Compare commits

...

17 Commits

Author SHA1 Message Date
Andy
9567b0a367 2022.9.13.0
Added video duration to the feed
Added skipping of pinned Instagram posts if they are already downloaded
2022-09-13 16:20:07 +03:00
Andy
c28c0e1ba3 2022.9.10.0
Fixed: missed posts are not saved
Fixed memory leaking because of the video
2022-09-10 12:28:40 +03:00
Andy
86771eee94 2022.9.8.1
Fixed unexpected memory leak when using the 'Feed' form
2022-09-08 22:24:36 +03:00
Andy
02e8a15ae3 2022.9.8.0
Temporary disabled RedGifs downloading
Added 'missing posts', 'feed'
Fixed minor bugs
2022-09-08 12:36:25 +03:00
Andy
443ab329d5 2022.8.28.0
Changed target platforms
Added RedGifs pics
Fixed Switcher limit bug
2022-08-28 04:08:54 +03:00
Andy
a16bb8de90 Update CONTRIBUTING.md 2022-08-26 20:38:33 +03:00
Andy
0af5e6f8d4 Update README.md 2022-08-26 20:37:54 +03:00
Andy
54ffe10f71 2022.8.22.0
Cleaned up the code
Replace some old functions with new ones
Adapted to the new library environment
Enable/Disable display user/downloaded image
Autodownloader option 'Show notification' not saved
Separate thread for standalone video downloader
Expanded the description of some errors with additional information
Fixed date/time renaming issue
Fixed internal library bugs
Fixed minor bugs
2022-08-22 02:42:36 +03:00
Andy
e0dc66e0da 2022.7.7.0
Brushed the code in some classes
Extended PropertyOption attribute
Removed AuthNullException
Moved ExitException to UserData class
Removed Instagram HashUpdateRequired and its environment
Changed Reddit response status code check
Twitter images bug
Added Scheduler, task startup delay, webp to jpg
Fixed Stop button bug
Minor changes
2022-07-07 14:11:18 +03:00
Andy
ab020d9b5f 2022.6.10.0
Instagram User ID
2022-06-10 21:13:35 +03:00
Andy
4ba1624edf Update MainWindowGroups.png 2022-06-09 07:55:58 +03:00
Andy
f3d956f33f 2022.6.7.0
Fixed some design issues
2022-06-07 20:00:36 +03:00
Andy
4a5e050201 Update README.md 2022-06-06 21:49:00 +03:00
Andy
dd272c6f6d 2022.6.6.0
Minor fixes
Fixed Twitter gifs
2022-06-06 21:32:43 +03:00
Andy
fbcda1ae75 2022.6.4.0
Added pause automation
Extended automation information
Updated automation checker
2022-06-04 02:43:46 +03:00
Andy
9e87369c9b Update ReadMe 2022-06-04 02:14:18 +03:00
Andy
cc3618a50e Update CONTRIBUTING.md 2022-06-04 02:10:44 +03:00
144 changed files with 6363 additions and 2163 deletions

View File

@@ -10,10 +10,15 @@ I welcome requests! Follow these steps to contribute:
# How to build from source
1. Delete the "PersonalUtilities" project from the solution.
1. Add the latest version of the "PersonalUtilities.dll" library (from the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest)).
1. Delete the "PersonalUtilities.Notifications" project from the solution.
1. The following libraries must be added to project references with the '**Copy to output folder**' option:
- ```PersonalUtilities.dll```
- ```PersonalUtilities.Notifications.dll```
- ```Microsoft.Toolkit.Uwp.Notifications.dll```
- ```System.ValueTuple.dll```
1. Import PersonalUtilities.Functions for the whole project.
**Always use the correct "PersonalUtilities.dll" library. You must download this library from the release of the code you downloaded.**
**Always use the correct libraries. You must download libraries from the same release date as the code commit date.**
# How to request a new site
@@ -22,7 +27,7 @@ I welcome requests! Follow these steps to contribute:
# Requirements for new site requests
**Attention! I'll add a new site only if I'm interested. I also have a life, and any development takes time. **
**Attention! I'll add a new site only if I'm interested. I also have a life, and any development takes time.**
- Post a link to the site's API
- Post request URLs **without OAuth** authentication
@@ -44,3 +49,5 @@ If I'm interested in a site you want to add, it may be added in future releases.
# 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,5 +1,102 @@
# 2022.9.13.0
*2022-09-13*
- Added
- Video duration to the feed
- Fixed
- (Issue #70) Instagram posts not downloading if there are pinned posts that have already been downloaded
- Minor bugs
# 2022.9.10.0
*2022-09-10*
- Fixed
- The memory is still leaking. This time because of the video. *Using WMP was not the best choice.*
# 2022.9.8.1
*2022-09-08*
- Fixed
- Unexpected memory leak when using the 'Feed' form
# 2022.9.8.0
*2022-09-08*
- Added
- **Feed** (feed of downloaded media files)
- Missing posts tracking and management
- Simple scheduler notifications
- Fixed
- (Issue #67) Saved Instagram posts not downloading
# 2022.8.28.0
*2022-08-28*
- Added
- RedGifs icon
- Fixed
- Incorrect number of posts displayed in the Reddit channels downloader.
# 2022.8.22.0
*2022-08-22*
- Added
- Ability to enable/disable the display of the downloaded image in toast notifications (AutoDownloader)
- Ability to enable/disable the display of the user icon in toast notifications (AutoDownloader)
- Downloading with standalone video downloader has been moved to a separate thread
- Fixed
- (Issue #35) The file name does not change only by date
- (Issue #62) Internal library error
- AutoDownloader option ```Show notifications``` not saved
- Minor bugs
# 2022.7.7.0
*2022-07-07*
- Added
- **Scheduler** (creating multiple automation tasks)
- Automation startup delay
- Download ```webp``` in ```jpg``` format
- Development: the ability to create a label control, that provides some information
- Removed
- Instagram auto-fill hash from cookies
- Updated
- Plugins
- Fixed
- ```Stop``` option not working properly
- In some cases, Twitter image is not downloading
- Minor bugs
# 2022.6.10.0
*2022-06-10*
**Attention! From now on, Instagram requires Cookies, Hash and authorization headers!**
- Fixed
- Can't get Instagram user ID
# 2022.6.6.0
*2022-06-06*
- Added
- Ability to pause automation
- Fixed
- GIFs from Twitter not downloading
- Not quite correct algorithm for stopping automation
# 2022.6.3.0
*2022-06-03*
Changed version numbering method. From now on, new versions will be numbered by release date (YYYY.M.D)
**Attention! Starting with this release, SCrawler may not work on windows 7 and 8 or may not work correctly. All future releases will only be guaranteed to work on windows 10 and 11.**
@@ -13,6 +110,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.10
*2022-05-23*
- Added
- **Downloading groups**
- **Download saved Twitter posts** (bookmarks)
@@ -34,6 +133,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.9
*2022-04-24*
- Added
- Excluded labels
- Ability to disable user grouping
@@ -44,6 +145,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.8
*2022-04-19*
- Added
- Script mode ```command```
- Disabled Instagram error 403 (Forbidden) logging for downloading tagged data
@@ -52,6 +155,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.7
*2022-04-14*
- Added
- Ability to run a script after the user download is complete
- Hotkey ```F2``` for additional options in the user creation form
@@ -62,6 +167,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.6
*2022-04-04*
- Added
- ```GoTo Start``` channels button
- ```GoTo End``` channels button
@@ -73,17 +180,23 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.5
*2022-04-02*
- Added
- ```New```, ```Hot```, ```Top``` Reddit channel and user download modes
# 3.0.0.4
*2022-03-26*
- Fixed
- External plugins do not save information about downloaded files
- The user cannot be added to the collection if a special path has been specified.
# 3.0.0.3
*2022-03-24*
- Added
- Download all by specific sites
- Download all, ignoring the ```Ready for download``` option
@@ -95,6 +208,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.2
*2022-03-22*
- Added
- **LPSG** site plugin
- **XVIDEOS** site plugin
@@ -105,6 +220,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.1
*2022-03-20*
- Added
- Download data up to a specific date
- Update and Reset functions in the plugin (ISiteSettings)
@@ -118,6 +235,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.0
*2022-03-17*
**Attention! This version of the program makes changes user data file (Users.xml). Once you start using this version, you will not be able to use previous versions of the program. Therefore, it is highly recommended to archive the program settings folder and archive the users' data files (you can use the [```ArchiveSCrawlerUsersDataFiles.bat```](Tools/ArchiveSCrawlerUsersDataFiles.bat) tool to archive the data files of all users).**
- Added
@@ -158,6 +277,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.4
*2022-02-07*
**Removed compatibility of program settings with version 1.0.0.4 and lower.**
**If your program version is 1.0.0.4 and lower, it is strongly recommended that you upgrade to release 2.0.0.1 to update the program settings (and run the program). Then update to this release. Otherwise, you will have to configure the program settings again**
@@ -172,6 +293,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.3
*2022-02-02*
**Removed compatibility of program settings with version 1.0.0.4 and lower.**
**If your program version is 1.0.0.4 and lower, it is strongly recommended that you upgrade to release 2.0.0.1 to update the program settings (and run the program). Then update to this release. Otherwise, you will have to configure the program settings again**
@@ -187,6 +310,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.2
*2022-01-23*
**This is the last release that supports program settings of version 1.0.0.4 and lower. Compatibility of program settings with version 1.0.0.4 and lower will be removed in future releases. It is strongly recommended that you upgrade to this release before future releases. Otherwise, you will have to configure the program settings again. If your program version is 1.0.1.0 or higher, you should not pay attention to this message.**
- Added
@@ -209,6 +334,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.1
*2021-12-29*
- Added
- Download individual Imgur media files (use the "Download video" form).
- Fixed
@@ -217,6 +344,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.0
*2021-12-27*
- Added
- **Instagram**
- Filter by site
@@ -234,6 +363,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.1.0
*2021-12-20*
- Added
- Extended site settings
- Non-existend users will be marked in red
@@ -255,6 +386,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.4
*2021-12-12*
- Added
- Full channels support (you can now add channel (subreddit) for standard download)
- ```Ready for download``` now available for collections and can be changed for multiple user
@@ -263,12 +396,16 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.3
*2021-12-11*
- Fixed
- Custom "Download videos" option is not saved
- The "Download all" button is not activated after changing modes
# 1.0.0.2
*2021-12-10*
- Added
- Ability to choose what types of media you want to download (images only, videos only, both)
- Ability to name files by date
@@ -277,6 +414,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.1
*2021-12-09*
- Added
- Limited download if user added from the channel
- Forced limited download for any user
@@ -299,4 +438,6 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.0
*2021-12-07*
Initial release

Binary file not shown.

After

Width:  |  Height:  |  Size: 574 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 369 KiB

After

Width:  |  Height:  |  Size: 370 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 9.3 KiB

After

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.6 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 26 KiB

View File

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

View File

@@ -1,4 +1,4 @@
# Social networks crawler
# :rainbow_flag: Social networks crawler :rainbow_flag:
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
@@ -35,6 +35,7 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- Add users from parsed channel
- **Advanced user management**
- **Automation** (downloading data automatically every ```X``` minutes)
- **Feed** (feed of downloaded media files)
- Labeling users
- Create download groups
- Adding users to favorites and temporary
@@ -100,9 +101,7 @@ Just download [latest](https://github.com/AAndyProgram/SCrawler/releases/latest)
# How to build from source
1. Delete the "PersonalUtilities" project from the solution.
1. Add the latest version of the "PersonalUtilities.dll" library (from the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest)).
1. Import PersonalUtilities.Functions for the whole project.
Read about how to build from source [here](CONTRIBUTING.md#how-to-build-from-source)
# How to make a plugin
@@ -118,7 +117,7 @@ The program has an intuitive interface.
You need to set up authorization for Twitter and Instagram:
- Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies) and [tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) for **Twitter** (if you want to download data from Twitter)
- Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies) and [Hash](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) for **Instagram** (if you want to download data from Instagram), [Hash 2](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-hash-2) for **saved Instagram posts**, Instagram [stories authorization headers](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-stories-authorization-headers) for **Stories** and **Tagged data**
- Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies), [Hash](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) and [authorization headers](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-authorization-headers) for **Instagram** (if you want to download data from Instagram), [Hash 2](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-hash-2) for **saved Instagram posts**
Just add a user profile and **click the ```Start downloading``` button**.
@@ -148,3 +147,5 @@ Example: ```D:\Programs\SCrawler\SCrawler.exe v```
# 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

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

View File

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

View File

@@ -30,7 +30,7 @@ Public Class SiteSettings : Implements ISiteSettings
.LoadSettings()
Else
.CookiesDomain = "www.lpsg.com"
.Cookies = New CookieKeeper("www.lpsg.com")
.Cookies = New CookieKeeper(.CookiesDomain)
End If
End With
End Sub
@@ -81,7 +81,7 @@ Public Class SiteSettings : Implements ISiteSettings
Else
Return Nothing
End If
Catch ex As Exception
Catch
Return Nothing
End Try
End Function
@@ -97,4 +97,7 @@ Public Class SiteSettings : Implements ISiteSettings
Public Function ReadyToDownload(ByVal What As ISiteSettings.Download) As Boolean Implements ISiteSettings.ReadyToDownload
Return True
End Function
Public Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Implements ISiteSettings.GetUserPostUrl
Return String.Empty
End Function
End Class

View File

@@ -95,7 +95,7 @@ Public Class UserData : Implements IPluginContentProvider
If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
LogProvider.Add("LPSG not available")
Else
LogProvider.Add(ex, "[LPSG.UserData.GetMedia]")
LogProvider.Add(ex, $"[LPSG.UserData.GetMedia({Name})]")
End If
End Try
End Sub
@@ -152,7 +152,8 @@ Public Class UserData : Implements IPluginContentProvider
If Responser.Client.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
LogProvider.Add("LPSG not available")
Else
m.DownloadState = UStates.Skipped
m.DownloadState = UStates.Missing
m.Attempts += 1
End If
End Try
RaiseEvent ProgressChanged(1)

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -14,8 +14,8 @@ Imports UStates = SCrawler.Plugin.PluginUserMedia.States
Imports UTypes = SCrawler.Plugin.PluginUserMedia.Types
Public Class UserData : Implements IPluginContentProvider
#Region "Interface declarations"
Public Event ProgressChanged(Count As Integer) Implements IPluginContentProvider.ProgressChanged
Public Event TotalCountChanged(Count As Integer) Implements IPluginContentProvider.TotalCountChanged
Public Event ProgressChanged(ByVal Count As Integer) Implements IPluginContentProvider.ProgressChanged
Public Event TotalCountChanged(ByVal Count As Integer) Implements IPluginContentProvider.TotalCountChanged
Public Property Thrower As IThrower Implements IPluginContentProvider.Thrower
Public Property LogProvider As ILogProvider Implements IPluginContentProvider.LogProvider
Public Property ESettings As ISiteSettings Implements IPluginContentProvider.Settings
@@ -56,7 +56,14 @@ Public Class UserData : Implements IPluginContentProvider
Private Property Responser As Response
Public Sub GetMedia() Implements IPluginContentProvider.GetMedia
Try
If Not Settings.UseM3U8 Then LogProvider.Add("File [ffmpeg.exe] not found") : Exit Sub
If Not Settings.UseM3U8 Then
If Settings.FfmpegExists Then
LogProvider.Add($"XVIDEOS [{Name}]: The plugin only works with x64 OS.")
Else
LogProvider.Add($"XVIDEOS [{Name}]: File [ffmpeg.exe] not found")
End If
Exit Sub
End If
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response
Responser.Copy(Settings.Responser)
@@ -105,9 +112,7 @@ Public Class UserData : Implements IPluginContentProvider
If TempMediaList.Count > 0 Then
For i% = 0 To TempMediaList.Count - 1
Thrower.ThrowAny()
With TempMediaList(i)
TempMediaList(i) = GetVideoData(.URL, Responser, Settings.DownloadUHD.Value, .PostID, LogProvider)
End With
With TempMediaList(i) : TempMediaList(i) = GetVideoData(.URL, Responser, Settings.DownloadUHD.Value, .PostID, LogProvider) : End With
Next
TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If
@@ -149,7 +154,7 @@ Public Class UserData : Implements IPluginContentProvider
Dim t$ = RegexReplace(r, VideoTitleRegex)
r = resp.GetResponse(m,, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim ls As List(Of VSize) = FNF.RegexFields(Of VSize)(r, {M3U8Reparse}, {1, 2})
Dim ls As List(Of VSize) = RegexFields(Of VSize)(r, {M3U8Reparse}, {1, 2})
If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) v.Size > 1080)
If ls.ListExists Then
ls.Sort()
@@ -203,7 +208,8 @@ Public Class UserData : Implements IPluginContentProvider
m.File = f
m.DownloadState = UStates.Downloaded
Catch ex As Exception
m.DownloadState = UStates.Skipped
m.DownloadState = UStates.Missing
m.Attempts += 1
End Try
TempMediaList(i) = m
RaiseEvent ProgressChanged(1)

View File

@@ -32,6 +32,10 @@ Namespace Plugin.Attributes
Public Property AllowNull As Boolean = True
''' <summary>Offset the control from the left border of the form.<br/>Default: 100</summary>
Public Property LeftOffset As Integer = 100
''' <summary>This control is an information label.<br/>Default: <see langword="False"/></summary>
Public Property IsInformationLabel As Boolean = False
''' <summary>Label text alignment.<br/>Default: <see cref="Drawing.ContentAlignment.TopCenter"/></summary>
Public Property LabelTextAlign As Drawing.ContentAlignment = Drawing.ContentAlignment.TopCenter
''' <summary>This is an authorization property</summary>
Public Property IsAuth As Boolean = False
''' <summary>Initialize a new property option attribute</summary>

View File

@@ -23,6 +23,7 @@ Namespace Plugin
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 GetInstance(ByVal What As Download) As IPluginContentProvider
Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
#Region "XML Support"
Sub Load(ByVal XMLValues As IEnumerable(Of KeyValuePair(Of String, String)))
#End Region

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 © 2022")>
<Assembly: AssemblyTrademark("AndyProgram")>
<Assembly: ComVisible(False)>
@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2022.6.3.0")>
<Assembly: AssemblyFileVersion("2022.6.3.0")>
<Assembly: AssemblyVersion("2022.9.10.0")>
<Assembly: AssemblyFileVersion("2022.9.10.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -13,13 +13,13 @@ Namespace Plugin
Public HostKey As String
Public IsChannel As Boolean
Public Exists As Boolean
Public Sub New(ByVal Site As String, ByVal _Name As String)
UserName = _Name
Public Sub New(ByVal Site As String, ByVal Name As String)
UserName = Name
SiteName = Site
End Sub
Public Sub New(ByVal Site As String, ByVal _Name As String, ByVal _IsChannel As Boolean)
Me.New(Site, _Name)
IsChannel = _IsChannel
Public Sub New(ByVal Site As String, ByVal Name As String, ByVal IsChannel As Boolean)
Me.New(Site, Name)
Me.IsChannel = IsChannel
End Sub
End Structure
End Namespace

View File

@@ -17,7 +17,7 @@ Namespace Plugin
GIF = 50
m3u8 = 100
End Enum
Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : End Enum
Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : Missing = 4 : End Enum
Public ContentType As Integer
Public URL As String
Public MD5 As String
@@ -26,5 +26,6 @@ Namespace Plugin
Public PostID As String
Public PostDate As Date?
Public SpecialFolder As String
Public Attempts As Integer
End Structure
End Namespace

View File

@@ -10,9 +10,9 @@ Namespace Plugin
Public Structure PropertyData
Public ReadOnly Name As String
Public ReadOnly Value As Object
Public Sub New(ByVal _Name As String, ByVal _Value As Object)
Name = _Name
Value = _Value
Public Sub New(ByVal Name As String, ByVal Value As Object)
Me.Name = Name
Me.Value = Value
End Sub
End Structure
End Namespace

View File

@@ -16,7 +16,7 @@ Namespace API.Base
Friend Structure Data : Implements IRegExCreator, IComparable(Of Data)
Friend [Date] As Date
Friend Value As Integer
Friend Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists Then
Try : [Date] = Date.Parse(ParamsArray(0)) : Catch : End Try
If ParamsArray.Length > 1 Then Value = AConvert(Of Integer)(ParamsArray(1), 0)
@@ -26,7 +26,7 @@ Namespace API.Base
Public Overrides Function ToString() As String
Return $"{AConvert(Of String)([Date], ADateTime.Formats.BaseDateTime, String.Empty)} [{Value}]"
End Function
Friend Function CompareTo(ByVal Other As Data) As Integer Implements IComparable(Of Data).CompareTo
Private Function CompareTo(ByVal Other As Data) As Integer Implements IComparable(Of Data).CompareTo
Return [Date].CompareTo(Other.Date) * -1
End Function
End Structure
@@ -37,7 +37,7 @@ Namespace API.Base
Using w As New WebClient
Dim r$ = w.DownloadString($"https://downdetector.co.uk/status/{Site}/")
If Not r.IsEmptyString Then
l = FNF.RegexFields(Of Data)(r, {Params}, {1, 2})
l = RegexFields(Of Data)(r, {Params}, {1, 2})
If l.ListExists(2) Then
l.Sort()
l2 = New List(Of Data)

View File

@@ -6,9 +6,9 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Hosts
Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.Plugin.Hosts
Imports PDownload = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base
Friend NotInheritable Class ProfileSaved
@@ -27,11 +27,8 @@ Namespace API.Base
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
u.Name = user.Name
With DirectCast(user, UserDataBase).User
u.IsChannel = .IsChannel
u.UpdateUserFile()
End With
With DirectCast(user, UserDataBase)
With .User : u.IsChannel = .IsChannel : u.UpdateUserFile() : End With
.User = u
.LoadUserInformation()
.IsSavedPosts = True
@@ -40,7 +37,7 @@ Namespace API.Base
End With
HOST.BeforeStartDownload(user, PDownload.SavedPosts)
user.DownloadData(Token)
Progress.InformationTemporary = $"Images: {user.DownloadedPictures(False)}; Videos: {user.DownloadedVideos(False)}"
Progress.InformationTemporary = $"{HOST.Name} Images: {user.DownloadedPictures(False)}; Videos: {user.DownloadedVideos(False)}"
HOST.AfterDownload(user, PDownload.SavedPosts)
End If
End Using

View File

@@ -6,17 +6,23 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports SCrawler.Plugin
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base
Friend MustInherit Class SiteSettingsBase : Implements ISiteSettings
Friend MustInherit Class SiteSettingsBase : Implements ISiteSettings, IResponserContainer
Friend ReadOnly Property Site As String Implements ISiteSettings.Site
Friend Overridable ReadOnly Property Icon As Icon = Nothing Implements ISiteSettings.Icon
Friend Overridable ReadOnly Property Image As Image = Nothing Implements ISiteSettings.Image
Friend Overridable ReadOnly Property Icon As Icon Implements ISiteSettings.Icon
Friend Overridable ReadOnly Property Image As Image Implements ISiteSettings.Image
Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger
Friend Overridable ReadOnly Property Responser As Response
Private Property IResponserContainer_Responser As Response Implements IResponserContainer.Responser
Get
Return Responser
End Get
Set : End Set
End Property
Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance
Friend Sub New(ByVal SiteName As String)
Site = SiteName
@@ -25,7 +31,15 @@ Namespace API.Base
Site = SiteName
Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml")
With Responser
If .File.Exists Then .LoadSettings() Else .CookiesDomain = CookiesDomain : .SaveSettings()
If .File.Exists Then
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.LoadSettings()
Else
.CookiesDomain = CookiesDomain
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.SaveSettings()
End If
End With
End Sub
#Region "XML"
@@ -36,6 +50,7 @@ Namespace API.Base
Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit
End Sub
Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit
EncryptCookies.ValidateCookiesEncrypt(Responser)
End Sub
Friend Overridable Sub BeginUpdate() Implements ISiteSettings.BeginUpdate
End Sub
@@ -63,6 +78,9 @@ Namespace API.Base
End If
Return String.Empty
End Function
Friend Overridable Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Implements ISiteSettings.GetUserPostUrl
Return String.Empty
End Function
Protected UserRegex As RParams = Nothing
Friend Overridable Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Implements ISiteSettings.IsMyUser
Try

View File

@@ -18,7 +18,7 @@ Namespace API.Base
GIF = 50
m3u8 = 100
End Enum
Friend Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : End Enum
Friend Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : Missing = 4 : End Enum
Friend [Type] As Types
Friend URL_BASE As String
Friend URL As String
@@ -27,6 +27,7 @@ Namespace API.Base
Friend Post As UserPost
Friend PictureOption As String
Friend State As States
Friend Attempts As Integer
''' <summary>
''' SomeFolder<br/>
''' SomeFolder\SomeFolder2
@@ -51,6 +52,7 @@ Namespace API.Base
Post = New UserPost With {.ID = m.PostID, .[Date] = m.PostDate}
State = m.DownloadState
SpecialFolder = m.SpecialFolder
Attempts = m.Attempts
End If
End Sub
Public Shared Widening Operator CType(ByVal _URL As String) As UserMedia
@@ -71,7 +73,8 @@ Namespace API.Base
.URL = URL,
.SpecialFolder = SpecialFolder,
.PostID = Post.ID,
.PostDate = Post.Date
.PostDate = Post.Date,
.Attempts = Attempts
}
End Function
Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals
@@ -106,12 +109,12 @@ Namespace API.Base
Friend Function CompareTo(ByVal Other As UserPost) As Integer Implements IComparable(Of UserPost).CompareTo
Return GetCompareValue(Me).CompareTo(GetCompareValue(Other))
End Function
#End Region
Private Function GetCompareValue(ByVal Post As UserPost) As Long
Dim v& = 0
If Post.Date.HasValue Then v = Post.Date.Value.Ticks * -1
Return v
End Function
#End Region
End Structure
Friend Structure Sizes : Implements IComparable(Of Sizes)
Friend Value As Integer

View File

@@ -9,8 +9,8 @@
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Imports System.IO
Imports System.Net
Imports System.Threading
@@ -21,28 +21,33 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Base
Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower
Friend Const UserFileAppender As String = "User"
Private ReadOnly _OnUserUpdatedHandlers As List(Of IUserData.OnUserUpdatedEventHandler)
Friend Custom Event OnUserUpdated As IUserData.OnUserUpdatedEventHandler Implements IUserData.OnUserUpdated
AddHandler(ByVal e As IUserData.OnUserUpdatedEventHandler)
If Not _OnUserUpdatedHandlers.Contains(e) Then _OnUserUpdatedHandlers.Add(e)
#Region "Events"
Private ReadOnly UserUpdatedEventHandlers As List(Of IUserData.UserUpdatedEventHandler)
Friend Custom Event UserUpdated As IUserData.UserUpdatedEventHandler Implements IUserData.UserUpdated
AddHandler(ByVal e As IUserData.UserUpdatedEventHandler)
If Not UserUpdatedEventHandlers.Contains(e) Then UserUpdatedEventHandlers.Add(e)
End AddHandler
RemoveHandler(ByVal e As IUserData.OnUserUpdatedEventHandler)
If _OnUserUpdatedHandlers.Contains(e) Then _OnUserUpdatedHandlers.Remove(e)
RemoveHandler(ByVal e As IUserData.UserUpdatedEventHandler)
If UserUpdatedEventHandlers.Contains(e) Then UserUpdatedEventHandlers.Remove(e)
End RemoveHandler
RaiseEvent(ByVal User As IUserData)
If _OnUserUpdatedHandlers.Count > 0 Then
For Each e As IUserData.OnUserUpdatedEventHandler In _OnUserUpdatedHandlers
Try : e.Invoke(User) : Catch : End Try
Next
End If
Try
If UserUpdatedEventHandlers.Count > 0 Then
For i% = 0 To UserUpdatedEventHandlers.Count - 1
Try : UserUpdatedEventHandlers(i).Invoke(User) : Catch : End Try
Next
End If
Catch
End Try
End RaiseEvent
End Event
Protected Sub RaiseEvent_OnUserUpdated()
RaiseEvent OnUserUpdated(Me)
Protected Sub OnUserUpdated()
RaiseEvent UserUpdated(Me)
End Sub
Friend Sub RemoveUpdateHandlers()
_OnUserUpdatedHandlers.Clear()
UserUpdatedEventHandlers.Clear()
End Sub
#End Region
#Region "Collection buttons"
Private _CollectionButtonsExists As Boolean = False
Private _CollectionButtonsColorsSet As Boolean = False
@@ -78,11 +83,11 @@ Namespace API.Base
Dim cb As Color = SystemColors.Control
Dim cf As Color = SystemColors.ControlText
If Not UserExists Then
cb = ColorBttDeleteBack
cf = ColorBttDeleteFore
cb = MyColor.DeleteBack
cf = MyColor.DeleteFore
ElseIf UserSuspended Then
cb = ColorBttEditBack
cf = ColorBttEditFore
cb = MyColor.EditBack
cf = MyColor.EditFore
End If
For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE}
If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf
@@ -122,6 +127,8 @@ Namespace API.Base
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"
@@ -130,12 +137,21 @@ Namespace API.Base
#End Region
#End Region
#Region "Declarations"
#Region "Host, Site, Progress, Self"
Friend Property HOST As SettingsHost Implements IUserData.HOST
Friend ReadOnly Property Site As String Implements IContentProvider.Site
Get
Return HOST.Name
End Get
End Property
Friend Property Progress As MyProgress
Friend ReadOnly Property Self As IUserData Implements IUserData.Self
Get
Return Me
End Get
End Property
#End Region
#Region "User name, ID, exist, suspend"
Friend User As UserInfo
Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
Friend Overridable Property UserExists As Boolean = True Implements IUserData.Exists, IPluginContentProvider.UserExists
@@ -152,7 +168,8 @@ Namespace API.Base
End Property
Friend Overridable Property ID As String = String.Empty Implements IContentProvider.ID, IPluginContentProvider.ID
Friend Overridable Property FriendlyName As String = String.Empty Implements IContentProvider.FriendlyName
#Region "UserDescription"
#End Region
#Region "Description"
Friend Property UserDescription As String = String.Empty Implements IContentProvider.Description, IPluginContentProvider.UserDescription
Protected _DescriptionEveryTime As Boolean = False
Protected _DescriptionChecked As Boolean = False
@@ -174,7 +191,7 @@ Namespace API.Base
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
End Sub
#End Region
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly, IPluginContentProvider.ParseUserMediaOnly
#Region "Favorite, Temporary"
Protected _Favorite As Boolean = False
Friend Overridable Property Favorite As Boolean Implements IContentProvider.Favorite
Get
@@ -195,17 +212,15 @@ Namespace API.Base
If _Temporary Then _Favorite = False
End Set
End Property
#End Region
#Region "Channel"
Friend Overridable ReadOnly Property IsChannel As Boolean Implements IUserData.IsChannel
Get
Return User.IsChannel
End Get
End Property
Friend Property CreatedByChannel As Boolean = False
Friend ReadOnly Property Self As IUserData Implements IUserData.Self
Get
Return Me
End Get
End Property
#End Region
#Region "Images"
Friend Overridable Function GetUserPicture() As Image Implements IUserData.GetPicture
If Settings.ViewModeIsPicture Then
@@ -214,21 +229,21 @@ Namespace API.Base
Return Nothing
End If
End Function
Friend Function GetUserPictureAddress() As SFile
Return GetPicture(Of SFile)(False)
Friend Function GetUserPictureToastAddress() As SFile
Return GetPicture(Of SFile)(False, True)
End Function
Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Try
If Not f.IsEmptyString AndAlso f.Exists Then
If f.Exists Then
Using p As New UserImage(f, User.File) : p.Save() : End Using
End If
Catch ex As Exception
Catch
End Try
End Sub
Protected Function GetNullPicture(ByVal MaxHeigh As XML.Base.XMLValue(Of Integer)) As Bitmap
Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value)
End Function
Protected Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As T
Protected Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True, Optional ByVal GetToast As Boolean = False) As T
Dim rsfile As Boolean = GetType(T) Is GetType(SFile)
Dim f As SFile = Nothing
Dim p As UserImage = Nothing
@@ -260,7 +275,7 @@ BlockPictureScan:
New ErrorsDescriber(EDP.ReturnValue) With {
.ReturnValue = New List(Of SFile),
.ReturnValueExists = True}).FirstOrDefault
If Not NewPicFile.IsEmptyString AndAlso NewPicFile.Exists Then
If NewPicFile.Exists Then
p = New UserImage(NewPicFile, MyFile)
p.Save()
GoTo BlockReturn
@@ -275,8 +290,14 @@ BlockReturn:
On Error GoTo BlockNullPicture
If Not p Is Nothing Then
Dim i As Image = Nothing
Dim a As SFile = p.Address
If Not rsfile Then
Dim a As SFile = Nothing
If rsfile Then
If GetToast Then
a = p.Large.Address
Else
a = p.Address
End If
Else
Select Case Settings.ViewMode.Value
Case View.LargeIcon : i = p.Large.OriginalImage.Clone
Case View.SmallIcon : i = p.Small.OriginalImage.Clone
@@ -288,8 +309,8 @@ BlockReturn:
BlockNullPicture:
If ReturnNullImageOnNothing Then
Select Case Settings.ViewMode.Value
Case View.LargeIcon : Return CObj(GetNullPicture(Settings.MaxLargeImageHeigh))
Case View.SmallIcon : Return CObj(GetNullPicture(Settings.MaxSmallImageHeigh))
Case View.LargeIcon : Return CObj(GetNullPicture(Settings.MaxLargeImageHeight))
Case View.SmallIcon : Return CObj(GetNullPicture(Settings.MaxSmallImageHeight))
End Select
End If
Return Nothing
@@ -303,7 +324,7 @@ BlockNullPicture:
End Get
End Property
#End Region
#Region "Collections support"
#Region "Collections"
Protected _IsCollection As Boolean = False
Protected Friend ReadOnly Property IsCollection As Boolean Implements IUserData.IsCollection
Get
@@ -332,16 +353,38 @@ BlockNullPicture:
End Sub
Friend Overridable ReadOnly Property Labels As List(Of String) Implements IUserData.Labels
#End Region
#Region "Downloading params"
#Region "Downloading"
Protected _DataLoaded As Boolean = False
Protected _DataParsed As Boolean = False
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly, IPluginContentProvider.ParseUserMediaOnly
Friend Overridable Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
Friend Property DownloadImages As Boolean = True Implements IUserData.DownloadImages
Friend Property DownloadVideos As Boolean = True Implements IUserData.DownloadVideos
Friend Property DownloadMissingOnly As Boolean = False Implements IUserData.DownloadMissingOnly
#End Region
#Region "Content"
Protected ReadOnly _ContentList As List(Of UserMedia)
Protected ReadOnly _ContentNew As List(Of UserMedia)
Friend ReadOnly Property LatestData As List(Of UserMedia)
Protected ReadOnly MissingFinder As Predicate(Of UserMedia) = Function(c) c.State = UStates.Missing
Friend ReadOnly Property ContentMissing As List(Of UserMedia)
Get
If _ContentList.Count > 0 Then
Return _ContentList.Where(Function(c) MissingFinder(c)).ListIfNothing
Else
Return New List(Of UserMedia)
End If
End Get
End Property
Friend Overridable ReadOnly Property ContentMissingExists As Boolean
Get
Return _ContentList.Exists(MissingFinder)
End Get
End Property
Friend Sub RemoveMedia(ByVal m As UserMedia, ByVal State As UStates?)
Dim i% = If(State.HasValue, _ContentList.FindIndex(Function(mm) mm.State = State.Value And mm.Equals(m)), _ContentList.IndexOf(m))
If i >= 0 Then _ContentList.RemoveAt(i)
End Sub
Protected ReadOnly _TempMediaList As List(Of UserMedia)
Protected ReadOnly _TempPostsList As List(Of String)
Friend Function GetLastImageAddress() As SFile
@@ -378,7 +421,7 @@ BlockNullPicture:
End Set
End Property
#End Region
#Region "Information"
#Region "Information, counters, error, update date"
Friend Overridable Property LastUpdated As Date?
Friend Overridable Property HasError As Boolean = False Implements IUserData.HasError
Private _DownloadedPicturesTotal As Integer = 0
@@ -422,6 +465,25 @@ BlockNullPicture:
$" (P - {DownloadedPictures(True)}; V - {DownloadedVideos(True)})"
End Get
End Property
Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name}"
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
OutStr.StringAppendLine($"Total downloaded ({DownloadedTotal(True).NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {DownloadedPictures(True).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(True).NumToString(ANumbers.Formats.Number, 3)}")
If Not UserDescription.IsEmptyString Then
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine(UserDescription)
End If
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine($"Last updated at: {AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, "not yet")}")
If _DataParsed Then
OutStr.StringAppendLine("Downloaded now:")
OutStr.StringAppendLine($"Pictures: {DownloadedTotal(False).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(False).NumToString(ANumbers.Formats.Number, 3)}")
End If
Return OutStr
End Function
#End Region
#Region "Script"
Friend Overridable Property ScriptUse As Boolean = False Implements IUserData.ScriptUse
@@ -431,7 +493,6 @@ BlockNullPicture:
#Region "Plugins Support"
Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged
Protected Event TotalCountChanged As IPluginContentProvider.TotalCountChangedEventHandler Implements IPluginContentProvider.TotalCountChanged
Friend Property HOST As SettingsHost Implements IUserData.HOST
Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings
Get
Return HOST.Source
@@ -524,38 +585,18 @@ BlockNullPicture:
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
End Try
End Function
Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name}"
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
OutStr.StringAppendLine($"Total downloaded ({DownloadedTotal(True).NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {DownloadedPictures(True).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(True).NumToString(ANumbers.Formats.Number, 3)}")
If Not UserDescription.IsEmptyString Then
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine(UserDescription)
End If
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine($"Last updated at: {AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, "not yet")}")
If _DataParsed Then
OutStr.StringAppendLine("Downloaded now:")
OutStr.StringAppendLine($"Pictures: {DownloadedTotal(False).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(False).NumToString(ANumbers.Formats.Number, 3)}")
End If
Return OutStr
End Function
#End Region
#Region "Initializer"
Private ReadOnly _InvokeImageHandler As Boolean
''' <summary>By using this constructor you must set UserName and MyFile manually</summary>
Friend Sub New(Optional ByVal InvokeImageHandler As Boolean = True)
_InvokeImageHandler = InvokeImageHandler
_ContentList = New List(Of UserMedia)
_ContentNew = New List(Of UserMedia)
LatestData = New List(Of UserMedia)
_TempMediaList = New List(Of UserMedia)
_TempPostsList = New List(Of String)
Labels = New List(Of String)
_OnUserUpdatedHandlers = New List(Of IUserData.OnUserUpdatedEventHandler)
If InvokeImageHandler Then ImageHandler(Me)
UserUpdatedEventHandlers = New List(Of IUserData.UserUpdatedEventHandler)
If InvokeImageHandler Then MainFrameObj.ImageHandler(Me)
End Sub
Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment
@@ -566,13 +607,29 @@ BlockNullPicture:
End If
End Sub
''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Overloads Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
Friend Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
If Not u.Plugin.IsEmptyString Then
Return Settings(u.Plugin).GetInstance(u.DownloadOption, u, _LoadUserInformation)
Else
Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader")
End If
End Function
Friend Shared Function GetPostUrl(ByVal u As IUserData, ByVal PostData As UserMedia) As String
Dim uName$ = String.Empty
Try
If Not u Is Nothing AndAlso Not u.IsCollection Then
With DirectCast(u, UserDataBase)
If Not .User.Plugin.IsEmptyString Then
uName = .User.Name
Return Settings(.User.Plugin).GetUserPostUrl(.ID, PostData.Post.ID)
End If
End With
End If
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"GetPostUrl({uName}, {PostData.Post.ID})", String.Empty)
End Try
End Function
#End Region
#Region "Information & Content data files loader and saver"
#Region "User information"
@@ -659,36 +716,31 @@ BlockNullPicture:
Protected MustOverride Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
#End Region
#Region "User data"
Friend Overridable Overloads Sub LoadContentInformation()
Friend Overridable Overloads Sub LoadContentInformation(Optional ByVal Force As Boolean = False)
Try
UpdateDataFiles()
If Not MyFileData.Exists Then Exit Sub
If Not MyFileData.Exists Or (_DataLoaded And Not Force) Then Exit Sub
Using x As New XmlFile(MyFileData, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData()
If x.Count > 0 Then
Dim fs$ = MyFile.CutPath.PathWithSeparator
Dim gfn As Func(Of String, String) = Function(ByVal Input As String) As String
If Input.IsEmptyString Then
Return String.Empty
Else
If Input.Contains("\") Then
Return New SFile(Input).File
Else
Return Input
End If
End If
End Function
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 = AConvert(Of Integer)(v.Attribute(Name_MediaType).Value, 0),
.URL = v.Attribute(Name_MediaURL).Value,
.URL_BASE = v.Value,
.MD5 = v.Attribute(Name_MediaHash).Value,
.File = fs & gfn.Invoke(v.Attribute(Name_MediaFile).Value),
.Post = New UserPost With {
.ID = v.Attribute(Name_MediaPostID).Value,
.[Date] = AConvert(Of Date)(v.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing)}
})
.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
End If
_DataLoaded = True
@@ -705,14 +757,17 @@ BlockNullPicture:
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_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))
}))
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
x.Save(MyFileData)
@@ -730,7 +785,7 @@ BlockNullPicture:
If Not URL.IsEmptyString Then Process.Start(URL)
Catch ex As Exception
If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowAllMsg)
MsgBoxE($"Error on trying to open [{Site}] page of user [{Name}]", MsgBoxStyle.Critical, e)
MsgBoxE({$"Error when trying to open [{Site}] page of user [{Name}]", $"User [{ToString()}]"}, MsgBoxStyle.Critical, e, ex)
End Try
End Sub
Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder
@@ -754,6 +809,7 @@ BlockNullPicture:
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(Of Image)(False) Is Nothing
Dim sEnvir() As Boolean = {UserExists, UserSuspended}
Dim EnvirChanged As Func(Of Boolean) = Function() Not sEnvir(0) = UserExists Or Not sEnvir(1) = UserSuspended
Dim _downContent As Func(Of UserMedia, Boolean) = Function(c) c.State = UStates.Downloaded
UserExists = True
UserSuspended = False
DownloadedPictures(False) = 0
@@ -762,19 +818,25 @@ BlockNullPicture:
_TempPostsList.Clear()
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
If Not _DataLoaded Then LoadContentInformation()
LoadContentInformation()
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
ThrowAny(Token)
DownloadDataF(Token)
ThrowAny(Token)
If Not DownloadMissingOnly Then
ThrowAny(Token)
DownloadDataF(Token)
ThrowAny(Token)
Else
'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)
If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.Video Or
m.Type = UTypes.VideoPre Or m.Type = UTypes.m3u8)
If DownloadMissingOnly Then _TempMediaList.RemoveAll(Function(m) Not m.State = UStates.Missing)
End If
ReparseVideo(Token)
@@ -783,8 +845,12 @@ BlockNullPicture:
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
DownloadContent(Token)
ThrowIfDisposed()
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UStates.Downloaded), LNC)
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Then
LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
Dim mcb& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
_ContentList.ListAddList(_ContentNew.Where(Function(c) _downContent(c) Or MissingFinder(c)), LNC)
Dim mca& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Or Not mcb = mca Then
If __SaveData Then
LastUpdated = Now
RunScript()
@@ -803,7 +869,7 @@ BlockNullPicture:
If _CollectionButtonsExists AndAlso EnvirChanged.Invoke Then UpdateButtonsColor()
End If
ThrowIfDisposed()
If UpPic Or EnvirChanged.Invoke Then RaiseEvent_OnUserUpdated()
If UpPic Or EnvirChanged.Invoke Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested
MyMainLOG = $"{Site} - {Name}: downloading canceled"
Canceled = True
@@ -814,10 +880,11 @@ BlockNullPicture:
HasError = True
Finally
If Not Responser Is Nothing Then Responser.Dispose() : Responser = Nothing
If Not Canceled Then _DataParsed = True ': LastUpdated = Now
If Not Canceled Then _DataParsed = True
_ContentNew.Clear()
DownloadTopCount = Nothing
DownloadToDate = Nothing
DownloadMissingOnly = False
End Try
End Sub
Protected Function CheckDatesLimit(ByVal DateString As String, ByVal DateProvider As IFormatProvider) As Boolean
@@ -839,11 +906,14 @@ BlockNullPicture:
MyFilePosts.Name &= "_Posts"
MyFilePosts.Extension = "txt"
Else
Throw New ArgumentNullException("User.File", "User file does not detected")
Throw New ArgumentNullException("User.File", "User file not detected")
End If
End Sub
Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken)
Protected MustOverride Sub ReparseVideo(ByVal Token As CancellationToken)
Protected Overridable Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try
@@ -854,6 +924,7 @@ BlockNullPicture:
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then
MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim MyDir$ = MyFile.CutPath.PathNoSeparator
Dim vsf As Boolean = SeparateVideoFolderF
Dim __isVideo As Boolean
@@ -861,7 +932,7 @@ BlockNullPicture:
Dim v As UserMedia
Using w As New WebClient
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
Progress.TotalCount += _ContentNew.Count
Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1
ThrowAny(Token)
v = _ContentNew(i)
@@ -886,6 +957,8 @@ BlockNullPicture:
Case UTypes.Video : f.Extension = "mp4"
Case UTypes.GIF : f.Extension = "gif"
End Select
ElseIf f.Extension = "webp" And Settings.DownloadNativeImageFormat Then
f.Extension = "jpg"
End If
If Not v.SpecialFolder.IsEmptyString Then
@@ -910,7 +983,9 @@ BlockNullPicture:
v.State = UStates.Downloaded
dCount += 1
Catch wex As Exception
ErrorDownloading(f, v.URL_BASE)
v.Attempts += 1
v.State = UStates.Missing
If MissingErrorsAdd Then ErrorDownloading(f, v.URL_BASE)
End Try
Else
v.State = UStates.Skipped
@@ -947,8 +1022,8 @@ BlockNullPicture:
Protected Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
Dim ff As SFile = Nothing
Try
If Not f.IsEmptyString AndAlso f.Exists Then
If Settings.FileReplaceNameByDate Or Settings.FileAddTimeToFileName Then
If f.Exists Then
If Not Settings.FileReplaceNameByDate.Value = FileNameReplaceMode.None Then
ff = f
ff.Name = String.Format(FileDateAppenderPattern, f.Name, CStr(AConvert(Of String)(If(m.Post.Date, Now), FileDateAppenderProvider, String.Empty)))
ff = SFile.Indexed_IndexFile(ff,, New NumberedFile(ff))
@@ -988,7 +1063,7 @@ BlockNullPicture:
Friend Overridable Function Delete() 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
ImageHandler(Me, False)
MainFrameObj.ImageHandler(Me, False)
Settings.UsersList.Remove(User)
Settings.UpdateUsersList()
Settings.Users.Remove(Me)
@@ -1193,6 +1268,7 @@ BlockNullPicture:
If disposing Then
_ContentList.Clear()
_ContentNew.Clear()
LatestData.Clear()
_TempMediaList.Clear()
_TempPostsList.Clear()
If Not Responser Is Nothing Then Responser.Dispose()
@@ -1201,7 +1277,7 @@ BlockNullPicture:
If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose()
If Not BTT_CONTEXT_OPEN_PATH Is Nothing Then BTT_CONTEXT_OPEN_PATH.Dispose()
If Not BTT_CONTEXT_OPEN_SITE Is Nothing Then BTT_CONTEXT_OPEN_SITE.Dispose()
_OnUserUpdatedHandlers.Clear()
UserUpdatedEventHandlers.Clear()
End If
disposedValue = True
End If
@@ -1228,7 +1304,7 @@ BlockNullPicture:
Sub DownloadData(ByVal Token As CancellationToken)
End Interface
Friend Interface IUserData : Inherits IContentProvider, IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IIndexable, IDisposable
Event OnUserUpdated(ByVal User As IUserData)
Event UserUpdated(ByVal User As IUserData)
Property ParseUserMediaOnly As Boolean
#Region "Images"
Function GetPicture() As Image
@@ -1256,6 +1332,7 @@ BlockNullPicture:
ReadOnly Property Key As String
Property DownloadImages As Boolean
Property DownloadVideos As Boolean
Property DownloadMissingOnly As Boolean
Property ScriptUse As Boolean
Property ScriptData As String
Function GetLVI(ByVal Destination As ListView) As ListViewItem

View File

@@ -10,8 +10,8 @@ Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net
Imports SCrawler.API.Imgur.Declarations
Imports SCrawler.API.Base
Imports SCrawler.API.Imgur.Declarations
Namespace API.Imgur
Namespace Declarations
Friend Module Imgur_Declarations
@@ -79,7 +79,7 @@ Namespace API.Imgur
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Imgur standalone downloader: fetch media error")
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog + EDP.ReturnValue, ex, "Imgur standalone downloader: fetch media error")
End Try
End Function
Private Shared Function DownloadingException(ByVal ex As Exception, ByVal Message As String,

View File

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

View File

@@ -11,15 +11,6 @@ Namespace API.Instagram
Friend Module Declarations
Friend Const InstagramSite As String = "Instagram"
Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
Friend ReadOnly Property DateProvider As New JsonDate
Friend Class JsonDate : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicode(Value)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
Friend ReadOnly Property DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v))
End Module
End Namespace

View File

@@ -11,10 +11,8 @@ Namespace API.Instagram
Friend Class EditorExchangeOptions
Friend Property GetStories As Boolean
Friend Property GetTagged As Boolean
Private ReadOnly Property MySiteSettings As SiteSettings
Friend Sub New(ByVal h As ISiteSettings)
MySiteSettings = DirectCast(h, SiteSettings)
With MySiteSettings
With DirectCast(h, SiteSettings)
GetStories = CBool(.GetStories.Value)
GetTagged = CBool(.GetTagged.Value)
End With

View File

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

View File

@@ -7,22 +7,19 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Namespace API.Instagram
Friend Class OptionsForm : Implements IOkCancelToolbar
Private ReadOnly MyDefs As DefaultFormProps
Friend Class OptionsForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyExchangeOptions As EditorExchangeOptions
Friend Sub New(ByRef ExchangeOptions As EditorExchangeOptions)
InitializeComponent()
MyExchangeOptions = ExchangeOptions
MyDefs = New DefaultFormProps
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub OptionsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(Me, Settings.Design, True)
.MyViewInitialize(True)
.AddOkCancelToolbar()
.DelegateClosingChecker()
.AppendDetectors()
With MyExchangeOptions
CH_GET_STORIES.Checked = .GetStories
CH_GET_TAGGED.Checked = .GetTagged
@@ -30,15 +27,12 @@ Namespace API.Instagram
.EndLoaderOperations()
End With
End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyExchangeOptions
.GetStories = CH_GET_STORIES.Checked
.GetTagged = CH_GET_TAGGED.Checked
End With
MyDefs.CloseForm()
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
End Class
End Namespace

View File

@@ -10,7 +10,7 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
@@ -18,7 +18,8 @@ Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram
<Manifest("AndyProgram_Instagram"), UseClassAsIs, SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Interface Declarations"
#Region "Declarations"
#Region "Images"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.InstagramIcon
@@ -54,7 +55,7 @@ Namespace API.Instagram
Return Nothing
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
Throw New NotImplementedException("[GetFormat] is not available in the context of [TimersChecker]")
End Function
End Class
Private Class TaggedNotifyLimitChecker : Implements IFieldsCheckerProvider
@@ -72,7 +73,7 @@ Namespace API.Instagram
End If
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
Throw New NotImplementedException("[GetFormat] is not available in the context of [TaggedNotifyLimitChecker]")
End Function
End Class
#End Region
@@ -89,14 +90,31 @@ Namespace API.Instagram
Friend Property IG_WWW_CLAIM As PropertyValue
<PropertyOption(ControlText:="Saved posts user", IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend ReadOnly Property StoriesAndTaggedReady As Boolean
Friend ReadOnly Property BaseAuthExists As Boolean
Get
Return ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
Return Responser.Cookies.Count > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
End Get
End Property
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
Case NameOf(IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
End Select
If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
End Sub
#End Region
#Region "Download properties"
Friend ReadOnly Property HashUpdateRequired As XMLValue(Of Boolean)
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(6)>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
@@ -121,7 +139,7 @@ Namespace API.Instagram
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region
#Region "429 bypass"
Friend ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
Friend Property LastApplyingValue As Integer? = Nothing
Friend ReadOnly Property ReadyForDownload As Boolean
Get
@@ -134,8 +152,11 @@ Namespace API.Instagram
End With
End Get
End Property
Friend ReadOnly Property LastDownloadDate As XMLValue(Of Date)
Friend ReadOnly Property LastRequestsCount As XMLValue(Of Integer)
Private ReadOnly Property LastDownloadDate As XMLValue(Of Date)
Private ReadOnly Property LastRequestsCount As XMLValue(Of Integer)
<PropertyOption(IsInformationLabel:=True), ControlNumber(100)>
Private Property LastRequestsCountLabel As PropertyValue
Private ReadOnly LastRequestsCountLabelStr As Func(Of Integer, String) = Function(r) $"Number of spent requests: {r.NumToGroupIntegral}"
Private TooManyRequestsReadyForCatch As Boolean = True
Friend Function GetWaitDate() As Date
With DownloadingErrorDate
@@ -155,7 +176,7 @@ Namespace API.Instagram
LastApplyingValue = If(LastApplyingValue, 0) + 10
TooManyRequestsReadyForCatch = False
MyMainLOG = $"Instagram downloading error: too many requests. Try again after {If(LastApplyingValue, 10)} minutes..."
End If
End If
End If
Else
.ValueF = Nothing
@@ -165,26 +186,23 @@ Namespace API.Instagram
End With
End Sub
#End Region
Friend Overrides ReadOnly Property Responser As WEB.Response
Private Initialized As Boolean = False
#End Region
#Region "Initializer"
Friend Sub New(ByRef _XML As XmlFile, ByVal GlobalPath As SFile)
MyBase.New(InstagramSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
MyBase.New(InstagramSite, "instagram.com")
Dim app_id$ = String.Empty
Dim www_claim$ = String.Empty
Dim token$ = String.Empty
With Responser
If .File.Exists Then
.LoadSettings()
If .Headers.Count > 0 Then
With .Headers
If .ContainsKey(Header_CSRF_TOKEN) Then token = .Item(Header_CSRF_TOKEN)
If .ContainsKey(Header_IG_APP_ID) Then app_id = .Item(Header_IG_APP_ID)
If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM)
End With
Else
.CookiesDomain = "instagram.com"
.SaveSettings()
End If
End With
@@ -192,7 +210,6 @@ Namespace API.Instagram
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
HashUpdateRequired = New XMLValue(Of Boolean)("InstaHashUpdateRequired", True, _XML, n)
Hash = New PropertyValue(String.Empty, GetType(String))
HashSavedPosts = New PropertyValue(String.Empty, GetType(String))
CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v))
@@ -211,44 +228,25 @@ Namespace API.Instagram
TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New XMLValue(Of Date) With {
.Provider = New XMLValueConversionProvider(Function(ss, vv) AConvert(Of String)(vv, AModes.Var, Nothing))}
DownloadingErrorDate = New XMLValue(Of Date) With {.Provider = New XMLValueConversionProvider(Function(ss, vv) AConvert(Of String)(vv, AModes.Var, Nothing))}
DownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n)
LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n)
LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n)
LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value))
AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(__value)
UrlPatternUser = "https://www.instagram.com/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
ImageVideoContains = "instagram.com"
End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
Case Download.Main : Return New UserData
Case Download.SavedPosts
Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
Return u
End Select
Return Nothing
End Function
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
Case NameOf(IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
End Select
If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
Friend Overrides Sub BeginInit()
End Sub
Friend Overrides Sub EndInit()
Initialized = True
MyBase.EndInit()
End Sub
#End Region
#Region "PropertiesDataChecker"
<PropertiesDataChecker({NameOf(Hash), NameOf(HashSavedPosts)})>
Private Function CheckHashControls(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists(2) Then
@@ -284,7 +282,7 @@ Namespace API.Instagram
Return True
ElseIf v = -1 Then
Return MsgBoxE({"You turn off notifications for tagged posts. This is highly undesirable. Do you still want to do it?",
"Disabling tagged notification limits "}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes
"Disabling tagged notification limits"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes
Else
Return False
End If
@@ -292,20 +290,32 @@ Namespace API.Instagram
End If
Return False
End Function
Friend Overrides Sub BeginInit()
End Sub
Friend Overrides Sub EndInit()
If (CStr(Hash.Value).IsEmptyString Or HashUpdateRequired) AndAlso Responser.Cookies.ListExists Then GatherInstaHash()
End Sub
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
Return ActiveJobs < 2 AndAlso ReadyForDownload
#End Region
#Region "Plugin functions"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
Case Download.Main : Return New UserData
Case Download.SavedPosts
Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
Return u
End Select
Return Nothing
End Function
#Region "Downloading"
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso ReadyForDownload AndAlso BaseAuthExists Then
Select Case What
Case Download.Main : Return ACheck(Hash.Value)
Case Download.SavedPosts : Return ACheck(HashSavedPosts.Value)
End Select
End If
Return False
End Function
Private ActiveJobs As Integer = 0
Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download)
If CStr(Hash.Value).IsEmptyString Or HashUpdateRequired Then GatherInstaHash()
ActiveJobs += 1
End Sub
Friend Overrides Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download)
@@ -336,40 +346,8 @@ Namespace API.Instagram
_NextTagged = True
LastDownloadDate.Value = Now
ActiveJobs -= 1
If HashUpdateRequired Then MyMainLOG = "Check your Instagram credentials"
End Sub
#End Region
<PropertyUpdater(NameOf(Hash))>
Friend Function GatherInstaHash() As Boolean
Try
If Not Responser.Cookies.ListExists Then Throw New Exception("Instagram cookies does not set")
Dim rs As New RParams("preload"" href=""(https://static.cdninstagram.com/rsrc.php/[^""]+?.js[^""]*)""", Nothing, 1, RegexReturn.List) With {.MatchTimeOut = 10}
Dim h$
Dim r$ = Responser.GetResponse("https://www.instagram.com",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim JsUrls As List(Of String) = RegexReplace(r, rs)
If JsUrls.ListExists Then
rs = New RParams("\{.+?var h=""([\w\d\S]+?)"".+?\)\.generatePaginationActionCreators", Nothing, 1) With {.MatchTimeOut = 10}
For Each url$ In JsUrls
r = Responser.GetResponse(url,, EDP.ReturnValue)
If Not r.IsEmptyString Then
h = RegexReplace(r, rs)
If Not h.IsEmptyString AndAlso h.Length > 30 Then
Hash.Value = h
HashUpdateRequired.Value = False
Return True
End If
End If
Next
End If
End If
Return False
Catch ex As Exception
HashUpdateRequired.Value = True
Hash.Value = String.Empty
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[SiteSettings.GaterInstaHash]", False)
End Try
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser, Me)
End Function
@@ -379,5 +357,6 @@ Namespace API.Instagram
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
#End Region
End Class
End Namespace

View File

@@ -12,18 +12,20 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports SCrawler.API.Base
Imports System.Threading
Imports System.Net
Imports System.Threading
Imports System.Reflection
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase
Private Const MaxPostsCount As Integer = 200
#Region "XML Names"
Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked"
#End Region
#Region "Declarations"
Private ReadOnly Property MySiteSettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
@@ -34,6 +36,8 @@ Namespace API.Instagram
Private FirstLoadingDone As Boolean = False
Friend Property GetStories As Boolean
Friend Property GetTaggedData As Boolean
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(HOST.Source) With {.GetStories = GetStories, .GetTagged = GetTaggedData}
End Function
@@ -45,6 +49,8 @@ Namespace API.Instagram
End With
End If
End Sub
#End Region
#Region "Initializer, loader"
Friend Sub New()
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -62,7 +68,13 @@ Namespace API.Instagram
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
End If
End Sub
#End Region
#Region "Download data"
Private Class ExitException : Inherits Exception
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
_InstaHash = String.Empty
@@ -80,7 +92,7 @@ Namespace API.Instagram
If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then
DownloadPosts(Token)
ElseIf MySiteSettings.StoriesAndTaggedReady Then
ElseIf MySiteSettings.BaseAuthExists Then
DownloadedTags = 0
If GetStories Then DownloadData(String.Empty, Sections.Stories, Token)
If GetTaggedData Then DownloadData(String.Empty, Sections.Tagged, Token)
@@ -92,14 +104,11 @@ Namespace API.Instagram
End Try
End Sub
Private _InstaHash As String = String.Empty
Friend Enum Sections
Timeline
Tagged
Stories
End Enum
Private Enum Sections : Timeline : Tagged : Stories : End Enum
Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass"
Private Const MaxPostsCount As Integer = 200
Friend Property RequestsCount As Integer = 0
Friend Enum WNM As Integer
Notify = 0
@@ -174,7 +183,7 @@ Namespace API.Instagram
Dim m As New MMessage("You have not entered a valid posts limit", "Tagged posts download limit", {tryBtt, selectBtt, cancelBtt})
Dim mh As New MMessage("", "Tagged posts download limit", {"Confirm", tryBtt, selectBtt, cancelBtt}) With {.ButtonsPerRow = 2}
Do
v = AConvert(Of Integer)(InputBoxE(aStr, "Tagged posts download limit", CInt(MySiteSettings.TaggedNotifyLimit.Value)), Nothing)
v = AConvert(Of Integer)(InputBoxE(aStr, "Tagged posts download limit", CInt(MySiteSettings.TaggedNotifyLimit.Value)), AModes.Var, Nothing)
If v.HasValue Then
mh.Text = $"You have entered a limit of {v.Value.NumToString(p)} posts"
Select Case MsgBoxE(mh).Index
@@ -238,6 +247,7 @@ Namespace API.Instagram
Try
Dim n As EContainer, nn As EContainer, node As EContainer
Dim HasNextPage As Boolean = False
Dim Pinned As Boolean
Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TaggedCount%
@@ -246,8 +256,7 @@ Namespace API.Instagram
'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value)
AuthNullException.ThrowIfNull(Section, IsSavedPosts, MySiteSettings)
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value)
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
@@ -288,7 +297,7 @@ Namespace API.Instagram
RequestsCount += 1
ThrowAny(Token)
'Data
'Parsing
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
n = j.ItemF(ENode).XmlIfNothing
@@ -309,14 +318,18 @@ Namespace API.Instagram
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)
If _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) 'Else _SavedPostsIDs.Add(PostID)
End If
End If
PostID = node.Value("id")
Pinned = CBool(If(node("pinned_for_users")?.Count, 0))
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) And Not Pinned Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
If IsSavedPosts Then
_SavedPostsIDs.Add(PostID)
Else
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
If Not CheckDatesLimit(PostDate, DateProvider) Then Throw New ExitException(_DownloadComplete)
If Not CheckDatesLimit(PostDate, DateProvider) And Not Pinned Then Throw New ExitException(_DownloadComplete)
ObtainMedia(node, PostID, PostDate, SpecFolder)
End If
Next
@@ -330,8 +343,7 @@ Namespace API.Instagram
_TempPostsList.Add(PostID)
ObtainMedia2(nn, PostID, SpecFolder)
DownloadedTags += 1
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then _
Throw New ExitException(_DownloadComplete)
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then Throw New ExitException(_DownloadComplete)
Next
If TaggedLimitsNotifications Then
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0)
@@ -351,9 +363,6 @@ Namespace API.Instagram
End If
_DownloadComplete = True
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token)
Catch iane As AuthNullException
ErrorsDescriber.Execute(EDP.SendInLog, iane)
Throw New ExitException(_DownloadComplete)
Catch eex As ExitException
Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested
@@ -390,7 +399,8 @@ Namespace API.Instagram
Dim e As New ErrorsDescriber(EDP.ThrowException)
For i% = _Index To _SavedPostsIDs.Count - 1
_Index = i
URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1"
'URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1"
URL = $"https://i.instagram.com/api/v1/media/{_SavedPostsIDs(i)}/info/"
ThrowAny(Token)
NextRequest(((i + 1) Mod 5) = 0)
ThrowAny(Token)
@@ -434,6 +444,26 @@ Namespace API.Instagram
End Try
End Sub
#End Region
#Region "Code ID converters"
Friend Shared Function CodeToID(ByVal Code As String) As String
Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
Try
If Not Code.IsEmptyString Then
Dim c As Char
Dim id& = 0
For i% = 0 To Code.Length - 1
c = Code(i)
id = (id * 64) + CodeSymbols.IndexOf(c)
Next
Return id
Else
Return String.Empty
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Instagram.UserData.CodeToID({Code})", String.Empty)
End Try
End Function
#End Region
#Region "Obtain Media"
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String, ByVal SpecFolder As String)
Dim CreateMedia As Action(Of EContainer) =
@@ -536,7 +566,8 @@ Namespace API.Instagram
End Try
End Sub
#End Region
Private Sub GetUserId()
#Region "GetUserId"
<Obsolete> Private Sub GetUserId_Old()
Try
Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, EDP.ThrowException)
If Not r.IsEmptyString Then
@@ -552,6 +583,23 @@ Namespace API.Instagram
End If
End Try
End Sub
Private Sub GetUserId()
Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={Name}",, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
ID = j({"data", "user"}, "id").XmlIfNothingValue
End Using
End If
Catch ex As Exception
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Throw ex
Else
LogError(ex, "get Instagram user id")
End If
End Try
End Sub
#End Region
#Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
@@ -612,11 +660,12 @@ Namespace API.Instagram
End Try
End Function
#End Region
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
#Region "Download content"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
#End Region
#Region "Exceptions"
''' <summary>
''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String)"/><br/>
''' 1 - continue
@@ -629,8 +678,7 @@ Namespace API.Instagram
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
HasError = True
MyMainLOG = $"Instagram credentials have expired: {ToString()} [{s}]"
MySiteSettings.HashUpdateRequired.Value = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
Return 3
ElseIf Responser.StatusCode = 429 Then
@@ -643,13 +691,14 @@ Namespace API.Instagram
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
Else
MySiteSettings.HashUpdateRequired.Value = True
MyMainLOG = $"Instagram hash requested: {ToString()} [{s}]"
MyMainLOG = $"Instagram hash requested [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
Return 2
End Function
#End Region
#Region "Create media"
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
@@ -659,10 +708,13 @@ Namespace API.Instagram
m.SpecialFolder = SpecialFolder
Return m
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)
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)
@@ -679,9 +731,12 @@ Namespace API.Instagram
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Instagram standalone downloader: fetch media error")
End Try
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _SavedPostsIDs.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

View File

@@ -9,9 +9,9 @@
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.XML
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Hosts
Imports System.Threading
Imports SCrawler.API.Reddit.RedditViewExchange
Imports View = SCrawler.API.Reddit.IRedditView.View
Imports Period = SCrawler.API.Reddit.IRedditView.Period
@@ -44,10 +44,12 @@ Namespace API.Reddit
Return ListAddList(Nothing, Posts).ListAddList(PostsLatest).ListSort
End Get
End Property
Private ReadOnly Property Source As IEnumerable(Of UserPost) Implements IRangeSwitcherContainer(Of UserPost).Source
Private Property Source As IEnumerable(Of UserPost) Implements IRangeSwitcherContainer(Of UserPost).Source
Get
Return Posts
End Get
Set(ByVal s As IEnumerable(Of UserPost))
End Set
End Property
Friend Property LatestParsedDate As Date? = Nothing
Private _Downloading As Boolean = False
@@ -110,7 +112,7 @@ Namespace API.Reddit
ChannelExistentUserNames.ListAddList((From p As UserPost In PostsAll
Where Not p.UserID.IsEmptyString AndAlso
Settings.UsersList.Exists(Function(u) u.Site = Site And u.Name = p.UserID)
Select p.UserID), LAP.NotContainsOnly)
Select p.UserID), LNC)
ChannelExistentUserNames.RemoveAll(Function(u) Not Settings.UsersList.Exists(Function(uu) uu.Site = Site And uu.Name = u))
End If
End Sub
@@ -163,7 +165,7 @@ Namespace API.Reddit
If Not ViewMode = View.New And AutoGetLimits Then
Return _DownloadLimitPost
Else
Dim PID$ = ListAddList(Nothing, Posts, LAP.NotContainsOnly).ListAddList(PostsLatest, LAP.NotContainsOnly).ListSort.FirstOrDefault.ID
Dim PID$ = ListAddList(Nothing, Posts, LNC).ListAddList(PostsLatest, LNC).ListSort.FirstOrDefault.ID
If AutoGetLimits And Not PID.IsEmptyString Then
Return PID
Else
@@ -231,11 +233,7 @@ Namespace API.Reddit
Return New Channel(f)
End Operator
Public Overrides Function ToString() As String
If Not Name.IsEmptyString Then
Return Name
Else
Return ID
End If
Return If(Name.IsEmptyString, ID, Name)
End Function
Friend Sub Delete()
File.Delete(, SFODelete.DeleteToRecycleBin)
@@ -259,7 +257,7 @@ Namespace API.Reddit
.DownloadData(Token)
End With
Dim b% = Posts.Count
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
Posts.ListAddList(d.GetNewChannelPosts(), LNC)
If Posts.Count - b > 0 Then CountOfLoadedPostsPerSession.Add(Posts.Count - b)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
@@ -362,8 +360,8 @@ Namespace API.Reddit
UpdateUsersStats()
If Not ViewMode = View.New Then
Dim l As New List(Of String)
If Posts.Count > 0 Or PostsLatest.Count > 0 Then l.ListAddList((From p In PostsAll Where Not p.ID.IsEmptyString Select p.ID), LAP.NotContainsOnly)
l.ListAddList(PostsNames, LAP.NotContainsOnly)
If Posts.Count > 0 Or PostsLatest.Count > 0 Then l.ListAddList((From p In PostsAll Where Not p.ID.IsEmptyString Select p.ID), LNC)
l.ListAddList(PostsNames, LNC)
If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendInLog)
End If
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}

View File

@@ -12,8 +12,16 @@ Imports SCrawler.API.Base
Imports System.Threading
Namespace API.Reddit
Friend Class ChannelsCollection : Implements ICollection(Of Channel), IMyEnumerator(Of Channel), IChannelLimits, IDisposable
Friend Shared ReadOnly Property ChannelsPath As SFile = $"{SettingsFolderName}\Channels\"
Friend Shared ReadOnly Property ChannelsPathCache As SFile = $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\"
Friend Shared ReadOnly Property ChannelsPath As SFile
Get
Return $"{SettingsFolderName}\Channels\"
End Get
End Property
Friend Shared ReadOnly Property ChannelsPathCache As SFile
Get
Return $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\"
End Get
End Property
Private ReadOnly Channels As List(Of Channel)
Friend Structure ChannelImage : Implements IEquatable(Of ChannelImage)
Friend File As SFile
@@ -42,7 +50,7 @@ Namespace API.Reddit
Return Nothing
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex)
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.ChannelsCollection.GetUserFiles]")
End Try
End Function
Friend Sub UpdateUsersStats()
@@ -97,7 +105,7 @@ Namespace API.Reddit
If Item(i).ID = ChannelID Then Return Item(i)
Next
End If
Throw New ArgumentException($"Channel ID [{ChannelID}] does not found in channels collection", "ChannelID") With {.HelpLink = 1}
Throw New ArgumentException($"Channel ID [{ChannelID}] not found in channel collection", "ChannelID") With {.HelpLink = 1}
End Get
End Property
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,

View File

@@ -17,26 +17,8 @@ Namespace API.Reddit
New NodeParams("children", True, True, True)}
Friend ReadOnly UrlBasePattern As RParams = RParams.DM("(?<=/)([^/]+?\.[\w]{3,4})(?=(\?|\Z))", 0)
Friend ReadOnly VideoRegEx As RParams = RParams.DM("http.{0,1}://[^" & Chr(34) & "]+?mp4", 0)
Friend ReadOnly DateProvider As New JsonDate
Friend ReadOnly DateProviderChannel As New JsonDateChannel
Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Cultures.EUR)
Friend Class JsonDate : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicodeJS(Value, NothingArg, e)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
Friend Class JsonDateChannel : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicode(AConvert(Of Integer)(Value, EUR_PROVIDER, Value), NothingArg, e)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicodeJS(v, n, e))
Friend ReadOnly DateProviderChannel As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(AConvert(Of Integer)(v, EUR_PROVIDER, v), n, e))
End Module
End Namespace

View File

@@ -15,12 +15,10 @@ Namespace API.Reddit
Friend Module M3U8_Declarations
Friend ReadOnly BaseUrlPattern As RParams = RParams.DM("([htps:/]{7,8}.+?/.+?)(?=/)", 0, EDP.ReturnValue)
''' <summary>Video</summary>
Friend ReadOnly PlayListRegEx_1 As RParams = RParams.DM("(#EXT-X-STREAM-INF)(.+)(RESOLUTION=)(\d+)(.+?[\r\n]{1,2})(.+?)([\r\n]{1,2})", 0,
RegexReturn.List, EDP.SendInLog, EDP.ReturnValue)
Friend ReadOnly PlayListRegEx_1 As RParams = RParams.DM("(#EXT-X-STREAM-INF)(.+)(RESOLUTION=)(\d+)(.+?[\r\n]{1,2})(.+?)([\r\n]{1,2})", 0, RegexReturn.List)
''' <summary>Audio, Video</summary>
Friend ReadOnly PlayListRegEx_2 As RParams = RParams.DM("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", 0,
RegexReturn.List, EDP.SendInLog, EDP.ReturnValue)
Friend ReadOnly PlayListAudioRegEx As RParams = RParams.DM("(HLS_AUDIO_(\d+)[^""]+)", 0, RegexReturn.List, EDP.SendInLog, EDP.ReturnValue)
Friend ReadOnly PlayListRegEx_2 As RParams = RParams.DM("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", 0, RegexReturn.List)
Friend ReadOnly PlayListAudioRegEx As RParams = RParams.DM("(HLS_AUDIO_(\d+)[^""]+)", 0, RegexReturn.List)
Friend ReadOnly DPED As New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue)
End Module
End Namespace
@@ -80,11 +78,11 @@ Namespace API.Reddit
If Not r.IsEmptyString Then
Dim l As New List(Of Resolution)
If Type = Types.Video Then
l = FNF.RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4})
l = RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4})
Else
Try
l = FNF.RegexFields(Of Resolution)(r, {PlayListAudioRegEx}, {1, 2})
Catch anull As FNF.RegexFieldsTextBecameNullException
l = RegexFields(Of Resolution)(r, {PlayListAudioRegEx}, {1, 2})
Catch anull As RegexFieldsTextBecameNullException
l.Clear()
End Try
End If

View File

@@ -7,17 +7,16 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit
Friend Class RedditViewSettingsForm : Implements IOkCancelToolbar
Private ReadOnly MyDefs As DefaultFormProps
Friend Class RedditViewSettingsForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyOptions As IRedditView
Friend Sub New(ByRef opt As IRedditView)
InitializeComponent()
MyOptions = opt
MyDefs = New DefaultFormProps
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub ChannelSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
@@ -29,10 +28,8 @@ Namespace API.Reddit
End If
If Not n.IsEmptyString Then Text = n
With MyDefs
.MyViewInitialize(Me, Settings.Design, True)
.MyViewInitialize(True)
.AddOkCancelToolbar()
.AppendDetectors()
.DelegateClosingChecker()
Select Case MyOptions.ViewMode
Case CView.Hot : OPT_VIEW_MODE_HOT.Checked = True
Case CView.Top : OPT_VIEW_MODE_TOP.Checked = True
@@ -53,7 +50,7 @@ Namespace API.Reddit
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyOptions
Select Case True
Case OPT_VIEW_MODE_HOT.Checked : .ViewMode = CView.Hot
@@ -71,9 +68,6 @@ Namespace API.Reddit
End With
MyDefs.CloseForm()
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
Private Sub OPT_VIEW_MODE_NEW_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_VIEW_MODE_NEW.CheckedChanged
ChangePeriodEnabled()
End Sub

View File

@@ -9,7 +9,7 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.RegularExpressions
Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download
@@ -30,19 +30,11 @@ Namespace API.Reddit
Friend ReadOnly Property SavedPostsUserName As PropertyValue
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML>
Friend ReadOnly Property UseM3U8 As PropertyValue
Friend Overrides ReadOnly Property Responser As WEB.Response
Friend Sub New()
MyBase.New(RedditSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
MyBase.New(RedditSite, "reddit.com")
With Responser
If .File.Exists Then
.LoadSettings()
Else
.CookiesDomain = "reddit.com"
.Decoders.Add(SymbolsConverter.Converters.Unicode)
.SaveSettings()
End If
If .Decoders.Count = 0 OrElse Not .Decoders.Contains(SymbolsConverter.Converters.Unicode) Then _
.Decoders.Add(SymbolsConverter.Converters.Unicode) : .SaveSettings()
End With
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UseM3U8 = New PropertyValue(True)
@@ -109,5 +101,8 @@ Namespace API.Reddit
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
Return $"https://www.reddit.com/comments/{PostID.Split("_").LastOrDefault}/"
End Function
End Class
End Namespace

View File

@@ -58,7 +58,7 @@ Namespace API.Reddit
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
#End Region
Friend Property ChannelInfo As Channel
Private ReadOnly ChannelPostsNames As New List(Of String)
Private ReadOnly ChannelPostsNames As List(Of String)
Friend Property SkipExistsUsers As Boolean = True Implements IChannelData.SkipExistsUsers
Private ReadOnly _ExistsUsersNames As List(Of String)
Friend Property SaveToCache As Boolean = False Implements IChannelData.SaveToCache
@@ -150,6 +150,7 @@ Namespace API.Reddit
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
'If Not IsSavedPosts AndAlso (Not IsChannel OrElse ChannelInfo Is Nothing) Then ReparseMissing(Token)
If IsSavedPosts Then
DownloadDataChannel(String.Empty, Token)
ElseIf IsChannel Then
@@ -507,6 +508,72 @@ Namespace API.Reddit
ProcessException(ex, Token, "video reparsing error", False)
End Try
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If _ContentList.Exists(MissingFinder) Then
Dim m As UserMedia
Dim j As EContainer, ss As EContainer
Dim r$, tmpUrl$, PostDate$, _UserID$
Dim err As New ErrorsDescriber(EDP.ReturnValue)
Dim node As Object() = {"data", "children", 0, "data"}
Dim eCount As Predicate(Of EContainer) = Function(e) e.Count > 0
Dim cItems As Predicate(Of EContainer) = Function(e) If(e.ItemF(node)?.Count, 0) > 0
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, err)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, err)
If Not j Is Nothing Then
If j.Contains(cItems) Then
With j.ItemF({cItems}).ItemF(node)
If .Contains("created") Then PostDate = .Item("created").Value Else PostDate = String.Empty
_UserID = .Value("author")
tmpUrl = .Value("url")
If Not tmpUrl.IsEmptyString AndAlso tmpUrl.StringContains({"redgifs.com", "gfycat.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
ElseIf Not .Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
tmpUrl = .Value({"media", "reddit_video"}, "fallback_url")
If UseM3U8 AndAlso Not .Value({"media", "reddit_video"}, "hls_url").IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, .Value({"media", "reddit_video"}, "hls_url"),
m.Post.ID, PostDate, _UserID, IsChannel), LNC)
Else
'_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre + UTypes.m3u8, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
ElseIf CreateImgurMedia(tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel) Then
_TotalPostsDownloaded += 1
ElseIf If(.Item("media_metadata")?.Count, 0) > 0 Then
DownloadGallery(.Self, m.Post.ID, PostDate, _UserID, SaveToCache)
_TotalPostsDownloaded += 1
ElseIf .Contains("preview") Then
ss = .ItemF({"preview", "images", eCount, "source", "url"}).XmlIfNothing
If Not ss.Value.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, ss.Value, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
End If
End With
End If
j.Dispose()
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.Contains("redgifs") Then
@@ -561,6 +628,8 @@ Namespace API.Reddit
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then
MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim IsImgurStuff As Boolean
Dim MyDir$
If Not IsSavedPosts AndAlso (IsChannel And SaveToCache And Not ChannelInfo Is Nothing) Then
MyDir = ChannelInfo.CachePath.PathNoSeparator
@@ -629,7 +698,7 @@ Namespace API.Reddit
Dim m$
Using w As New WebClient
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
Progress.TotalCount += _ContentNew.Count
Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1
ThrowAny(Token)
v = _ContentNew(i)
@@ -651,6 +720,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
Do
If Not cached And Not m.IsEmptyString Then HashList.Add(m)
v.MD5 = m
@@ -664,6 +734,7 @@ Namespace API.Reddit
f = SFile.Indexed_IndexFile(f,,, EDP.ReturnValue)
End If
End If
If f.Extension = "webp" And Settings.DownloadNativeImageFormat Then f.Extension = "jpg"
f.Path = MyDir
Try
If (v.Type = UTypes.Video Or v.Type = UTypes.m3u8 Or (ImgurUrls.Count > 0 AndAlso f.Extension = "mp4")) And
@@ -694,7 +765,11 @@ Namespace API.Reddit
dCount += 1
End If
Catch wex As Exception
If Not IsChannel Then ErrorDownloading(f, v.URL)
If Not IsChannel Then
If Not IsImgurStuff And MissingErrorsAdd Then ErrorDownloading(f, v.URL)
v.Attempts += 1
v.State = UStates.Missing
End If
End Try
If ImgurUrls.Count > 0 Then ImgurUrls.RemoveAt(0)
Loop While ImgurUrls.Count > 0
@@ -728,9 +803,10 @@ Namespace API.Reddit
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then
UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Or
Responser.StatusCode = HttpStatusCode.GatewayTimeout Then
MyMainLOG = $"Reddit is currently unavailable ({ToString()})"
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
ElseIf Responser.StatusCode = HttpStatusCode.GatewayTimeout Then
Return 1
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0

View File

@@ -9,15 +9,6 @@
Namespace API.RedGifs
Friend Module Declarations
Friend Const RedGifsSite As String = "RedGifs"
Friend ReadOnly DateProvider As New JsonDate
Friend Class JsonDate : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicode(Value, NothingArg, e)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v, n, e))
End Module
End Namespace

View File

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

View File

@@ -9,10 +9,11 @@
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Threading
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
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()
@@ -20,6 +21,7 @@ Namespace API.RedGifs
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ReparseMissing(Token)
DownloadData(1, Token)
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)
@@ -29,8 +31,6 @@ Namespace API.RedGifs
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Dim postDate$, postID$
Dim pTotal% = 0
Dim u$
Dim ut As UTypes
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("gifs") Then
@@ -40,21 +40,7 @@ Namespace API.RedGifs
If Not CheckDatesLimit(postDate, DateProvider) Then Exit Sub
postID = g.Value("id")
If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit For
With g("urls")
If .ListExists Then
u = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
If Not u.IsEmptyString Then
ut = UTypes.Undefined
'Type 1: video
'Type 2: image
Select Case g.Value("type").FromXML(Of Integer)(0)
Case 1 : ut = UTypes.Video
Case 2 : ut = UTypes.Picture
End Select
If Not ut = UTypes.Undefined Then _TempMediaList.ListAddValue(MediaFromData(ut, u, postID, postDate))
End If
End If
End With
ObtainMedia(g, postID, postDate)
Next
End If
End Using
@@ -64,16 +50,84 @@ Namespace API.RedGifs
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Private Sub ObtainMedia(ByVal j As EContainer, ByVal PostID As String,
Optional ByVal PostDateStr As String = Nothing, Optional ByVal PostDateDate As Date? = Nothing,
Optional ByVal State As UStates = UStates.Unknown)
With j("urls")
If .ListExists Then
Dim u$ = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
If Not u.IsEmptyString Then
Dim ut As UTypes = UTypes.Undefined
'Type 1: video
'Type 2: image
Select Case j.Value("type").FromXML(Of Integer)(0)
Case 1 : ut = UTypes.Video
Case 2 : ut = UTypes.Picture
End Select
If Not ut = UTypes.Undefined Then _TempMediaList.ListAddValue(MediaFromData(ut, u, PostID, PostDateStr, PostDateDate, State))
End If
End If
End With
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If _ContentList.Exists(MissingFinder) Then
Dim url$, r$
Dim u As UserMedia
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
If _ContentList(i).State = UserMedia.States.Missing Then
ThrowAny(Token)
u = _ContentList(i)
If Not u.Post.ID.IsEmptyString Then
url = $"https://api.redgifs.com/v2/gifs/{u.Post.ID}?views=yes&users=yes"
Try
r = Responser.GetResponse(url,, EDP.ThrowException)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
If If(j("gif")?.Count, 0) > 0 Then
ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing)
rList.Add(i)
End If
End If
End If
Catch down_ex As Exception
u.Attempts += 1
_ContentList(i) = u
End Try
Else
rList.Add(i)
End If
End If
Next
End If
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
ProcessException(ex, Token, $"missing data downloading error")
Finally
If Not Disposed And rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
End If
End Try
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String) As UserMedia
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String,
ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
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 PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateProvider, Nothing) Else m.Post.Date = Nothing
If Not PostDateStr.IsEmptyString Then
m.Post.Date = AConvert(Of Date)(PostDateStr, DateProvider, Nothing)
ElseIf PostDateDate.HasValue Then
m.Post.Date = PostDateDate
Else
m.Post.Date = Nothing
End If
m.State = State
Return m
End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer

View File

@@ -6,11 +6,11 @@
'
' 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.Tools
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.RegularExpressions
Imports SCrawler.API.Base
Namespace API.Twitter
<Manifest("AndyProgram_Twitter"), SavedPosts, UseClassAsIs>
Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -33,16 +33,17 @@ Namespace API.Twitter
Private ReadOnly Property Token As PropertyValue
<PropertyOption(ControlText:="Saved posts user name", ControlToolTip:="Personal profile username", LeftOffset:=120), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend Overrides ReadOnly Property Responser As WEB.Response
Friend Overrides ReadOnly Property Responser As Response
Friend Sub New()
MyBase.New(TwitterSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml")
Dim a$ = String.Empty
Dim t$ = String.Empty
With Responser
If .File.Exists Then
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.LoadSettings()
With .Headers
If .ContainsKey(Header_Authorization) Then a = .Item(Header_Authorization)
@@ -52,11 +53,11 @@ Namespace API.Twitter
.ContentType = "application/json"
.Accept = "*/*"
.CookiesDomain = "twitter.com"
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.Decoders.Add(SymbolsConverter.Converters.Unicode)
With .Headers
.Add("sec-ch-ua", " Not;A Brand" & Chr(34) & ";v=" & Chr(34) & "99" & Chr(34) & ", " & Chr(34) &
"Google Chrome" & Chr(34) & ";v=" & Chr(34) & "91" & Chr(34) & ", " & Chr(34) & "Chromium" &
Chr(34) & ";v=" & Chr(34) & "91" & Chr(34))
.Add("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
.Add("sec-ch-ua-mobile", "?0")
.Add("sec-fetch-dest", "empty")
.Add("sec-fetch-mode", "cors")
@@ -102,5 +103,8 @@ Namespace API.Twitter
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
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
End Class
End Namespace

View File

@@ -13,6 +13,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase
#Region "Declarations"
@@ -33,6 +34,7 @@ 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)
'ReparseMissing(Token)
End If
End Sub
Private Overloads Sub DownloadData(ByVal POST As String, ByVal Token As CancellationToken)
@@ -41,8 +43,8 @@ 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 m As EContainer, nn As EContainer, s As EContainer
Dim PostDate$ ', dName$
Dim nn As EContainer, s As EContainer ', m As EContainer
Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False
@@ -63,7 +65,7 @@ Namespace API.Twitter
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r)
If Not w Is Nothing AndAlso w.Count > 0 Then
If w.ListExists Then
For Each nn In If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, w)
ThrowAny(Token)
If nn.Count > 0 Then
@@ -96,22 +98,23 @@ Namespace API.Twitter
If IsSavedPosts OrElse Not ParseUserMediaOnly OrElse (Not nn.Contains("retweeted_status") OrElse
(Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then
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
'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
End If
Next
@@ -136,13 +139,67 @@ Namespace API.Twitter
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try
End Sub
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown)
If Not CheckVideoNode(e, PostID, PostDate) Then
Dim s As EContainer = e.ItemF({"extended_entities", "media"})
If s Is Nothing OrElse s.Count = 0 Then s = e.ItemF({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) > 0 Then
For Each m In s
If m.Contains("media_url") Then
Dim dName$ = UrlFile(m("media_url").Value)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(m("media_url").Value,
PostID, PostDate, GetPictureOption(m), State), LNC)
End If
End If
Next
End If
End If
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim r$, PostDate$
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
URL = $"https://api.twitter.com/1.1/statuses/show.json?id={m.Post.ID}"
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, UStates.Missing)
rList.Add(i)
End If
End If
End If
End If
Next
End If
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)
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
@@ -163,7 +220,7 @@ Namespace API.Twitter
Const P4K As String = "4096x4096"
Try
Dim ww As EContainer = w("sizes")
If Not ww Is Nothing AndAlso ww.Count > 0 Then
If ww.ListExists Then
Dim l As New List(Of Sizes)
Dim Orig As Sizes? = New Sizes(w.Value({"original_info"}, "height").FromXML(Of Integer)(-1), P4K)
If Orig.Value.Value = -1 Then Orig = Nothing
@@ -176,7 +233,7 @@ Namespace API.Twitter
If Orig.HasValue AndAlso l(0).Value < Orig.Value.Value Then
Return P4K
ElseIf l(0).Data.IsEmptyString Then
If LargeContained Then Return "large" Else Return P4K
Return P4K
Else
Return l(0).Data
End If
@@ -197,6 +254,7 @@ Namespace API.Twitter
#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
Dim URL$ = GetVideoNodeURL(w)
If Not URL.IsEmptyString Then
Dim f$ = UrlFile(URL)
@@ -212,9 +270,44 @@ 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
Try
Dim gifUrl As Predicate(Of EContainer) = Function(e) Not e.Value("content_type").IsEmptyString AndAlso
e.Value("content_type").Contains("mp4") AndAlso
Not e.Value("url").IsEmptyString
Dim url$, ff$
Dim f As SFile
Dim m As UserMedia
With w({"extended_entities", "media"})
If .ListExists Then
For Each n As EContainer In .Self
If n.Value("type") = "animated_gif" Then
With n({"video_info", "variants"}).XmlIfNothing.ItemF({gifUrl}).XmlIfNothing
url = .Value("url")
ff = UrlFile(url)
If Not ff.IsEmptyString Then
If Not _DataNames.Contains(ff) Then
m = MediaFromData(url, PostID, PostDate)
f = m.File
If Not f.IsEmptyString Then f.Name = $"GIF_{f.Name}" : m.File = f
_TempMediaList.ListAddValue(m, LNC)
End If
Return True
End If
End With
End If
Next
End If
End With
Return False
Catch ex As Exception
LogError(ex, "[API.Twitter.UserData.CheckForGif]")
Return False
End Try
End Function
Private Shared Function GetVideoNodeURL(ByVal w As EContainer) As String
Dim v As EContainer = w.GetNode(VideoNode)
If Not v Is Nothing AndAlso v.Count > 0 Then
If v.ListExists Then
Dim l As New List(Of Sizes)
Dim u$
Dim nn As EContainer
@@ -233,8 +326,6 @@ Namespace API.Twitter
End If
Return String.Empty
End Function
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Private Function UrlFile(ByVal URL As String) As String
Try
Dim f As SFile = CStr(RegexReplace(LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern)), FilesPattern))
@@ -245,7 +336,8 @@ Namespace API.Twitter
End Function
#End Region
Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _PictureOption As String = "") As UserMedia
Optional ByVal _PictureOption As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
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))
@@ -253,6 +345,7 @@ Namespace API.Twitter
m.URL_BASE = $"{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

View File

@@ -79,7 +79,7 @@ Namespace API
If Count > 0 Then
Return Collections(0).GetPicture
Else
Return GetNullPicture(Settings.MaxLargeImageHeigh)
Return GetNullPicture(Settings.MaxLargeImageHeight)
End If
End Function
#End Region
@@ -92,6 +92,11 @@ Namespace API
End If
End Get
End Property
Friend Overrides ReadOnly Property ContentMissingExists As Boolean
Get
Return Count > 0 AndAlso Collections.Exists(Function(c) DirectCast(c, UserDataBase).ContentMissingExists)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements ICollection(Of IUserData).Count, IMyEnumerator(Of IUserData).MyEnumeratorCount
Get
If Collections Is Nothing Then
@@ -191,10 +196,10 @@ Namespace API
Friend Overrides Property LastUpdated As Date?
Get
If Count > 0 Then
With If((From c As IUserData In Collections
Where DirectCast(c, UserDataBase).LastUpdated.HasValue
Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
If .Count > 0 Then Return .Max
With (From c As IUserData In Collections
Where DirectCast(c, UserDataBase).LastUpdated.HasValue
Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList
If .ListExists Then Return .Max
End With
End If
Return Nothing
@@ -267,6 +272,7 @@ Namespace API
End Property
#End Region
#End Region
#Region "Initializers"
Friend Sub New()
_IsCollection = True
Collections = New List(Of IUserData)
@@ -276,17 +282,21 @@ Namespace API
Me.New
CollectionName = _Name
End Sub
#End Region
#Region "Load, Update"
Friend Overrides Sub LoadUserInformation()
If Count > 0 Then Collections.ForEach(Sub(c) c.LoadUserInformation())
End Sub
Friend Overrides Sub UpdateUserInformation()
If Count > 0 Then Collections.ForEach(Sub(c) c.UpdateUserInformation())
End Sub
Friend Overrides Sub LoadContentInformation()
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation())
Friend Overrides Sub LoadContentInformation(Optional ByVal Force As Boolean = False)
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation(Force))
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Download"
Friend Overrides Property DownloadTopCount As Integer?
Get
If Count > 0 Then
@@ -304,16 +314,16 @@ Namespace API
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub ReparseVideo(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
Return 0
End Function
Private Sub User_OnUserUpdated(ByVal User As IUserData)
RaiseEvent_OnUserUpdated()
OnUserUpdated()
End Sub
#End Region
#Region "Open site, folder"
Friend Overrides Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
If Not e.Exists Then e = New ErrorsDescriber(EDP.SendInLog)
If Count > 0 Then Collections.ForEach(Sub(c) c.OpenSite(e))
@@ -321,9 +331,10 @@ Namespace API
Friend Overrides Sub OpenFolder()
Try
If Count > 0 Then GlobalOpenPath(Collections(0).File.CutPath(2))
Catch ex As Exception
Catch
End Try
End Sub
#End Region
#Region "ICollection Support"
Default Friend ReadOnly Property Item(ByVal Index As Integer) As IUserData Implements IMyEnumerator(Of IUserData).MyEnumeratorObject
Get
@@ -351,9 +362,9 @@ Namespace API
ConsolidateScripts()
.UpdateUserInformation()
End If
ImageHandler(_Item, False)
MainFrameObj.ImageHandler(_Item, False)
AddRemoveBttDeleteHandler(.Self, True)
AddHandler .Self.OnUserUpdated, AddressOf User_OnUserUpdated
AddHandler .Self.UserUpdated, AddressOf User_OnUserUpdated
End With
Else
Throw New InvalidOperationException("User data was not moved to the collection folder")
@@ -367,7 +378,7 @@ Namespace API
With Collections.Last
If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
AddRemoveBttDeleteHandler(.Self, True)
AddHandler .OnUserUpdated, AddressOf User_OnUserUpdated
AddHandler .UserUpdated, AddressOf User_OnUserUpdated
End With
Else
Collections.RemoveAt(Count - 1)
@@ -398,7 +409,7 @@ Namespace API
If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True)
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If Not _Items Is Nothing AndAlso _Items.Count > 0 Then
If _Items.ListExists Then
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
End If
End Sub
@@ -433,7 +444,7 @@ Namespace API
Collections.ListClearDispose
End Sub
Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains
Return Collections.Contains(_Item)
Return Count > 0 AndAlso Collections.Contains(_Item)
End Function
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")
@@ -446,7 +457,7 @@ Namespace API
Return False
Else
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty)
ImageHandler(_Item)
MainFrameObj.ImageHandler(_Item)
AddRemoveBttDeleteHandler(_Item, False)
RaiseEvent OnUserRemoved(_Item)
Return Collections.Remove(_Item)
@@ -461,7 +472,7 @@ Namespace API
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) c.Delete())
Downloader.UserRemove(Me)
ImageHandler(Me, False)
MainFrameObj.ImageHandler(Me, False)
Collections.ListClearDispose
Dispose(False)
f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
@@ -479,12 +490,12 @@ Namespace API
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c)
c.MoveFiles(String.Empty)
ImageHandler(c)
MainFrameObj.ImageHandler(c)
End Sub)
Collections.Clear()
f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
Downloader.UserRemove(Me)
ImageHandler(Me, False)
MainFrameObj.ImageHandler(Me, False)
Dispose(False)
Return 3
Else
@@ -503,7 +514,7 @@ Namespace API
Dim RemoveMeIfNull As Action = Sub()
If Count = 0 Then
Settings.Users.Remove(Me)
ImageHandler(Me, False)
MainFrameObj.ImageHandler(Me, False)
RaiseEvent OnCollectionSelfRemoved(Me)
Dispose(False)
End If

View File

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

View File

@@ -120,15 +120,12 @@
<metadata name="SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="SEP_3.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="CONTEXT_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="CONTEXT_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>241, 17</value>
</metadata>
@@ -141,9 +138,6 @@
<metadata name="LCONTEXT.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>342, 17</value>
</metadata>
<metadata name="CONTEXT_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>

View File

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

View File

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

View File

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

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 345 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.3 KiB

View File

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

View File

@@ -23,8 +23,8 @@ Namespace DownloadObjects
Friend Sub New()
InitializeComponent()
JobsList = New List(Of DownloadProgress)
AddHandler Downloader.OnReconfigured, AddressOf Downloader_OnReconfigured
Downloader_OnReconfigured()
AddHandler Downloader.Reconfigured, AddressOf Downloader_Reconfigured
Downloader_Reconfigured()
End Sub
Private Sub ActiveDownloadingProgress_Load(sender As Object, e As EventArgs) Handles Me.Load
MyView = New FormsView(Me)
@@ -37,14 +37,13 @@ Namespace DownloadObjects
e.Cancel = True
Hide()
End Sub
Private Sub Downloader_OnReconfigured()
Private Sub Downloader_Reconfigured()
Const RowHeight% = 30
Dim a As Action = Sub()
With TP_MAIN
If .Controls.Count > 0 Then
For Each c As Control In .Controls
If Not c Is Nothing Then c.Dispose()
Next
.Controls.Clear()
End If
@@ -59,7 +58,7 @@ Namespace DownloadObjects
.RowStyles.Add(New RowStyle(SizeType.Absolute, RowHeight))
.RowCount += 1
JobsList.Add(New DownloadProgress(j))
AddHandler JobsList.Last.OnTotalCountChange, AddressOf Jobs_OnTotalCountChange
AddHandler JobsList.Last.ProgressMaximumChanged, AddressOf Jobs_ProgressMaximumChanged
.Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1)
End With
Next
@@ -75,11 +74,11 @@ Namespace DownloadObjects
End Sub
If TP_MAIN.InvokeRequired Then TP_MAIN.Invoke(a) Else a.Invoke
End Sub
Private Sub Jobs_OnTotalCountChange()
Private Sub Jobs_ProgressMaximumChanged()
If JobsList.Count > 0 And Not DisableProgressChange Then
MainProgress.TotalCount = JobsList.Sum(Function(j) CLng(j.Job.Progress.TotalCount))
MainProgress.CurrentCounter = Math.Max(JobsList.Sum(Function(j) CLng(j.Job.Progress.CurrentCounter)) - 1, 0)
If MainProgress.CurrentCounter > 0 Then MainProgress.Perform()
MainProgress.Maximum = JobsList.Sum(Function(j) CLng(j.Job.Progress.Maximum))
MainProgress.Value = Math.Max(JobsList.Sum(Function(j) CLng(j.Job.Progress.Value)) - 1, 0)
If MainProgress.Value > 0 Then MainProgress.Perform()
End If
End Sub
End Class

View File

@@ -8,13 +8,19 @@
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Notifications
Imports SCrawler.DownloadObjects.Groups
Imports SCrawler.API
Imports SCrawler.API.Base
Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters
Friend Event UserFind(ByVal Key As String, ByVal Activate As Boolean)
Friend Class AutoDownloader : Inherits GroupParameters : Implements IEContainerProvider
Private Shared ReadOnly Property CachePath As SFile
Get
Return Settings.CachePath
End Get
End Property
Friend Enum Modes As Integer
None = 0
[Default] = 1
@@ -31,60 +37,84 @@ Namespace DownloadObjects
Private ReadOnly UserKeys As List(Of NotifiedUser)
Private Class NotifiedUser : Implements IDisposable
Private ReadOnly Property User As IUserData
Friend ReadOnly Property IUserDataKey As String
Private ReadOnly Property Key As String
Private ReadOnly Property KeyFolder As String
Private ReadOnly Property KeySite As String
Private ReadOnly Property KeyDismiss As String
Private ReadOnly Property Images As Dictionary(Of String, SFile)
Private ReadOnly Property AutoDownloaderSource As AutoDownloader
Private Sub New()
Images = New Dictionary(Of String, SFile)
End Sub
Friend Sub New(ByVal _Key As String)
Private Sub New(ByVal _Key As String)
Me.New
Key = _Key
KeyFolder = $"{Key}{KeyOpenFolder}"
KeySite = $"{Key}{KeyOpenSite}"
KeyDismiss = $"{Key}{KeyBttDismiss}"
End Sub
Friend Sub New(ByVal _Key As String, ByRef _User As IUserData)
Friend Sub New(ByVal _Key As String, ByRef _User As IUserData, ByRef Source As AutoDownloader)
Me.New(_Key)
User = _User
IUserDataKey = _User.Key
AutoDownloaderSource = Source
If _User.IncludedInCollection Then
Dim cn$ = _User.CollectionName
Dim i% = Settings.Users.FindIndex(Function(u) u.IsCollection And u.Name = cn)
If i >= 0 Then IUserDataKey = Settings.Users(i).Key
End If
End Sub
Public Shared Widening Operator CType(ByVal Key As String) As NotifiedUser
Return New NotifiedUser(Key)
End Operator
Friend Sub ShowNotification()
Try
If Not User Is Nothing Then
Dim Text$ = $"{User.Site} - {User.Name}{vbNewLine}" &
$"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos"
Dim Title$
If Not User.CollectionName.IsEmptyString Then
Title = User.CollectionName
Else
Title = User.ToString
End If
Using Notify As New Notification(Text, Title) With {.Key = Key}
Dim uPic As SFile = DirectCast(User, UserDataBase).GetUserPictureAddress
Dim uif As SFile = Nothing
Dim uifKey$ = String.Empty
If uPic.Exists Then Notify.Images = {New ToastImage(uPic)}
If User.DownloadedPictures(False) > 0 Then
uif = DirectCast(User, UserDataBase).GetLastImageAddress
If uif.Exists Then
Notify.Images = {New ToastImage(uif, IImage.Modes.Inline)}
uifKey = $"{Key}_{Images.Keys.Count + 1}_{KeyBttPhoto}"
If Not Images.ContainsKey(uifKey) Then Images.Add(uifKey, uif)
If Not AutoDownloaderSource Is Nothing Then
If AutoDownloaderSource.ShowNotifications Then
If Not User Is Nothing Then
Dim Text$ = $"{User.Site} - {User.Name}{vbNewLine}" &
$"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos"
Dim Title$
If Not User.CollectionName.IsEmptyString Then
Title = User.CollectionName
Else
Title = User.ToString
End If
Using Notify As New Notification(Text, Title) With {.Key = Key}
Dim uPic As SFile = Nothing
Dim uif As SFile = Nothing
Dim uif_compressed As SFile = Nothing
Dim uifKey$ = String.Empty
If AutoDownloaderSource.ShowPictureUser Then uPic = DirectCast(User, UserDataBase).GetUserPictureToastAddress
If AutoDownloaderSource.ShowPictureUser AndAlso uPic.Exists Then Notify.Images = {New ToastImage(uPic)}
If AutoDownloaderSource.ShowPictureDownloaded And User.DownloadedPictures(False) > 0 Then
uif = DirectCast(User, UserDataBase).GetLastImageAddress
If uif.Exists Then
uif_compressed = uif
uif_compressed.Path = CachePath.Path
uif_compressed.Name = $"360_{uif.Name}"
Using imgR As New ImageRenderer(uif, EDP.SendInLog)
Try : imgR.FitToWidth(360).Save(uif_compressed) : Catch : End Try
End Using
If uif_compressed.Exists Then uif = uif_compressed
If uif.Exists Then
Notify.Images = {New ToastImage(uif, IImage.Modes.Inline)}
uifKey = $"{Key}_{Images.Keys.Count + 1}_{KeyBttPhoto}"
If Not Images.ContainsKey(uifKey) Then Images.Add(uifKey, uif)
End If
End If
End If
Notify.Buttons = {
New ToastButton(KeyFolder, "Folder"),
New ToastButton(KeySite, "Site")
}
If Not uifKey.IsEmptyString Then Notify.Buttons = {New ToastButton(uifKey, "Photo")}
Notify.Buttons = {New ToastButton(KeyDismiss, "Dismiss")}
Notify.Show()
End Using
End If
Notify.Buttons = {
New ToastButton(KeyFolder, "Folder"),
New ToastButton(KeySite, "Site")
}
If Not uifKey.IsEmptyString Then Notify.Buttons = {New ToastButton(uifKey, "Photo")}
Notify.Buttons = {New ToastButton(KeyDismiss, "Dismiss")}
Notify.Show()
End Using
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[AutoDownloader.NotifiedUser.ShowNotification]")
@@ -138,37 +168,126 @@ Namespace DownloadObjects
Private Const Name_Groups As String = "Groups"
Private Const Name_Labels As String = "Labels"
Private Const Name_Timer As String = "Timer"
Private Const Name_StartupDelay As String = "StartupDelay"
Private Const Name_LastDownloadDate As String = "LastDownloadDate"
Private Const Name_ShowNotifications As String = "Notify"
Private Const Name_ShowPictureDown As String = "ShowDownloadedPicture"
Private Const Name_ShowPictureUser As String = "ShowUserPicture"
Private Const Name_ShowSimpleNotification As String = "ShowSimpleNotification"
#End Region
#Region "Declarations"
Friend Property Mode As Modes = Modes.None
Friend Property Source As Scheduler
Private _Mode As Modes = Modes.None
Friend Property Mode As Modes
Get
Return _Mode
End Get
Set(ByVal m As Modes)
_Mode = m
If _Mode = Modes.None Then [Stop]()
End Set
End Property
Friend ReadOnly Property Groups As List(Of String)
Friend Property Timer As Integer = DefaultTimer
Friend Property StartupDelay As Integer = 0
Friend Property ShowNotifications As Boolean = True
Friend Property LastDownloadDate As Date = Now.AddYears(-1)
Friend Property ShowPictureDownloaded As Boolean = True
Friend Property ShowPictureUser As Boolean = True
Friend Property ShowSimpleNotification As Boolean = False
#Region "Date"
Private ReadOnly LastDownloadDateXML As Date? = Nothing
Private _LastDownloadDate As Date = Now.AddYears(-1)
Private _LastDownloadDateChanged As Boolean = False
Friend Property LastDownloadDate As Date
Get
Return _LastDownloadDate
End Get
Set(ByVal d As Date)
_LastDownloadDate = d
If Not Initialization Then _LastDownloadDateChanged = True
End Set
End Property
Private ReadOnly DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Private File As SFile = $"Settings\AutoDownload.xml"
Private AThread As Thread
Private Function GetLastDateString() As String
If LastDownloadDateXML.HasValue Or _LastDownloadDateChanged Then
Return LastDownloadDate.ToStringDate(ADateTime.Formats.BaseDateTime)
Else
Return "never"
End If
End Function
Private Function GetNextDateString() As String
If _LastDownloadDateChanged Then
Return LastDownloadDate.AddMinutes(Timer).ToStringDate(ADateTime.Formats.BaseDateTime)
Else
Return _StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)
End If
End Function
#End Region
#Region "Information"
Friend ReadOnly Property Information As String
Get
Return $"Last download date: {GetLastDateString()} ({GetWorkingState()})"
End Get
End Property
Private Function GetWorkingState() As String
Dim OutStr$
If Working Then
If StartupDelay > 0 And _StartTime.AddMinutes(StartupDelay) > Now Then
OutStr = $"delayed until {_StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)}"
ElseIf _StopRequested Then
OutStr = "stopping"
Else
OutStr = "working"
End If
If Pause Then OutStr &= ", paused"
Else
OutStr = "stopped"
End If
Return OutStr
End Function
Public Overrides Function ToString() As String
Return $"{Name} ({GetWorkingState()}): last download date: {GetLastDateString()}; next run: {GetNextDateString()}"
End Function
#End Region
#End Region
#Region "Initializer"
Friend Sub New()
Private ReadOnly Initialization As Boolean = True
Private _IsNewPlan As Boolean = False
Friend ReadOnly Property IsNewPlan As Boolean
Get
Return _IsNewPlan
End Get
End Property
Friend Sub New(Optional ByVal IsNewPlan As Boolean = False)
Groups = New List(Of String)
UserKeys = New List(Of NotifiedUser)
If File.Exists Then
Using x As New XmlFile(File)
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly)
Labels.ListAddList(x.Value(Name_Labels).StringToList(Of String)("|"), LAP.NotContainsOnly)
Temporary = x.Value(Name_Temporary).FromXML(Of Integer)(CheckState.Indeterminate)
Favorite = x.Value(Name_Favorite).FromXML(Of Integer)(CheckState.Indeterminate)
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
ReadyForDownloadIgnore = x.Value(Name_ReadyForDownloadIgnore).FromXML(Of Boolean)(False)
Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer)
ShowNotifications = x.Value(Name_ShowNotifications).FromXML(Of Boolean)(True)
LastDownloadDate = AConvert(Of Date)(x.Value(Name_LastDownloadDate), DateProvider, Now.AddYears(-1))
End Using
_IsNewPlan = IsNewPlan
End Sub
Friend Sub New(ByVal x As EContainer)
Me.New
Name = x.Value(Name_Name).FromXML(Of String)("Default")
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly)
Labels.ListAddList(x.Value(Name_Labels).StringToList(Of String)("|"), LAP.NotContainsOnly)
Temporary = x.Value(Name_Temporary).FromXML(Of Integer)(CheckState.Indeterminate)
Favorite = x.Value(Name_Favorite).FromXML(Of Integer)(CheckState.Indeterminate)
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
ReadyForDownloadIgnore = x.Value(Name_ReadyForDownloadIgnore).FromXML(Of Boolean)(False)
Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer)
If Timer <= 0 Then Timer = DefaultTimer
StartupDelay = x.Value(Name_StartupDelay).FromXML(Of Integer)(0)
If StartupDelay < 0 Then StartupDelay = 0
ShowNotifications = x.Value(Name_ShowNotifications).FromXML(Of Boolean)(True)
ShowPictureDownloaded = x.Value(Name_ShowPictureDown).FromXML(Of Boolean)(True)
ShowPictureUser = x.Value(Name_ShowPictureUser).FromXML(Of Boolean)(True)
ShowSimpleNotification = x.Value(Name_ShowSimpleNotification).FromXML(Of Boolean)(False)
LastDownloadDateXML = AConvert(Of Date)(x.Value(Name_LastDownloadDate), DateProvider, Nothing)
If LastDownloadDateXML.HasValue Then
LastDownloadDate = LastDownloadDateXML.Value
Else
LastDownloadDate = Now.AddYears(-1)
End If
Initialization = False
End Sub
#End Region
#Region "Groups Support"
@@ -187,41 +306,63 @@ Namespace DownloadObjects
#End Region
#Region "Update"
Friend Sub Update()
Try
Using x As New XmlFile With {.Name = "Settings"}
x.Add(Name_Mode, CInt(Mode))
x.Add(Name_Groups, Groups.ListToString("|"))
x.Add(Name_Labels, Labels.ListToString("|"))
x.Add(Name_Temporary, CInt(Temporary))
x.Add(Name_Favorite, CInt(Favorite))
x.Add(Name_ReadyForDownload, ReadyForDownload.BoolToInteger)
x.Add(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger)
x.Add(Name_Timer, Timer)
x.Add(Name_ShowNotifications, ShowNotifications.BoolToInteger)
x.Add(Name_LastDownloadDate, CStr(AConvert(Of String)(LastDownloadDate, DateProvider, String.Empty)))
x.Save(File)
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[AutoDownloader.Update]")
End Try
If Not Source Is Nothing Then Source.Update()
End Sub
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer(Scheduler.Name_Plan, String.Empty) From {
New EContainer(Name_Name, Name),
New EContainer(Name_Mode, CInt(Mode)),
New EContainer(Name_Groups, Groups.ListToString("|")),
New EContainer(Name_Labels, Labels.ListToString("|")),
New EContainer(Name_Temporary, CInt(Temporary)),
New EContainer(Name_Favorite, CInt(Favorite)),
New EContainer(Name_ReadyForDownload, ReadyForDownload.BoolToInteger),
New EContainer(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger),
New EContainer(Name_Timer, Timer),
New EContainer(Name_StartupDelay, StartupDelay),
New EContainer(Name_ShowNotifications, ShowNotifications.BoolToInteger),
New EContainer(Name_ShowPictureDown, ShowPictureDownloaded.BoolToInteger),
New EContainer(Name_ShowPictureUser, ShowPictureUser.BoolToInteger),
New EContainer(Name_ShowSimpleNotification, ShowSimpleNotification.BoolToInteger),
New EContainer(Name_LastDownloadDate, CStr(AConvert(Of String)(If(LastDownloadDateXML.HasValue Or _LastDownloadDateChanged,
CObj(LastDownloadDate), Nothing), DateProvider, String.Empty)))
}
End Function
#End Region
#Region "Execution"
Friend Sub Start()
If Not If(AThread?.IsAlive, False) And Not Mode = Modes.None Then
Private AThread As Thread
Friend ReadOnly Property Working As Boolean
Get
Return If(AThread?.IsAlive, False)
End Get
End Property
Private _StartTime As Date = Now
Friend Sub Start(ByVal Init As Boolean)
If Init Then _StartTime = Now
_IsNewPlan = False
If Not Working And Not Mode = Modes.None Then
AThread = New Thread(New ThreadStart(AddressOf Checker))
AThread.SetApartmentState(ApartmentState.MTA)
AThread.Start()
End If
End Sub
Private _StopRequested As Boolean = False
Friend Property Pause As Boolean = False
Friend Sub [Stop]()
If If(AThread?.IsAlive, False) Then _StopRequested = True
If Working Then _StopRequested = True
End Sub
Friend Sub Skip()
If LastDownloadDate.AddMinutes(Timer) <= Now Then
LastDownloadDate = Now.AddMinutes(Timer)
Else
LastDownloadDate = LastDownloadDate.AddMinutes(Timer)
End If
End Sub
Private Sub Checker()
Try
While Not _StopRequested
If LastDownloadDate.AddMinutes(Timer) < Now And Not Downloader.Working Then Download()
While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None
If LastDownloadDate.AddMinutes(Timer) < Now And _StartTime.AddMinutes(StartupDelay) < Now And
Not Downloader.Working And Not Pause And Not _StopRequested And Not Mode = Modes.None Then Download()
Thread.Sleep(500)
End While
Catch ex As Exception
@@ -230,18 +371,31 @@ Namespace DownloadObjects
_StopRequested = False
End Try
End Sub
Private _Downloading As Boolean = False
Friend ReadOnly Property Downloading As Boolean
Get
Return _Downloading
End Get
End Property
Private Sub Download()
_Downloading = True
Dim Keys As New List(Of String)
Try
Dim users As New List(Of IUserData)
Dim GName$
Dim i%
Dim DownloadedUsersCount% = 0
Dim l As New ListAddParams(LAP.IgnoreICopier + LAP.NotContainsOnly)
Dim simple As Boolean = ShowSimpleNotification And ShowNotifications
Dim notify As Action = Sub()
With Downloader.Downloaded
If ShowNotifications And .Count > 0 Then .ForEach(Sub(ByVal u As IUserData)
If Keys.Contains(u.Key) Then
ShowNotification(u)
If simple Then
DownloadedUsersCount += 1
Else
ShowNotification(u)
End If
Keys.Remove(u.Key)
End If
End Sub)
@@ -278,10 +432,11 @@ Namespace DownloadObjects
.AutoDownloaderWorking = True
If .Downloaded.Count > 0 Then .Downloaded.RemoveAll(Function(u) Keys.Contains(u.Key)) : .InvokeDownloadsChangeEvent()
.AddRange(users)
.DisableOpenForms = False
While .Working Or .Count > 0 : notify.Invoke() : Thread.Sleep(200) : End While
.AutoDownloaderWorking = False
notify.Invoke
If simple And DownloadedUsersCount > 0 Then _
MainFrameObj.ShowNotification($"{DownloadedUsersCount} user(s) downloaded with scheduler plan '{Name}'", $"Scheduler plan '{Name}'")
End With
End If
Catch ex As Exception
@@ -290,21 +445,23 @@ Namespace DownloadObjects
Keys.Clear()
LastDownloadDate = Now
Update()
_Downloading = False
End Try
End Sub
Private Sub ShowNotification(ByVal u As IUserData)
Dim i% = UserKeys.IndexOf(u.Key)
Dim k$ = $"{Name}_{u.Key}"
Dim i% = UserKeys.IndexOf(k)
If i >= 0 Then
UserKeys(i).ShowNotification()
Else
UserKeys.Add(New NotifiedUser(u.Key, TDownloader.GetUserFromMainCollection(u)))
UserKeys.Add(New NotifiedUser(k, Settings.GetUser(u), Me))
UserKeys.Last.ShowNotification()
End If
End Sub
Friend Function NotificationClicked(ByVal Key As String) As Boolean
Dim i% = UserKeys.IndexOf(Key)
If i >= 0 Then
RaiseEvent UserFind(Key, UserKeys(i).Open(Key))
MainFrameObj.FocusUser(UserKeys(i).IUserDataKey, UserKeys(i).Open(Key))
Return True
Else
Return False

View File

@@ -29,6 +29,8 @@ Namespace DownloadObjects
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_MODE As System.Windows.Forms.TableLayoutPanel
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
Me.TXT_GROUPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
@@ -37,11 +39,16 @@ Namespace DownloadObjects
Me.OPT_SPEC = New System.Windows.Forms.RadioButton()
Me.OPT_DISABLED = New System.Windows.Forms.RadioButton()
Me.OPT_GROUP = New System.Windows.Forms.RadioButton()
Me.CH_NOTIFY = New System.Windows.Forms.CheckBox()
Me.TXT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.LBL_LAST_TIME_UP = New System.Windows.Forms.Label()
Me.NUM_DELAY = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_NOTIFY = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC_USER = New System.Windows.Forms.CheckBox()
Me.CH_NOTIFY_SIMPLE = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MODE = New System.Windows.Forms.TableLayoutPanel()
TP_NOTIFY = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
@@ -49,6 +56,8 @@ Namespace DownloadObjects
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_MODE.SuspendLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
@@ -57,13 +66,13 @@ Namespace DownloadObjects
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 217)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 301)
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(476, 242)
CONTAINER_MAIN.Size = New System.Drawing.Size(476, 301)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
@@ -72,44 +81,46 @@ Namespace DownloadObjects
Me.DEF_GROUP.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.DEF_GROUP.ColumnCount = 1
Me.DEF_GROUP.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.Controls.Add(Me.TXT_GROUPS, 0, 4)
Me.DEF_GROUP.Controls.Add(Me.TXT_GROUPS, 0, 5)
Me.DEF_GROUP.Controls.Add(TP_MODE, 0, 0)
Me.DEF_GROUP.Controls.Add(Me.CH_NOTIFY, 0, 5)
Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 6)
Me.DEF_GROUP.Controls.Add(Me.LBL_LAST_TIME_UP, 0, 7)
Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 7)
Me.DEF_GROUP.Controls.Add(Me.LBL_LAST_TIME_UP, 0, 9)
Me.DEF_GROUP.Controls.Add(Me.NUM_DELAY, 0, 8)
Me.DEF_GROUP.Controls.Add(TP_NOTIFY, 0, 6)
Me.DEF_GROUP.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEF_GROUP.Location = New System.Drawing.Point(0, 0)
Me.DEF_GROUP.Name = "DEF_GROUP"
Me.DEF_GROUP.RowCount = 9
Me.DEF_GROUP.RowCount = 11
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 217)
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 301)
Me.DEF_GROUP.TabIndex = 0
'
'TXT_GROUPS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Index = 0
ActionButton1.Name = "BTT_EDIT"
ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Index = 1
ActionButton2.Name = "BTT_CLEAR"
ActionButton2.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 111)
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 140)
Me.TXT_GROUPS.Name = "TXT_GROUPS"
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
Me.TXT_GROUPS.TabIndex = 4
Me.TXT_GROUPS.TabIndex = 1
'
'TP_MODE
'
@@ -132,7 +143,7 @@ Namespace DownloadObjects
TP_MODE.RowCount = 1
TP_MODE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MODE.Size = New System.Drawing.Size(474, 25)
TP_MODE.TabIndex = 8
TP_MODE.TabIndex = 0
'
'OPT_ALL
'
@@ -199,55 +210,132 @@ Namespace DownloadObjects
TT_MAIN.SetToolTip(Me.OPT_GROUP, "Download groups")
Me.OPT_GROUP.UseVisualStyleBackColor = True
'
'CH_NOTIFY
'
Me.CH_NOTIFY.AutoSize = True
Me.CH_NOTIFY.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_NOTIFY.Location = New System.Drawing.Point(4, 140)
Me.CH_NOTIFY.Name = "CH_NOTIFY"
Me.CH_NOTIFY.Size = New System.Drawing.Size(468, 19)
Me.CH_NOTIFY.TabIndex = 12
Me.CH_NOTIFY.Text = "Show notifications"
Me.CH_NOTIFY.UseVisualStyleBackColor = True
'
'TXT_TIMER
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Index = 0
ActionButton3.Name = "BTT_REFRESH"
ActionButton3.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3)
Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionWidth = 50.0R
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 166)
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 195)
Me.TXT_TIMER.Name = "TXT_TIMER"
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22)
Me.TXT_TIMER.TabIndex = 16
Me.TXT_TIMER.TabIndex = 3
'
'LBL_LAST_TIME_UP
'
Me.LBL_LAST_TIME_UP.AutoSize = True
Me.LBL_LAST_TIME_UP.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_LAST_TIME_UP.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Italic, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 192)
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 250)
Me.LBL_LAST_TIME_UP.Name = "LBL_LAST_TIME_UP"
Me.LBL_LAST_TIME_UP.Size = New System.Drawing.Size(468, 25)
Me.LBL_LAST_TIME_UP.TabIndex = 20
Me.LBL_LAST_TIME_UP.TabIndex = 5
Me.LBL_LAST_TIME_UP.Text = "Last download date: "
Me.LBL_LAST_TIME_UP.TextAlign = System.Drawing.ContentAlignment.TopCenter
'
'NUM_DELAY
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4)
Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay"
Me.NUM_DELAY.CaptionWidth = 50.0R
Me.NUM_DELAY.ClearTextByButtonClear = False
Me.NUM_DELAY.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.NUM_DELAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 224)
Me.NUM_DELAY.Name = "NUM_DELAY"
Me.NUM_DELAY.NumberMaximum = New Decimal(New Integer() {1440, 0, 0, 0})
Me.NUM_DELAY.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
Me.NUM_DELAY.Size = New System.Drawing.Size(468, 22)
Me.NUM_DELAY.TabIndex = 4
Me.NUM_DELAY.Text = "0"
'
'TP_NOTIFY
'
TP_NOTIFY.ColumnCount = 4
TP_NOTIFY.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_NOTIFY.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_NOTIFY.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_NOTIFY.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_NOTIFY.Controls.Add(Me.CH_NOTIFY, 0, 0)
TP_NOTIFY.Controls.Add(Me.CH_SHOW_PIC, 2, 0)
TP_NOTIFY.Controls.Add(Me.CH_SHOW_PIC_USER, 3, 0)
TP_NOTIFY.Controls.Add(Me.CH_NOTIFY_SIMPLE, 1, 0)
TP_NOTIFY.Dock = System.Windows.Forms.DockStyle.Fill
TP_NOTIFY.Location = New System.Drawing.Point(1, 166)
TP_NOTIFY.Margin = New System.Windows.Forms.Padding(0)
TP_NOTIFY.Name = "TP_NOTIFY"
TP_NOTIFY.RowCount = 1
TP_NOTIFY.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_NOTIFY.Size = New System.Drawing.Size(474, 25)
TP_NOTIFY.TabIndex = 2
'
'CH_NOTIFY
'
Me.CH_NOTIFY.AutoSize = True
Me.CH_NOTIFY.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_NOTIFY.Location = New System.Drawing.Point(3, 3)
Me.CH_NOTIFY.Name = "CH_NOTIFY"
Me.CH_NOTIFY.Size = New System.Drawing.Size(112, 19)
Me.CH_NOTIFY.TabIndex = 0
Me.CH_NOTIFY.Text = "Show notifications"
TT_MAIN.SetToolTip(Me.CH_NOTIFY, "Show notification when some data has been downloaded")
Me.CH_NOTIFY.UseVisualStyleBackColor = True
'
'CH_SHOW_PIC
'
Me.CH_SHOW_PIC.AutoSize = True
Me.CH_SHOW_PIC.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_SHOW_PIC.Location = New System.Drawing.Point(239, 3)
Me.CH_SHOW_PIC.Name = "CH_SHOW_PIC"
Me.CH_SHOW_PIC.Size = New System.Drawing.Size(112, 19)
Me.CH_SHOW_PIC.TabIndex = 2
Me.CH_SHOW_PIC.Text = "Image"
TT_MAIN.SetToolTip(Me.CH_SHOW_PIC, "Show downloaded image in notification")
Me.CH_SHOW_PIC.UseVisualStyleBackColor = True
'
'CH_SHOW_PIC_USER
'
Me.CH_SHOW_PIC_USER.AutoSize = True
Me.CH_SHOW_PIC_USER.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_SHOW_PIC_USER.Location = New System.Drawing.Point(357, 3)
Me.CH_SHOW_PIC_USER.Name = "CH_SHOW_PIC_USER"
Me.CH_SHOW_PIC_USER.Size = New System.Drawing.Size(114, 19)
Me.CH_SHOW_PIC_USER.TabIndex = 3
Me.CH_SHOW_PIC_USER.Text = "User icon"
TT_MAIN.SetToolTip(Me.CH_SHOW_PIC_USER, "Show user image in notification")
Me.CH_SHOW_PIC_USER.UseVisualStyleBackColor = True
'
'CH_NOTIFY_SIMPLE
'
Me.CH_NOTIFY_SIMPLE.AutoSize = True
Me.CH_NOTIFY_SIMPLE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_NOTIFY_SIMPLE.Location = New System.Drawing.Point(121, 3)
Me.CH_NOTIFY_SIMPLE.Name = "CH_NOTIFY_SIMPLE"
Me.CH_NOTIFY_SIMPLE.Size = New System.Drawing.Size(112, 19)
Me.CH_NOTIFY_SIMPLE.TabIndex = 1
Me.CH_NOTIFY_SIMPLE.Text = "Simple"
TT_MAIN.SetToolTip(Me.CH_NOTIFY_SIMPLE, resources.GetString("CH_NOTIFY_SIMPLE.ToolTip"))
Me.CH_NOTIFY_SIMPLE.UseVisualStyleBackColor = True
'
'AutoDownloaderEditorForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(476, 242)
Me.ClientSize = New System.Drawing.Size(476, 301)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(492, 281)
Me.MaximumSize = New System.Drawing.Size(492, 340)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(492, 281)
Me.MinimumSize = New System.Drawing.Size(492, 340)
Me.Name = "AutoDownloaderEditorForm"
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "AutoDownloader settings"
@@ -260,6 +348,9 @@ Namespace DownloadObjects
TP_MODE.ResumeLayout(False)
TP_MODE.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).EndInit()
TP_NOTIFY.ResumeLayout(False)
TP_NOTIFY.PerformLayout()
Me.ResumeLayout(False)
End Sub
@@ -270,8 +361,12 @@ Namespace DownloadObjects
Private WithEvents OPT_SPEC As RadioButton
Private WithEvents OPT_DISABLED As RadioButton
Private WithEvents CH_NOTIFY As CheckBox
Friend WithEvents TXT_TIMER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_TIMER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents OPT_GROUP As RadioButton
Private WithEvents LBL_LAST_TIME_UP As Label
Private WithEvents NUM_DELAY As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_SHOW_PIC As CheckBox
Private WithEvents CH_SHOW_PIC_USER As CheckBox
Private WithEvents CH_NOTIFY_SIMPLE As CheckBox
End Class
End Namespace

View File

@@ -211,6 +211,30 @@
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<metadata name="TP_NOTIFY.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="CH_NOTIFY_SIMPLE.ToolTip" xml:space="preserve">
<value>Show a simple notification instead of a user notification.
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value>
</data>
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>

View File

@@ -8,19 +8,19 @@
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Forms.Toolbars
Imports DModes = SCrawler.DownloadObjects.AutoDownloader.Modes
Namespace DownloadObjects
Friend Class AutoDownloaderEditorForm : Implements IOkCancelToolbar
Private ReadOnly MyDefs As DefaultFormProps
Friend Class AutoDownloaderEditorForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly MyGroups As List(Of String)
Friend Property IsControlForm As Boolean = False
Friend Sub New()
Private ReadOnly Property Plan As AutoDownloader
Friend Sub New(ByRef _Plan As AutoDownloader)
InitializeComponent()
MyDefs = New DefaultFormProps
MyGroups.ListAddList(Settings.Automation.Groups, LAP.NotContainsOnly)
Plan = _Plan
MyDefs = New DefaultFormOptions(Me, Settings.Design)
MyGroups.ListAddList(Plan.Groups, LAP.NotContainsOnly)
End Sub
Friend Class AutomationTimerChecker : Implements IFieldsCheckerProvider
Private Class AutomationTimerChecker : Implements IFieldsCheckerProvider
Private Property ErrorMessage As String = "The timer value must be greater than 0" Implements IFieldsCheckerProvider.ErrorMessage
Private Property Name As String Implements IFieldsCheckerProvider.Name
Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError
@@ -36,18 +36,11 @@ Namespace DownloadObjects
Throw New NotImplementedException()
End Function
End Class
Private _Loaded As Boolean = False
Friend Shadows Sub Show()
MyBase.Show()
If Not _Loaded And IsControlForm Then AutoDownloaderEditorForm_Load(Nothing, EventArgs.Empty)
End Sub
Private Sub AutoDownloaderEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
If Not IsControlForm Then
.MyViewInitialize(Me, Settings.Design, True)
.AddOkCancelToolbar()
End If
With Settings.Automation
.MyViewInitialize(True)
.AddOkCancelToolbar()
With Plan
Select Case .Mode
Case DModes.None : OPT_DISABLED.Checked = True
Case DModes.All : OPT_ALL.Checked = True
@@ -55,33 +48,34 @@ Namespace DownloadObjects
Case DModes.Specified : OPT_SPEC.Checked = True
Case DModes.Groups : OPT_GROUP.Checked = True
End Select
ChangeEnabled()
DEF_GROUP.Set(Settings.Automation)
DEF_GROUP.Set(Plan)
If MyGroups.Count > 0 Then TXT_GROUPS.Text = MyGroups.ListToString
If Settings.Groups.Count = 0 Then TXT_GROUPS.Clear() : TXT_GROUPS.Enabled = False
CH_NOTIFY.Checked = .ShowNotifications
CH_NOTIFY_SIMPLE.Checked = .ShowSimpleNotification
CH_SHOW_PIC.Checked = .ShowPictureDownloaded
CH_SHOW_PIC_USER.Checked = .ShowPictureUser
TXT_TIMER.Text = .Timer
LBL_LAST_TIME_UP.Text &= .LastDownloadDate.ToStringDate(ADateTime.Formats.BaseDateTime)
NUM_DELAY.Value = .StartupDelay
LBL_LAST_TIME_UP.Text = .Information
ChangeEnabled()
End With
If Not IsControlForm Then
.MyFieldsChecker = New FieldsChecker
With DirectCast(.MyFieldsChecker, FieldsChecker)
.AddControl(Of Integer)(TXT_TIMER, TXT_TIMER.CaptionText,, New AutomationTimerChecker)
.EndLoaderOperations()
End With
.DelegateClosingChecker()
.AppendDetectors()
.MyFieldsChecker = New FieldsChecker
With .MyFieldsCheckerE
.AddControl(Of String)(DEF_GROUP.TXT_NAME, DEF_GROUP.TXT_NAME.CaptionText,,
New Groups.GroupEditorForm.NameChecker(Plan.Name, Settings.Automation, "Plan"))
.AddControl(Of Integer)(TXT_TIMER, TXT_TIMER.CaptionText,, New AutomationTimerChecker)
.EndLoaderOperations()
End If
End With
.EndLoaderOperations()
End With
_Loaded = True
End Sub
Private Sub AutoDownloaderEditorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
MyGroups.Clear()
End Sub
Friend Sub SaveSetiings() Implements IOkCancelToolbar.ToolbarBttOK
If If(MyDefs.MyFieldsChecker?.AllParamsOK, True) Then
With Settings.Automation
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then
With Plan
Select Case True
Case OPT_DISABLED.Checked : .Mode = DModes.None
Case OPT_ALL.Checked : .Mode = DModes.All
@@ -89,19 +83,21 @@ Namespace DownloadObjects
Case OPT_SPEC.Checked : .Mode = DModes.Specified
Case OPT_GROUP.Checked : .Mode = DModes.Groups
End Select
DEF_GROUP.Get(Settings.Automation)
DEF_GROUP.Get(Plan)
.Groups.Clear()
.Groups.ListAddList(MyGroups)
.ShowNotifications = CH_NOTIFY.Checked
.ShowSimpleNotification = CH_NOTIFY_SIMPLE.Checked
.ShowPictureDownloaded = CH_SHOW_PIC.Checked
.ShowPictureUser = CH_SHOW_PIC_USER.Checked
.Timer = AConvert(Of Integer)(TXT_TIMER.Text, AutoDownloader.DefaultTimer)
.StartupDelay = NUM_DELAY.Value
.Update()
End With
If Not IsControlForm Then MyDefs.CloseForm()
MyDefs.CloseForm()
End If
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_GROUPS.ActionOnButtonClick
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GROUPS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ActionButton.DefaultButtons.Edit
Using f As New LabelsForm(MyGroups, Settings.Groups.Select(Function(g) g.Name)) With {.Text = "Groups"}
@@ -126,11 +122,18 @@ Namespace DownloadObjects
Private Sub OPT_GROUP_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_GROUP.CheckedChanged
ChangeEnabled()
End Sub
Private Sub ChangeEnabled()
Private Sub ChangeEnabled() Handles CH_NOTIFY.CheckedChanged, CH_NOTIFY_SIMPLE.CheckedChanged
DEF_GROUP.Enabled = OPT_SPEC.Checked
TXT_GROUPS.Enabled = OPT_GROUP.Checked
TXT_TIMER.Enabled = Not OPT_DISABLED.Checked
NUM_DELAY.Enabled = Not OPT_DISABLED.Checked
CH_NOTIFY.Enabled = Not OPT_DISABLED.Checked
CH_NOTIFY_SIMPLE.Enabled = CH_NOTIFY.Enabled And CH_NOTIFY.Checked
CH_SHOW_PIC.Enabled = CH_NOTIFY.Checked And Not OPT_DISABLED.Checked And Not CH_NOTIFY_SIMPLE.Checked
CH_SHOW_PIC_USER.Enabled = CH_NOTIFY.Checked And Not OPT_DISABLED.Checked And Not CH_NOTIFY_SIMPLE.Checked
End Sub
Private Sub NUM_DELAY_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles NUM_DELAY.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Clear Then NUM_DELAY.Value = 0
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,117 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class DownloadFeedForm : 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 SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadFeedForm))
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout()
'
'SEP_1
'
SEP_1.Name = "SEP_1"
SEP_1.Size = New System.Drawing.Size(6, 25)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_REFRESH, Me.BTT_CLEAR, SEP_1})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(484, 25)
Me.ToolbarTOP.TabIndex = 0
'
'BTT_REFRESH
'
Me.BTT_REFRESH.Image = Global.SCrawler.My.Resources.Resources.Refresh
Me.BTT_REFRESH.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_REFRESH.Name = "BTT_REFRESH"
Me.BTT_REFRESH.Size = New System.Drawing.Size(66, 22)
Me.BTT_REFRESH.Text = "Refresh"
Me.BTT_REFRESH.ToolTipText = "Refresh data list"
'
'BTT_CLEAR
'
Me.BTT_CLEAR.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_CLEAR.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR.Name = "BTT_CLEAR"
Me.BTT_CLEAR.Size = New System.Drawing.Size(54, 22)
Me.BTT_CLEAR.Text = "Clear"
Me.BTT_CLEAR.ToolTipText = "Clear data list"
'
'TP_DATA
'
Me.TP_DATA.AutoScroll = True
Me.TP_DATA.ColumnCount = 1
Me.TP_DATA.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_DATA.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_DATA.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_DATA.Location = New System.Drawing.Point(0, 25)
Me.TP_DATA.Name = "TP_DATA"
Me.TP_DATA.RowCount = 11
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.RowStyles.Add(New System.Windows.Forms.RowStyle())
Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1
'
'DownloadFeedForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.BackColor = System.Drawing.SystemColors.Window
Me.ClientSize = New System.Drawing.Size(484, 461)
Me.Controls.Add(Me.TP_DATA)
Me.Controls.Add(Me.ToolbarTOP)
Me.ForeColor = System.Drawing.SystemColors.WindowText
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(300, 300)
Me.Name = "DownloadFeedForm"
Me.Text = "Download Feed"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private WithEvents ToolbarTOP As ToolStrip
Private WithEvents TP_DATA As TableLayoutPanel
Private WithEvents BTT_REFRESH As ToolStripButton
Private WithEvents BTT_CLEAR As ToolStripButton
End Class
End Namespace

View File

@@ -0,0 +1,203 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAABAAEAICAAAAEAIACoEAAAFgAAACgAAAAgAAAAQAAAAAEAIAAAAAAAABAAABMLAAATCwAAAAAAAAAA
AAAZeOoAGXjqJBl46p4ZeOrtGXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq7Rl4
6p4ZeOokGXjqABl46iQZeOq+GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46r4ZeOokGXjqnhl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46p4ZeOrrGXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GHfq/xh3
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8Yd+r/F3fq/xd36v8Xd+r/GHjq/xl46v8ZeOr/GHjq/xd3
6v8Xd+r/F3fq/xh36v8ZeOr/GXjq/xl46v8ZeOr/GXjq6xl46v4ZeOr/GXjq/xl46v8ZeOr/GHfq/xl4
6v8pguz/KYHr/xl46v8Yd+r/GXjq/xl46v8ZeOr/GXjq/yqC7P8yh+z/Mofs/zKH7P8mf+v/GXjq/xl4
6v8hfev/Mofs/zOH7P8zh+z/L4Xs/xt56v8ZeOr/GXjq/xl46v8ZeOr+GXjq/xl46v8ZeOr/GXjq/xh3
6v8ogev/j731/9Xm+//T5fv/ibr0/yV/6/8Yd+r/GXjq/xl46v8ceur/o8n3/+Pv/P/g7fz/4+78/3qx
8/8Wdur/Fnbq/1id8P/e7Pz/4e38/+Pu/P/A2vn/KoLs/xh36v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/4289f/+/v/////////////9/v//hbf0/xh36v8ZeOr/GHjq/yN+6//J3/r/////////
////////fLLz/xV26v8Vdur/bKjy//7+/////////////9Pl+/8ogev/GHfq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xh36v8ogev/0eT7///////////////////////K4Pr/JH/r/xh46v8Xd+r/N4rt/+Pv
/P////////////v9//9hovH/FXbq/xV26v+CtfT/////////////////xN36/yF96/8YeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GHfq/yeA6//P4/v//////////////////////8jf+v8jfuv/GHjq/xV2
6v9npvH/+/3/////////////6vP9/z+P7v8Xd+r/GXjq/6PJ9/////////////////+rzvf/Gnnq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GHjq/4W39P/8/f/////////////6/P//fLLz/xh3
6v8YeOr/IHzr/7bU+P/////////////////C2/n/In3r/xh36v8mgOv/zOH6/////////////////4e4
9P8Wdur/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8Yd+r/JH7r/4C18//I3/r/x976/3uy
8/8hfev/GHjq/xZ26v9lpfH/9fn+/////////////////32z8/8Wdur/Fnbq/0qU7v/w9v7/////////
///4+/7/Wp7w/xV26v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8YeOr/GHfq/yN+
6/8ifev/F3fq/xh46v8Wdur/QI/u/9jo+//////////////////a6vz/NYnt/xd36v8Xd+r/i7v0////
/////////////9zr/P8yhuz/F3fq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GHjq/xh46v8YeOr/Fnbq/z+O7f/I3/r//////////////////P3//32z8/8Xd+r/F3fq/zCF
7P/V5vv/////////////////pMr3/xp56v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xh46v8Xd+r/FXbq/x976/9jo/H/1+f7//////////////////////+41fj/JoDr/xh3
6v8Xd+r/frPz//3+//////////////b6/v9anvD/Fnbq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8beer/IX3r/zSI7P9jpPH/s9P4//T5/v//////////////////////0uX7/z2N
7f8Xd+r/Fnfq/z2N7f/d6/z/////////////////wNr5/yR+6/8YeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8Yd+r/JoDr/53F9v/G3vr/4e38//n8/v///////////////////////////9Pl
+/9IlO7/Fnfq/xh36v8ifev/rc/4//////////////////b6/v9jo/H/Fnbq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xh36v8thOz/2+r8//////////////////////////////////z9
//+61/n/Po7t/xZ36v8YeOr/G3nq/4m69P/7/P//////////////////r9D4/yF86/8YeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GHfq/y2E7P/b6vz///////////////////////7+
///e7Pz/gLTz/yeA6/8Xd+r/GHfq/xt56v97svP/9Pj+/////////////////+Dt/P9DkO7/Fnfq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8Yd+r/LYTs/9vq/P///////P3//+31
/f/G3vr/gbX0/ziK7f8Xd+r/GHfq/xd36v8hfev/h7j0//T4/v/////////////////0+P7/bKny/xd3
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xh46v8kfuv/e7Hz/4G1
9P9mpfH/Q5Hu/yR+6/8Wdur/F3fq/xh36v8Wdur/OYvt/6rN9//5/P7/////////////////+vz//4q7
9P8ceur/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8Wdur/FXbq/xV26v8Wdur/GHfq/xZ26v8Wdur/K4Ps/3ev8//a6fz///////////////////////r8
//+VwfX/IHzr/xh36v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xZ26v8Vdur/FXbq/xd36v8ifev/QpDu/4K29P/Q4/v/+/3/////////////////////
///1+f7/jLz1/yF96/8Yd+r/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ee+r/T5fv/2Oj8f94sPP/msT2/8Td+v/s9P3//v7/////////////////////
////////4+/8/3Cr8v8ceur/GHfq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GHfq/yyD7P/V5vv//v//////////////////////////////////////
////////+Pv+/7XU+P9Gku7/F3fq/xh46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8Yd+r/LYPs/9rp/P//////////////////////////////
////////+Pv+/8fe+v9pp/H/In7r/xZ26v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xh36v8thOz/2un8////////////////////
///7/f//4+/8/63P+P9io/H/J4Dr/xZ26v8YeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GHfq/yqC7P+/2vn/3Ov8/83i
+v+11Pj/kb71/2Ok8f83iu3/HHrq/xZ26v8Yd+r/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr+GXjq/xl46v8ZeOr/G3nq/y6E
7P8thOz/JX/r/xx66v8Xd+r/FXbq/xd36v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/hl46usZeOr/GXjq/xl4
6v8ZeOr/GHfq/xh36v8YeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOrrGXjqnhl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6p4ZeOokGXjqvhl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOq+GXjqJBl46gAZeOokGXjqnxl46u0ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl46v8ZeOr/GXjq/xl4
6v8ZeOrtGXjqnhl46iQZeOoAgAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAAAE=
</value>
</data>
</root>

View File

@@ -0,0 +1,326 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools
Imports RCI = PersonalUtilities.Forms.Toolbars.RangeSwitcherToolbar.ControlItem
Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD
Namespace DownloadObjects
Friend Class DownloadFeedForm
#Region "Declarations"
Private WithEvents MyDefs As DefaultFormOptions
Private WithEvents MyRange As RangeSwitcherToolbar(Of UserMediaD)
Private ReadOnly DataList As List(Of UserMediaD)
Private WithEvents BTT_DELETE_SELECTED As ToolStripButton
Private WithEvents LBL_FILES As ToolStripLabel
Private DataRows As Integer = 10
Private DataColumns As Integer = 1
Private FeedEndless As Boolean = False
#End Region
#Region "Initializer"
Friend Sub New()
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
MyRange = New RangeSwitcherToolbar(Of UserMediaD)(ToolbarTOP)
DataList = New List(Of UserMediaD)
LBL_FILES = New ToolStripLabel With {.Text = String.Empty, .AutoToolTip = False, .ToolTipText = String.Empty}
BTT_DELETE_SELECTED = New ToolStripButton With {
.Text = "Delete selected",
.AutoToolTip = True,
.ToolTipText = "Delete marked files",
.Image = My.Resources.Delete,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
End Sub
#End Region
#Region "Form handlers"
Private Sub DownloadFeedForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
With MyRange
.AutoToolTip = True
.ButtonKey(RCI.Previous) = Keys.F3
.ButtonKey(RCI.Next) = Keys.F4
.AddThisToolbar()
End With
ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED, New ToolStripSeparator, LBL_FILES})
UpdateSettings()
RefillList()
.EndLoaderOperations(False)
End With
End Sub
Private Sub DownloadFeedForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub DownloadFeedForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
ClearTable()
MyRange.Dispose()
BTT_CLEAR.Dispose()
DataList.Clear()
LBL_FILES.Dispose()
End Sub
Private Sub DownloadFeedForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.F5 Then RefillList() : e.Handled = True
End Sub
#End Region
#Region "Settings"
Friend Sub UpdateSettings()
With Settings
Dim c% = .FeedDataRows * .FeedDataColumns
Dim rangeChanged As Boolean = Not c = DataRows * DataColumns
DataRows = .FeedDataRows
DataColumns = .FeedDataColumns
FeedEndless = .FeedEndless
If rangeChanged Then
ClearTable()
ControlInvoke(TP_DATA, Sub()
With TP_DATA
.RowStyles.Clear()
.RowCount = 0
.ColumnStyles.Clear()
.ColumnCount = 0
Dim i%
Dim p% = IIf(DataColumns = 1, 100, 50)
For i = 0 To DataColumns - 1 : .ColumnStyles.Add(New ColumnStyle(SizeType.Percent, p)) : Next
.ColumnCount = .ColumnStyles.Count
For i = 0 To DataRows - 1 : .RowStyles.Add(New RowStyle(SizeType.Absolute, 0)) : Next
.RowCount = .RowStyles.Count
.HorizontalScroll.Visible = False
End With
End Sub)
End If
MyRange.HandlersSuspended = True
MyRange.Limit = c
MyRange.HandlersSuspended = False
If Not MyDefs.Initializing And rangeChanged Then RefillList()
End With
End Sub
#End Region
#Region "Refill"
Friend Sub Downloader_FilesChanged(ByVal Added As Boolean)
ControlInvoke(ToolbarTOP, LBL_FILES, Sub() LBL_FILES.Text = IIf(Added, "New files found", "Some files have been removed"))
LBL_FILES.ControlChangeColor(ToolbarTOP, Added, False)
End Sub
Private Sub RefillList() Handles BTT_REFRESH.Click
DataPopulated = False
DataList.ListAddList(Downloader.Files, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
MyRange.Source = DataList
ControlInvoke(ToolbarTOP, LBL_FILES, Sub() LBL_FILES.Text = String.Empty)
LBL_FILES.ControlDropColor(ToolbarTOP)
If DataList.Count = 0 Then
ClearTable()
ElseIf Not DataPopulated Then
MyRange_IndexChanged(MyRange, Nothing)
End If
End Sub
Private Sub BTT_CLEAR_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR.Click
Downloader.Files.Clear()
ClearTable()
RefillList()
End Sub
#End Region
#Region "Data"
Private Sub BTT_DELETE_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_DELETE_SELECTED.Click
Const MsgTitle$ = "Deleting marked files"
Try
Dim c As IEnumerable(Of FeedMedia) = ControlInvoke(TP_DATA, Function() If(TP_DATA.Controls.Count > 0, TP_DATA.Controls.ToObjectsList.Cast(Of FeedMedia)().Where(Function(f) f.Checked), New FeedMedia() {}))
If c.ListExists Then
If MsgBoxE({$"Are you sure you want to delete {c.Count} file(s)?", MsgTitle}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Dim indx% = MyRange.CurrentIndex
Dim d% = 0
ControlInvoke(TP_DATA, Sub()
With TP_DATA
For Each fm As FeedMedia In c
If fm.DeleteFile(True) Then
d += 1
DataList.RemoveAll(Function(dd) dd.Data.File = fm.File)
End If
Next
End With
End Sub)
If d > 0 Then
If DataList.Count > 0 Then
MyRange.HandlersSuspended = True
MyRange.Source = DataList
If indx.ValueBetween(0, MyRange.Count - 1) Then MyRange.CurrentIndex = indx
MyRange.HandlersSuspended = False
DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged()
Else
RefillList()
End If
End If
MsgBoxE({$"{d}/{c.Count} file(s) deleted", MsgTitle})
Else
MsgBoxE({"Operation canceled", MsgTitle})
End If
Else
MsgBoxE({"No files selected", MsgTitle}, vbExclamation)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, MsgTitle)
End Try
End Sub
#End Region
#Region "Range"
Private DataPopulated As Boolean = False
Private Structure TPCELL
Private ReadOnly RowsCount As Integer
Private ReadOnly ColumnsCount As Integer
Friend ReadOnly Row As Integer
Friend ReadOnly Column As Integer
Friend Sub New(ByVal RowsCount As Integer, ByVal ColumnsCount As Integer)
Me.RowsCount = RowsCount - 1
Me.ColumnsCount = ColumnsCount - 1
Row = 0
Column = 0
End Sub
Private Sub New(ByVal RowsCount As Integer, ByVal ColumnsCount As Integer, ByVal Row As Integer, ByVal Column As Integer)
Me.New(RowsCount, ColumnsCount)
Me.Row = Row
Me.Column = Column
End Sub
Friend Function [Next]() As TPCELL
Dim r% = Row
Dim c% = Column + 1
If Not c.ValueBetween(0, ColumnsCount) Then c = 0 : r += 1
Return New TPCELL(RowsCount, ColumnsCount, r, c)
End Function
End Structure
Private Sub MyRange_IndexChanged(ByVal Sender As IRangeSwitcherProvider, ByVal e As EventArgs) Handles MyRange.IndexChanged
Try
If Sender.CurrentIndex >= 0 Then
AllowTopScroll = False
ScrollSuspended = True
Dim d As List(Of Integer) = MyRange.Indexes(Sender.CurrentIndex, EDP.ReturnValue).ListIfNothing
Dim i%
If d.Count > 0 Then
ClearTable()
If Sender.CurrentIndex > 0 And FeedEndless Then
i = MyRange.Indexes(Sender.CurrentIndex - 1, EDP.ReturnValue).DefaultIfEmpty(-1).Last
If i.ValueBetween(0, DataList.Count - 1) Then
If d.Count = 0 Then d.Add(i) Else d.Insert(0, i)
End If
End If
Dim w% = GetWidth()
Dim hp% = PaddingE.GetOf({TP_DATA}).Vertical(2)
Dim p As New TPCELL(DataRows, DataColumns)
Dim fmList As New List(Of FeedMedia)
Dim rhd As New Dictionary(Of Integer, List(Of Integer))
For Each i In d
If i.ValueBetween(0, DataList.Count - 1) Then fmList.Add(New FeedMedia(DataList(i), w))
Next
If fmList.Count > 0 Then fmList.ListDisposeRemoveAll(Function(fm) fm Is Nothing OrElse fm.HasError)
If fmList.Count > 0 Then
For i = 0 To fmList.Count - 1
If Not rhd.ContainsKey(p.Row) Then rhd.Add(p.Row, New List(Of Integer))
rhd(p.Row).Add(fmList(i).Height)
p = p.Next
Next
p = New TPCELL(DataRows, DataColumns)
ControlInvoke(TP_DATA, Sub()
With TP_DATA
With .RowStyles
For i = 0 To .Count - 1
With .Item(i) : .SizeType = SizeType.Absolute : .Height = 0 : End With
Next
End With
.AutoScroll = False
.AutoScroll = True
End With
End Sub)
For i = 0 To fmList.Count - 1
ControlInvoke(TP_DATA, Sub()
With TP_DATA
With .RowStyles(p.Row) : .SizeType = SizeType.Absolute : .Height = rhd(p.Row).Max : End With
.Controls.Add(fmList(i), p.Column, p.Row)
End With
End Sub)
p = p.Next
Next
End If
fmList.Clear()
rhd.ListForEach(Sub(kv, ii) kv.Value.Clear())
rhd.Clear()
d.Clear()
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[DownloadObjects.DownloadFeedForm.Range.IndexChanged({Sender.CurrentIndex})]")
Finally
ControlInvoke(TP_DATA, Sub()
With TP_DATA.VerticalScroll
If Offset = 1 Then .Value = 0 Else .Value = .Maximum
End With
End Sub)
ScrollSuspended = False
DataPopulated = True
End Try
End Sub
#End Region
#Region "Size"
Private Function GetWidth() As Integer
Return (TP_DATA.Width - PaddingE.GetOf({Me, TP_DATA}).Horizontal(2)) / DataColumns
End Function
Private Sub DownloadFeedForm_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd
ControlInvoke(TP_DATA, Sub()
With TP_DATA
If .Controls.Count > 0 Then
Dim w% = GetWidth()
Dim p As TableLayoutPanelCellPosition
Dim rh As New Dictionary(Of Integer, List(Of Integer))
For Each cnt As FeedMedia In .Controls
cnt.Width = w
p = .GetCellPosition(cnt)
If Not rh.ContainsKey(p.Row) Then rh.Add(p.Row, New List(Of Integer))
rh(p.Row).Add(cnt.Height)
Next
If rh.Count > 0 Then
For Each kv In rh
With .RowStyles(kv.Key) : .SizeType = SizeType.Absolute : .Height = kv.Value.Max : End With
kv.Value.Clear()
Next
End If
rh.Clear()
.AutoScroll = False
.AutoScroll = True
End If
End With
End Sub)
End Sub
#End Region
#Region "Scroll"
Private AllowTopScroll As Boolean = False
Private ScrollSuspended As Boolean = False
Private Offset As Integer = 1
Private Sub TP_DATA_Paint(sender As Object, e As PaintEventArgs) Handles TP_DATA.Paint
If Not MyDefs.Initializing And Not ScrollSuspended And FeedEndless Then
ControlInvoke(TP_DATA, Sub()
With TP_DATA
Offset = IIf(.VerticalScroll.Value = 0 And AllowTopScroll, -1, 1)
If .VerticalScroll.Value + .VerticalScroll.LargeChange >= .DisplayRectangle.Height Or (.VerticalScroll.Value = 0 And AllowTopScroll) Then
If MyRange.TryMove(Offset) Then MyRange.Move(Offset)
End If
If Not AllowTopScroll And .VerticalScroll.Value > 0 Then AllowTopScroll = True
End With
End Sub)
End If
End Sub
#End Region
Private Sub ClearTable()
ControlInvoke(TP_DATA, Sub()
If TP_DATA.Controls.Count > 0 Then
For Each cnt As Control In TP_DATA.Controls : cnt.Dispose() : Next
TP_DATA.Controls.Clear()
End If
End Sub)
End Sub
End Class
End Namespace

View File

@@ -11,8 +11,8 @@ Imports Download = SCrawler.Plugin.ISiteSettings.Download
Imports TDJob = SCrawler.DownloadObjects.TDownloader.Job
Namespace DownloadObjects
Friend Class DownloadProgress : Implements IDisposable
Friend Event OnDownloadDone(ByVal Message As String)
Friend Event OnTotalCountChange()
Friend Event DownloadDone As NotificationEventHandler
Friend Event ProgressMaximumChanged()
Private ReadOnly TP_MAIN As TableLayoutPanel
Private ReadOnly TP_CONTROLS As TableLayoutPanel
Private WithEvents BTT_START As Button
@@ -89,10 +89,10 @@ Namespace DownloadObjects
End If
With Job
.Progress = New MyProgress(PR_MAIN, LBL_INFO) With {.DropCurrentProgressOnTotalChange = False}
.Progress = New MyProgress(PR_MAIN, LBL_INFO) With {.ResetProgressOnMaximumChanges = False}
With .Progress
AddHandler .OnProgressChange, AddressOf JobProgress_OnProgressChange
AddHandler .OnTotalCountChange, AddressOf JobProgress_OnTotalCountChange
AddHandler .ProgressChanged, AddressOf JobProgress_ProgressChanged
AddHandler .MaximumChanged, AddressOf JobProgress_MaximumChanged
End With
End With
@@ -139,7 +139,7 @@ Namespace DownloadObjects
Job.Progress.InformationTemporary = $"{Job.Host.Name} downloading started"
Job.Start()
Instance.Download(Job.Token)
RaiseEvent OnDownloadDone($"Downloading saved {Job.Host.Name} posts is completed")
RaiseEvent DownloadDone($"Downloading saved {Job.Host.Name} posts is completed")
Catch ex As Exception
Job.Progress.InformationTemporary = $"{Job.Host.Name} downloading error"
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, {$"{Job.Host.Name} saved posts downloading error", "Saved posts"})
@@ -147,15 +147,15 @@ Namespace DownloadObjects
btte.Invoke(BTT_START, True)
btte.Invoke(BTT_STOP, False)
Job.Stopped()
If Job.Type = Download.SavedPosts Then Job.Progress.TotalCount = 0 : Job.Progress.CurrentCounter = 0
If Job.Type = Download.SavedPosts Then Job.Progress.Maximum = 0 : Job.Progress.Value = 0
End Try
End Sub
#End Region
#Region "Progress, Jobs count"
Private Sub JobProgress_OnTotalCountChange(ByVal Source As IMyProgress, ByVal Index As Integer)
RaiseEvent OnTotalCountChange()
Private Sub JobProgress_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
RaiseEvent ProgressMaximumChanged()
End Sub
Private Sub JobProgress_OnProgressChange(ByVal Source As IMyProgress, ByVal Index As Integer)
Private Sub JobProgress_ProgressChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If Not Job.Type = Download.SavedPosts Then MainProgress.Perform()
End Sub
#End Region

View File

@@ -11,7 +11,7 @@ Imports PersonalUtilities.Forms
Imports SCrawler.DownloadObjects
Imports SCrawler.Plugin.Hosts
Friend Class DownloadSavedPostsForm
Friend Event OnDownloadDone As NotificationEventHandler
Friend Event DownloadDone As NotificationEventHandler
Private MyView As FormsView
Private ReadOnly JobsList As List(Of DownloadProgress)
Friend ReadOnly Property Working As Boolean
@@ -45,7 +45,7 @@ Friend Class DownloadSavedPostsForm
MyView.SetMeSize()
If JobsList.Count > 0 Then
For Each j As DownloadProgress In JobsList
AddHandler j.OnDownloadDone, AddressOf Jobs_OnDownloadDone
AddHandler j.DownloadDone, AddressOf Jobs_DownloadDone
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Absolute, 60))
TP_MAIN.RowCount += 1
TP_MAIN.Controls.Add(j.Get, 0, TP_MAIN.RowStyles.Count - 1)
@@ -65,8 +65,8 @@ Friend Class DownloadSavedPostsForm
[Stop]()
MyView.Dispose(Settings.Design)
End Sub
Private Sub Jobs_OnDownloadDone(ByVal Message As String)
RaiseEvent OnDownloadDone(Message)
Private Sub Jobs_DownloadDone(ByVal Message As String)
RaiseEvent DownloadDone(Message)
End Sub
Private Sub BTT_DOWN_ALL_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_ALL.Click
Start()

View File

@@ -152,10 +152,10 @@
Me.Controls.Add(Me.LIST_DOWN)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(570, 450)
Me.Name = "DownloadedInfoForm"
Me.ShowIcon = False
Me.Text = "Downloaded items"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()

View File

@@ -198,4 +198,507 @@
<metadata name="ToolbarBOTTOM.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>133, 17</value>
</metadata>
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAABAAwAMDAQAAEABABoBgAAxgAAACAgEAABAAQA6AIAAC4HAAAYGBAAAQAEAOgBAAAWCgAAEBAQAAEA
BAAoAQAA/gsAADAwAAABAAgAqA4AACYNAAAgIAAAAQAIAKgIAADOGwAAGBgAAAEACADIBgAAdiQAABAQ
AAABAAgAaAUAAD4rAAAwMAAAAQAgAKglAACmMAAAICAAAAEAIACoEAAATlYAABgYAAABACAAiAkAAPZm
AAAQEAAAAQAgAGgEAAB+cAAAKAAAADAAAABgAAAAAQAEAAAAAACABAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAIAAAIAAAACAgACAAAAAgACAAICAAACAgIAAwMDAAAAA/wAA/wAAAP//AP8AAAD/AP8A//8AAP//
/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4YAAAAAAAAAAAAAAAAAAAAAAAAAAAAAjsjgAAAAAAAAAAAA
AAAAAAAAAAAAAAAIbOh4AAAAAAAAAAAAAAAAAAAAAAAAAAAH5mfsgAAAAAAAAAAAAAAAAAAAAAAAAAB+
xs54YAAAAAAAAAAAAAAAAAAAAAAAAAfsbmxo5wAAAAAAAAAAAAAAAAAAAAAAAIbObObOeMAAAAAAAAAA
AAAAAAAAAAAACG5+zmzsaOgAAAAAAAAAAAAAAAAAAAAABn7ObOZmbneAAAAAAAAAAAAAAAAAAAAAfs5s
5+zs7I7AAAAAAAAAAAAAAAAAAAAH7Ofm7G7GbGiOAAAAAAAAAAAAAAAAAAB+fs7Ofs5+zmzngAAAAAAA
AAAAAAAAAAhn7Ojs5uzm7OZ4yAAAAAAAAAAAAAAAAAaOfm7Obsfsbs7OjnAAAAAAAAAAAAAAAH7Ojs7n
7O7ObOZs54AAAAAAAAAAAAAABn6Ozuduzn5uznzmyOcAAAAAAAAAAAAAfn7I6M7s5+zn7Obs5oyAAAAA
AAAAAAAIZ+jujuzo7Obs5uxubOjnAAAAAAAAAAAG586M5+js7n7OfOfs5s54cAAAAAAAAABnzo7o5+zu
fs5+5uzmzmzowAAAAAAAAAdujn5+fu7Ozuzs7Ofs5+bI6AAAAAAAAHzn7OjOjI5+5+jufs5uzs5ueOAA
AAAAAG6M6O6O7n7Ofs7Ozo7Ofmzs53gAAAAAB+zo7IznyOzuzufufs6Ofo6Ofn4AAAAACEdsZ2Z87o5+
js7O7O5cjHx8jIgAAAAAAAAAAAAAfOfs7Ojs6OfgAAAAAAAAAAAAAAAAAAAAbo7O6O7O7OfAAAAAAAAA
AAAAAAAAAAAAfsjm7Obo7s6AAAAAAAAAAAAAAAAAAAAAaO5+zo7OyO5wAAAAAAAAAAAAAAAAAAAAzn7O
js7n7sjAAAAAAAAAAAAAAAAAAAAAaM6Ozuzuzu5wAAAAAAAAAAAAAAAAAAAAbn7Obn5+jshgAAAAAAAA
AAAAAAAAAAAAbOjn7Ozs7O5wAAAAAAAAAAAAAAAAAAAAfnzn5+bn7n7AAAAAAAAAAAAAAAAAAAAAbOjs
7OzuzshgAAAAAAAAAAAAAAAAAAAAaOyOfn7I5+5wAAAAAAAAAAAAAAAAAAAAbOfs7Ozm7OfAAAAAAAAA
AAAAAAAAAAAAbnzn5+bs5u5wAAAAAAAAAAAAAAAAAAAAfOfsjOx+zn7AAAAAAAAAAAAAAAAAAAAAbnzn
5o7OfshgAAAAAAAAAAAAAAAAAAAAx+Z+zs5uzm5gAAAAAAAAAAAAAAAAAAAAbs7H5+fObsjAAAAAAAAA
AAAAAAAAAAAAZ2js585s7O5wAAAAAAAAAAAAAAAAAAAAjOyH5+jn53aAAAAAAAAAAAAAAAAAAAAACGZs
bHxsfGgAAAAAAAAAAAD///////8AAP///////wAA////////AAD///j///8AAP//8H///wAA///gP///
AAD//+Af//8AAP//wB///wAA//+AD///AAD//wAH//8AAP/+AAP//wAA//4AAf//AAD//AAB//8AAP/4
AAD//wAA//AAAH//AAD/4AAAP/8AAP/gAAAf/wAA/8AAAB//AAD/gAAAD/8AAP8AAAAH/wAA/gAAAAP/
AAD+AAAAAf8AAPwAAAAB/wAA+AAAAAD/AADwAAAAAH8AAPAAAAAAPwAA4AAAAAA/AADgAAAAAD8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//
AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//4AA///AAAoAAAAIAAAAEAAAAABAAQAAAAAAAAC
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAICAgADAwMAAAAD/AAD/
AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5+AAAAAAAAAAAAAAAAAA
BoyHAAAAAAAAAAAAAAAAAOfn7AAAAAAAAAAAAAAAAAjIzn6AAAAAAAAAAAAAAAAO5uxo7AAAAAAAAAAA
AAAAaM7ObI6AAAAAAAAAAAAADn5ubOboyAAAAAAAAAAAAH7Ozs5sbo4AAAAAAAAAAAjI5+fn7saM4AAA
AAAAAAAO7n7Ozsbs6OcAAAAAAAAAaH7O5+bn5s6MgAAAAAAABo7o5+zs7Ozm6OAAAAAAAH7I7Ozufn5u
zsfsAAAAAAjOjn6Ofs7s5+bsjnAAAAAG6Ozo7O7n5+zs5ujnAAAAaOyOjo587Ozo6I7IjIAAAGxmxsZ+
7o7uzsbG7O4AAAAAAAAM587OyOhgAAAAAAAAAAAABo7n5+7OYAAAAAAAAAAAAAzozuzujsAAAAAAAAAA
AAAGjufuzs5wAAAAAAAAAAAADOfOyOfowAAAAAAAAAAAAAaOfm7O7mAAAAAAAAAAAAAM7Ofs5sjAAAAA
AAAAAAAABn585+7oYAAAAAAAAAAAAAyM6Oxs58AAAAAAAAAAAAAG5+zm5+5gAAAAAAAAAAAABOx+fs7I
wAAAAAAAAAAAAAZ+Z8hs7kAAAAAAAAAAAAAMjOjm52fAAAAAAAAAAAAAAGbExsbOAAAAAAAA///////8
f///+D////A////gH///4A///8AH//+AA///AAP//gAB//4AAP/8AAB/+AAAf/AAAD/gAAAf4AAAD8AA
AAfAAAAP/4AH//+AB///gAf//4AH//+AB///gAf//4AH//+AB///gAf//4AH//+AB///gAf//4AH///A
D/8oAAAAGAAAADAAAAABAAQAAAAAACABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAA
AACAAIAAgIAAAICAgADAwMAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAA
AAAABgAAAAAAAAAAAAAAeOAAAAAAAAAAAAAG7IcAAAAAAAAAAAB+fujgAAAAAAAAAAbs7OyHAAAAAAAA
AGjufm7oYAAAAAAABo7OzsfOhwAAAAAAaO5+5+7s6GAAAAAG5+zs7Ozn7PYAAABo6Ojo7n6IjojgAAAM
bGzs7OyOx+wAAAAAAAfo7o7nAAAAAAAAAAaM7OyGAAAAAAAAAAbufu6MAAAAAAAAAAd+zn6GAAAAAAAA
AAzn7OznAAAAAAAAAAaOzuiGAAAAAAAAAAbn587sAAAAAAAAAAZ87m6GAAAAAAAAAAzozs6MAAAAAAAA
AAaOh+eGAAAAAAAAAABsbGxgAAAAAAAAAAAAAAAAAAAAAP///wD/7/8A/8f/AP+D/wD/Af8A/gD/APwA
fwD4AD8A8AAfAOAADwDAAAcA4AAPAP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A
/wD/Af8A////ACgAAAAQAAAAIAAAAAEABAAAAAAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAACA
AAAAgIAAgAAAAIAAgACAgAAAgICAAMDAwAAAAP8AAP8AAAD//wD/AAAA/wD/AP//AAD///8AAAAABgAA
AAAAAABoYAAAAAAABo6MAAAAAABozshgAAAABo5uboYAAABo7OfOeGAABo5+fn6OhgB2xs7O6MfHgAAA
aOfIYAAAAABuzujgAAAAAGjn6MAAAAAAzs5+cAAAAABo5+jAAAAAAG7OyOAAAAAAaI6OcAAAAAAMbGYA
AAD+/wAA/H8AAPg/AADwHwAA4A8AAMAHAACAAwAAAAEAAPAfAADwHwAA8B8AAPAfAADwHwAA8B8AAPAf
AAD4PwAAKAAAADAAAABgAAAAAQAIAAAAAAAACQAAAAAAAAAAAAAAAQAAAAEAAAAAAACjaB0ApmsgAKlt
IwCrcCYArXMqALF1LACzeC4ArHYwALR6MQC4fTQAt385AMh1AADJdwQAy3gAAM17AADOfQEAy3oHAM5/
CQDMfA0A0H4BAMt/GQC7gDcAvoI6ALmBPADRgAIA0oIEANSDBADVhQUA1ogGANaMBwDZiQYA3I0GANKE
CgDWhwkA0YIMANaMCwDZiggA2o0JANyOCQDbkgsA3pAKAN6UCwDekg0A3ZQNAM+EGgDRhhUA1YkSANiN
EgDajhcA2pISANqSHgDalh4A3ZgaAOGUCgDgkg0A4ZUOAOSWDgDhmA4A5ZgPAOicDgDklxAA45cVAOGY
EADlmRAA5ZwRAOSdFwDonRIA550YAOmfGwDpoBIA6qEUAO2iFADrpBQA7qUWAO6mGADvqBgA8KUXAPCm
GADxqRgA9KsZAPKsGgD0rBoA9a0cAPiuGgD1sBsA+bEbAPixHADOhycAzo0lAMqKKwDRjCIA0Y8lANSP
JgDTji0A05ImANiRIwDdnScA1JQpANmVKwDXmCoA25stAMGJNQDAhj0A0I84AM2VPwDTmTYA3JwyANKR
OQDSlDgA2Js6AOGeIADknS8A3qAxANyiPwDopCAA7qogAOKiLQDtqykA8asjAPOxJwD6syAA+LMkAPq1
JwD2tSoA+rYsAPq4LgDiozEA6qUzAOepNQDpqTEA66wyAOmrNwDtqjUA6qw2AO2vNQDjpjoA6aw4AOir
PwDwrDgA67A3AO2xOQDssT8A8rIwAPazMwD2tzEA8bE2APq7NgDytDoA+Lc6APW5PAD5uToA+bw7APi7
PQD5vD0A/L49APzAPgCxgEMAv4VAALaFSAC5h0sAvJZmALyacgC5mnYAxYlBAMOLRgDHi0QAyY1GAMaO
SgDJj0oAyZBEAMyQSgDPlEkAypFNAM6TTADNlE4A0pVHANebQwDUnUUA0JRNANaaSgDDkVUAzpZWAM2X
WwDOmVsAzZpdANGZVgDUmlcA0ppaANOcWwDQnF4A16BHANqiSADapUkA3adLAN2lTQDbo1QA1KFeANql
WwDgpkMA4KtOAO6sSwDxrUYA8rdAAPGxRQD1uUAA+r1AAPSySADirl0Ax5ljAMOYZgDFmWUAz51gAM+f
ZADBnG4AxJ1uANGeYgDQnmUA0aBjANalYwDVoWQA2KRgAN+sYwDbqWYA3aplAN2sZwDRo2sA1KdrANWl
bADZqmoA3q5qAMWhcgDNpHMAzKV1AMmmeQDUqXAA1Kp5ANuwcADhrWAA569jAOCvaQDismgA5LRoAOGy
bADitGwA+8BDALGchQCxnokAxa2OAMqwkQDPs5MA1LiXAN3AngDjwJYAAAAAAP///wAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADc2b4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAOy6sLjRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAA+7oVbN2+ogAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAulgR
DLTFuvYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAC6aCMREQzGvroAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAALisLxsUERET4Nm4AAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAA6awxJhsbGxERLuC+0QAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAD6rGArJiYdGxsREV7gvqIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACoYz4+NyYm
GxsbERGx3Lr2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKhsREM3PjcpJh8bGxQRw9y6AAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAtapFSEhGOzc3KSYfGxsbE+DauAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAADXpYJIT0hIRkY3NzcmJhsbGS7w2dEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
APqeipBPT01IRkZGPjc3JiYbGxFg8L6iAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJ5yzZdPT09NSEZG
Ozc3NyYmGxsZbvC49gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGnLzpd5T09PTk1GRkZDNzcmJh0bEcHj
ugAAAAAAAAAAAAAAAAAAAAAAAAAAAACgnsuX9fV5V1dPT05NRkZGNzc3Jh8fGyPu47cAAAAAAAAAAAAA
AAAAAAAAAAAAAKELjs719fV+V09XT05OTkhGRjdDNyYmHxsv8dnRAAAAAAAAAAAAAAAAAAAAAAAA+AmI
l/X1l/WTV1dXV09PTk5IRkY3NzcpJh0bYPG+ogAAAAAAAAAAAAAAAAAAAAAACGrLl8719fWXeVdXT1RX
Tk5NSEZGRjc3KSYdG27tvvcAAAAAAAAAAAAAAAAAAAAIZo7Ll87OzvX1fldXVFRTT1dOTUhGRjs+NyYm
JhvC67YAAAAAAAAAAAAAAAAAAJ0JgZDLy8uczs7Ofld5eVdPVE9PTk1IRkY7NzcpJh8i0Ou4AAAAAAAA
AAAAAAAA1whxjI6Qy5PLl/XOl3l5V3l5eVdPV05NTUZGRjs3KSYfMPHj6QAAAAAAAAAAAAAABGOBjIyU
k8uXnJf1l3l5eXl5V1dXT1dOTU1GRjw7NzYfHzPxvvwAAAAAAAAAAACfWnFwf4CAgoyLy4yXznlPeVR5
V1dXV05XTneLz8/Pz8/Pz8/J79wAAAAAAAAAAADqAQECAgMDAwQEBAaXznx5VHl5V1dXV1dPV5WkpKam
pqarp6ezs/0AAAAAAAAAAAAAAAAAAAAAAAAAAASXy5NQVXlUeXlXV1dXTpWkAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAASXy5NPVVVUeXlXV1dXV5dnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAASQy8t4UFVVeVR5eVdXV5dnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOQjst8TFBV
VVR5eXlXeZeeAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKMjJCOUFBQT1V5VHl5eZcWAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKCjI6MdEhPVU95VXlUeZwKAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAKCgoKOdkh0UE9VVXlUeZwKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAJ/f4KCgkhITExPT1VVeZwJAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAF/f4GMjHNG
SExPVU95VZwJAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAF1cXF/iHVGRkh0UFBQT5wJAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFlZXF/f4FDQ0ZGSExPVZcGAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAFlZWVxdX9vLENGRnRQT5cJAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAFvY2VlcXFxKT9BRkZMTMsEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFjY2RlZXFx
NSwsRkZGTJMEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFgY2NkZWVxYSksPz9GRssEAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFgWVlkY2RxcTIoLCxGRowEAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAFZWWRZZGRkcTQdLCw/Q4wDAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAFYWVljWWRjZGQyHSgogYECAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOcBv7+/wcHB
wsjHZXFxdQHnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADnAQEBAQEBAQEBAQEBAecAAAAA
AAAAAAAAAAAAAAAAAAD///////8AAP///////wAA////////AAD///j///8AAP//8H///wAA///gP///
AAD//+Af//8AAP//wB///wAA//+AD///AAD//wAH//8AAP/+AAP//wAA//4AAf//AAD//AAB//8AAP/4
AAD//wAA//AAAH//AAD/4AAAP/8AAP/gAAAf/wAA/8AAAB//AAD/gAAAD/8AAP8AAAAH/wAA/gAAAAP/
AAD+AAAAAf8AAPwAAAAB/wAA+AAAAAD/AADwAAAAAH8AAPAAAAAAPwAA4AAAAAA/AADgAAAAAD8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//
AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//4AA///AAAoAAAAIAAAAEAAAAABAAgAAAAAAAAE
AAAAAAAAAAAAAAABAAAAAQAAAAAAAKdIAACpSgAArU0AALBSAACxVQAAtFYAALdYAAC5WwAAuVwAALxe
AAC/YQAAvGgNALllFwC5Zx8AtWUpAMJkAADFaAAAyGsAAMxuAgDOcQYA0nYJANR5DQDFdREAz34aANd8
EADafxMA0IAGANSDBQDThAYA1YUFANiJBwDThg8A2YoIANqNCQDcjQoA25AKAN2QCgDekQ0A35UNAN2A
FgDXjxAA2Y4UAN6DGQDWjBsA3ZEQAN6UFgDdmBgA4JMKAOCSDQDhlQ4A5ZcPAOSZDgDghhsA44geAOSW
EADjmxEA5ZoQAOScEQDnnxQA6Z0SAOWcGgDpoBIA6aEUAO2iFADtpBYA5qAZAO+oGgDwphcA8acYAPGp
GAD0qxkA86waAPSsGgD1rhwA9rAbAPawHAD4sBoA+LEcAMyAIADXhSMA0IUnAN+NKgDRkScA2pYhAN2b
IwDcmyUA05MoANWWKQDali8A2ZksANucLQDcnS4A3Z0xAN2TOwDblT8A1po7ANKYPADVmj0A154+AOaO
JADjkCoA5ZIuAOqTKgDtkysA7ZQrAOiTLQDulSwA4pIxAOmWMQDrlzUA6J02AOOaOQDgnTwA6pw5APCa
NADynj0A36AvAN6hMADdoDgA2aE/AOSgIQDioSYA7KchAO2oJgDgoCkA6agrAPewIAD5tCIA+bQnAPOx
KAD5tigA+bcvAOOmMgDjpjQA5KU0AOepNQDnrD8A6Ko4AOyvOADprj8A86A/AO+zOgDysjAA8LE3APe4
NgD7ujEA8rY7APCzPQDytj4A9Lg6APW6PQD7vDoA+b0+AMWARADPkEUA3ZlEANmbTQDPnF8A0phUAOqe
QgDdoEEA2aJGAN2kRADep0kA3aVOANuiUADdplQA4ahGAO2qRwDooEgA4alKAOOtTQDzoUAA869EAPap
TgDsskAA77JGAOewTgDusUoA6rBMAPC1QwD0ukUA9rxGAPm9QQDwskkA8rVNAPe+SAD1uk8A+L5IAPWp
UADyqlQA6rRRAO22UgDuuFQA47BbAPCyUQD0vFAA8r5WAPC2XAD4sV0AyZ5nAMSlfwDfr3MA2K19AOWt
YgDltmcA67NgAOm5YQDsu2oA77ptAPW+awDwvm0A+bhpAOizcQDiu34A7Lt9APS9cAD7wEIA+8FGAPnA
SAD4wk4A+MNZAPnEWgD6w2AA/ctkAMOnhQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAABta58AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAbc2/a8oAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKpvpabIawAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADWcqgdHaa/awAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAG2JLR8dIM6tXgAAAAAAAAAAAAAAAAAAAAAAAAAAAABlsT0xIx8dLNJzngAAAAAA
AAAAAAAAAAAAAAAAAAAAUq58PDMxIyMdWdVr4gAAAAAAAAAAAAAAAAAAAAAAAJypj0REMzMxJSMdochr
AAAAAAAAAAAAAAAAAAAAAADLcN9KRURERDMxJSMjw69lAAAAAAAAAAAAAAAAAAAAAFDhuH9KSkQzRDMx
JSMq0o1fAAAAAAAAAAAAAAAAAAAY4Nu4gUdHQ0VEM0QlJSNU2XPJAAAAAAAAAAAAAAAAT8TcuNuSTUpK
R0REMzsxJSNd1WsAAAAAAAAAAAAAAJtw3bi425hNTUpKSkRERDMzMSOryGsAAAAAAAAAAADMUd2Vl7i4
mIFNTU1KSkRERDMzMSXQr2wAAAAAAAAAABfBsJOXmLi4g01NTU1KSkRERDk5MS3ZdJ0AAAAAAAAMz7S0
urrFxbiETYFNTU1KSo+xlbq6tMfTa9gAAAAAAJoGBgYGCQkL35FLTU2BTU1KthkZKys1NmSgAAAAAAAA
AAAAAAAAAAnfl0pLTU1NgU29FgAAAAAAAAAAAAAAAAAAAAAAAAAABt2VgkpNgU1NTdwVAAAAAAAAAAAA
AAAAAAAAAAAAAAAGxrGPSkpKTU2B2xQAAAAAAAAAAAAAAAAAAAAAAAAAAAbCi5BDREpLTU3cEwAAAAAA
AAAAAAAAAAAAAAAAAAAABMGIi3xAR0pLTdwTAAAAAAAAAAAAAAAAAAAAAAAAAAADsoWKjzlEQ0pL3BEA
AAAAAAAAAAAAAAAAAAAAAAAAAAOrhYWFOztEREq7EQAAAAAAAAAAAAAAAAAAAAAAAAAAA6tdXIV5OTtE
Q7YLAAAAAAAAAAAAAAAAAAAAAAAAAAABpVxcdn0nMztEtgkAAAAAAAAAAAAAAAAAAAAAAAAAAAGhWFpd
di8nMzu1CQAAAAAAAAAAAAAAAAAAAAAAAAAAAaVTWFxdViUnJ7EGAAAAAAAAAAAAAAAAAAAAAAAAAAAB
YFNYWFhcKSQnsAYAAAAAAAAAAAAAAAAAAAAAAAAAAA/XYWBjoaF3VFZWDQAAAAAAAAAAAAAAAAAAAAAA
AAAAAA8BAQEBAQEEBA4AAAAAAAAAAAAAAAD///////x////4P///8D///+Af///gD///wAf//4AD//8A
A//+AAH//gAA//wAAH/4AAB/8AAAP+AAAB/gAAAPwAAAB8AAAA//gAf//4AH//+AB///gAf//4AH//+A
B///gAf//4AH//+AB///gAf//4AH//+AB///gAf//8AP/ygAAAAYAAAAMAAAAAEACAAAAAAAQAIAAAAA
AAAAAAAAAAEAAAABAAAAAAAApWYWAKhpGQCqbBsAqm0dAKxuHgCucCEAsHMjALJ2JgC2eioAuH4uALyC
MgC9gzQAvoU1AN+YEwDklw8A5ZkQAOmdEgDooBIA6aEUAO2hFQDtpRYA8KYXAPGqFwDxpxgA8qoZAPSr
GgD0rRoA86wcAPauHAD3sBoA97AcAPmwGgD4sRwAwIY3AMGJOQDDizwAxIs8AMWNPgDjnSUA5J4nAN6g
MADnoyAA5aAnAOSjKQDgoi8A7awpAPCsIwD6syIA+rcrAOKlMwDqqzIA6Kk3AOSpOgDpqz0A+rozAPq6
NADytjsA97s+APe8PAD5uzgA36VCAN+sVADgqUQA5axHAOmuQADkrUoA6bNKAO63TgDws0EA9btDAPS6
RQD6vkEA9LxMAPm+SADhrlUA5LJZAPK7UAD7wEMA+8NOAPbBUAD6xFIA+8VUAPDDaQD0xmwA9shtAPjK
bgD6zW8A8cmCAPPMhAD0zoYA99CHAPDPmQDw0JkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAD///8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAmAAAAAAAA
AAAAAAAAAAAAAAAAAAAAACZcJgAAAAAAAAAAAAAAAAAAAAAAAAAAJjYnXSYAAAAAAAAAAAAAAAAAAAAA
AAAiRREPJ10mAAAAAAAAAAAAAAAAAAAAAAtHFhYQECddJgAAAAAAAAAAAAAAAAAACkobGxYRERAnXSYA
AAAAAAAAAAAAAAAJUjAbGxgbFhEQKF0mAAAAAAAAAAAAAAhSTjEgGxsbFhYRECtdJgAAAAAAAAAABjpI
SDggICAbGBgWERAnXSYAAAAAAAAFOVBSUk84IDAgGxtUW1paWlwmAAAAAAAABQUGBgg8IDAgMBtWCwsL
IiIAAAAAAAAAAAAAAAY6HiAgMCBXCgAAAAAAAAAAAAAAAAAAAAVHGx4wICBXCgAAAAAAAAAAAAAAAAAA
AAVJGxseMCBXCQAAAAAAAAAAAAAAAAAAAAVJLxsbHjBXCAAAAAAAAAAAAAAAAAAAAAFELhYcGx5XCAAA
AAAAAAAAAAAAAAAAAAFDMxMVGxtXBgAAAAAAAAAAAAAAAAAAAAFANCsWFhxVBgAAAAAAAAAAAAAAAAAA
AAE/MisOEBZVBQAAAAAAAAAAAAAAAAAAAAE9KS0OEBNUAwAAAAAAAAAAAAAAAAAAAAE+S0xAND9TAwAA
AAAAAAAAAAAAAAAAAAABAQEBAwEBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA////AP/v
/wD/x/8A/4P/AP8B/wD+AP8A/AB/APgAPwDwAB8A4AAPAMAABwDgAA8A/gD/AP4A/wD+AP8A/gD/AP4A
/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP8B/wD///8AKAAAABAAAAAgAAAAAQAIAAAAAAAAAQAAAAAAAAAA
AAAAAQAAAAEAAAAAAAClZhYAsnYmALN4KQC4fi8A1Y0XANWOGADXkBkA2pUbANuVHADclhwA3poeAOCc
HwDgmyAA46EiAOaiIwDmpiMA56cnAOilIwDppiUA66omAO2rJwDuricA46YsAOyrKADurikA7q4sAPCv
KQDvsS4A8LAqAO2vMQDkpjgA5q8+AOqwOADwszIA4qtBAOi0TwDyvEoA7LlSAOSyXADnt18Aw5ljAMui
bQDqumEA5LhoAOa7cADpv3MA78FlAPDFdgDyyXkA88x6APXNegD20IAA6MeQAOnIkQDpyZcAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAP///wAAAAAAAAAAAwAAAAAAAAAAAAAAAAAAAzcCAAAAAAAAAAAAAAAAAycFNQIAAAAA
AAAAAAAAAysLCAY1BAAAAAAAAAAAAy8SDg0IBjUEAAAAAAAAAzMaFBIODQgINQQAAAAAAzQlIhQaEg4f
Li01BAAAKQEBAQEbGhQUMAQEBAQqAAAAAAABGxsbFDMEAAAAAAAAAAAAARwbGxszBAAAAAAAAAAAAAEe
FBsbMwQAAAAAAAAAAAABIRQcHDMEAAAAAAAAAAAAASARFBQzBAAAAAAAAAAAAAEjFw4WMwQAAAAAAAAA
AAABLCgkJjMDAAAAAAAAAAAAAAEBAQEBAAAAAAAA/v8AAPx/AAD4PwAA8B8AAOAPAADABwAAgAMAAAAB
AADwHwAA8B8AAPAfAADwHwAA8B8AAPAfAADwHwAA+D8AACgAAAAwAAAAYAAAAAEAIAAAAAAAgCUAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAADAAAABgAAAAgAAAAGAAAAAwAA
AAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAMAAAAFgAA
ABsAAAAWAAAACwAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAA
AAwAAAAfAAAAMwAAADwAAAAyAAAAHQAAAAsAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAACAAAACSccDyHPllLiypFQ4M2UUesdFQtZAAAANQAAABoAAAAJAAAAAgAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAEAAAAHAAAAF8aOTb/RlU3z0pVH/82UU/K/iUvcAAAAUAAAADAAAAAWAAAABgAA
AAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUAAAATs4BGjtOXUfXLfxn/0pE5/9ikYP7Rl1T3pXdBvQAA
AEoAAAAqAAAAEgAAAAUAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAA+RaDhc0ZdR+M6HJv3Legf/yHUA/9aa
Sv/Tn1v51JlU+nxZMZcAAABDAAAAJAAAAA4AAAADAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAADFg/ITLPlE/1z4wz+NGC
DP/NewD/y3gA/8l3BP/apVv/zZdV89OYU/hHMxxzAAAAPAAAAB8AAAALAAAAAgAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAAAJJxwOIMiO
SuHNj0Dy1YkR/9ODBf/QfwH/zXsA/8t4AP/MfA3/3apl/8yXV/DLklDuHBQLXQAAADYAAAAaAAAACAAA
AAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAA
AAcAAAAXu4VEvMuPRvPajhf/2osK/9aIBv/UgwX/0YAD/819Af/LeQD/z4Qa/92sZ//OmFfyvYhL2QAA
AE8AAAAvAAAAFQAAAAYAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAABAAAABQAAABOodjyMyY5H9tuTH//ekg7/3Y4K/9qLCP/Whwb/1IMF/9GAA//PfQD/y3kA/9OO
Lf/bqWX90plW96R2QbsAAABJAAAAKQAAABEAAAAFAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAEAAAAD4hfL1rHjEb42ZUq/eOXFf/jlQ7/35IN/92OCv/aiwn/14gG/9SE
Bf/SgQT/z34B/8t6AP/Xm0P/1qNg+dKYU/p6WDCVAAAAQgAAACMAAAAOAAAAAwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAAALUzkcMsSJQvPRkTL3550Y/+ecEf/lmBD/45UP/+CS
Df/djgr/24sJ/9eIB//VhAb/0oED/9B+Af/NfAP/26NU/9CcXPPSllP4RzMccwAAADsAAAAeAAAACgAA
AAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAAkUDgYeu4I938eLO/Lpnxv/7qIU/+qg
E//onRL/5pkR/+SWDv/gkw3/3o8L/9uMCf/ZiQf/1YUG/9OBBP/QfwP/zn8J/9+sY//Nmlvwy5JQ7RYQ
CVoAAAA0AAAAGQAAAAgAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAABwAAABaueDe4wYY98+qq
Mf/vphb/8KYX/+2iFf/roBP/6J0S/+aZEf/klw//4JQO/96QCv/bjQn/2YoI/9WFBv/TgwT/0H8D/9GG
Ff/gr2n/z5pb87qHSdYAAABOAAAALgAAABQAAAAGAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAFAAAAEpxr
MIe9gjr36Ks///azM//zqRj/8agY//CkF//uoxX/66AU/+mdEv/mmhD/5JcP/+GUDf/ekAr/240K/9mJ
B//Whwb/04IE/9B/Af/Ujyb/3q5p/dKZV/ifcj62AAAARwAAACgAAAARAAAABAAAAAEAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAMAAAAOfVUkV7p/N/jcoT389rlB//m4Of/1rBv/86oZ//GoGP/wphf/7qMV/+ugE//pnhL/55oR/+SX
EP/hlQ7/3pIL/9yNCf/aiwf/1ocF/9ODBP/RgAP/2Js6/9ioZvjTmFT6dlYukQAAAEEAAAAjAAAADQAA
AAMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAgAAAAtGMBQvtXsz8sySOPb1uUD/+75B//q8Pf/4sB//9Kwa//OrGv/yqRn/8KYX/+6j
Ff/roBT/6Z4T/+ecEf/kmBD/4ZUO/9+SC//djgn/2ooI/9aHBv/UgwT/0YAC/9ylT//So2Tzz5VR90Mw
GnAAAAA6AAAAHQAAAAoAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAACAAAACRIMBR2udS/cvYI08/K3QP/7v0H/+79B//u+Qf/4syX/9q0a//Ws
G//zqxr/8akZ//GmGP/uoxX/7aEU/+qeE//nnBH/5ZgP/+GVDv/fkg3/3I4K/9qLB//WiAf/1IQF/9KE
Cv/hrWD/z55i8MmPTusPCwZXAAAAMwAAABgAAAAIAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAHAAAAFqJtKba0eTDz7LE///q+Qf/7v0H/+79B//vA
Q//6tiz/+K4a//auG//1rRr/9Ksa//KpGf/wpxj/76MX/+2hFP/pnxP/6JwS/+WYD//hlQ//35IN/92O
Cv/aiwn/14gH/9SEBf/ViRP/4rJo/8+cXfS4hEjVAAAATQAAAC0AAAAUAAAABgAAAAEAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUAAAASjl8jgq91LPfjpjr/+Ls///q+
Qf/7v0H/+79B//vAQ//7vDb/+bEc//iwHP/2rhz/9a0b//SrGv/yqhn/8agY/++kF//toRT/6p8T/+ic
Ev/lmRD/45YO/9+TDf/djwv/2owI/9eJB//UhQT/2JEj/+Gya/zRmVf5mm48sQAAAEYAAAAnAAAAEAAA
AAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAA5zTBtTrXIp+NOY
NPzytz3/+bw+//q9QP/6vkH/+79B//u/Qf/7vj7/+rMg//mxHP/4sBz/9q4c//WsG//0rBr/86oZ//Go
GP/vpBf/7aEV/+qfE//onRH/5ZkQ/+OWD//gkw7/3Y8J/9uMCP/XiQf/1YQG/9uaNv/armz30phU+nJR
LI0AAABAAAAAIgAAAAwAAAADAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAACzom
DSyobyXxv4Ut9e2wOv/1ujz/+Ls9//m8QP/6vUD/+r5B//u/Qf/7v0L/+rUn//mxG//5sR3/+LAc//au
HP/1rRv/9Kwa//OqGf/xqBj/76QX/+6iFf/roBP/6JwS/+aZEP/klg//4JMN/96OC//bjQn/2YkI/9WF
Bv/fpkz/06Zp8s2TUPY/LRhtAAAAOQAAABwAAAAJAAAAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAEGRAFFKRqI9mwdibx56o3//G0Ov/ztjv/9bo8//a7Pv/5vED/+r1A//q+Qf/7wEP/+rgu//mx
G//5sh3/+bId//ixHP/2sBz/9a0b//SrGv/yqhn/8agY//CmF//uoxX/6qAT/+mdEf/mmRD/5JYP/+CT
Dv/ejwr/3IwK/9mJB//Whwn/4q5d/9GiZ+7Hj0znEg0HSAAAACcAAAAPAAAAAwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAGoGcgpaluIvLdoDP/6q03/++yOf/xtDr/87Y7//S4PP/2uz3/+bw+//m9
QP/6vkL/+rs3//myHP/5sh3/+bId//myHf/5sR3/+LAc//WtHP/0rRv/9KsZ//KpGP/wphf/7qMV/+ug
E//onhL/55oR/+SXD//hlA3/3pAL/9yNCf/Zigf/2I0S/+S0aP/ToGPwvolJxAAAACcAAAARAAAABQAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiaB9ppmsg9dKVL//nqjX/67A3/+6yOP/wtDr/87Y7//W4
PP/4uz3/+b0+//m9QP/5vUD/+rw7//myHv/5sh3/+bId//myHf/5sh3/+LEd//iwHP/2rhv/9awb//Or
Gv/xqBn/8KYY/+6jFf/roBP/6p4Q/+icDv/llw3/4ZQK/9+QCf/cjQb/2okF/9mRHf/ismj40ZVQ9MGK
SogAAAALAAAAAwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACmaR7PyYgn+uSdL//loDD/56Iy/+qk
M//rpjT/7qk3//CrOP/xrTn/8a05//CxOP/4vD7/+bxA//izJP/4sRz/+bId//myHf/5sh3/+bId//mx
Hf/4sBz/9q4c//WsG//zqxr/8qkY//GrI//xsDr/8bFF//W0Sf/2s0n/9LJI//OwSP/yr0f/8a1G//Cs
R//urEv/5ahV6dGVT+AAAAAEAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACkaR2XpGoe/6Vq
H/+mayD/pmwh/6hsIv+pbSP/qW4k/6twJf+scCf/rXIn/65zKf/6vDz/+LxA//a1Kv/2sBr/+bEd//my
Hf/5sh3/+bId//myHf/5sR3/+LAc//auHP/1rRv/9Ksa//a3Ov/EiED/xYlB/8aKQ//Hi0T/yY1G/8qO
R//Lj0n/zJBK/82RS//Ok0z/0JRN/9GVTpcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAK1yJ//5uzv/9rs+//a3
Mf/1rhr/9rAc//iyHf/5sh3/+bId//myHf/5sh3/+bEd//iwHP/2rhz/9a0b//m5Ov/Chj//AAAAKwAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKtw
Jf/4tzr/9Lg9//W3OP/0rRz/9a4b//awHP/4sh3/+bId//myHf/5sh3/+bId//mxHf/4sBz/9q4c//q8
O//AhT3/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKpvJP/0tTn/8rU8//O2Pf/zsSf/86wZ//WuG//2sBz/+LEd//myHf/5sh3/+bId//my
Hf/5sh3/+LEc//u9PP+/gzv/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKluI//yszf/77M6//K1Pf/ysjD/8aoY//SsGv/1rhz/9rAc//ix
Hf/5sh3/+bId//myHf/5sh3/+bId//y+Pf+9gTn/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKdtIv/wsDb/7bA5//CzO//xszj/8Kkb//Gq
Gf/yqxr/9a4b//awHP/4sR3/+bId//myHf/5sh3/+bId//y/Pv+7gDf/AAAAKwAAAA4AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKZrIf/tqzT/6qw3/+2w
OP/vsjr/7qog/+6nFf/xqhn/86wa//StG//2sBz/+LEd//myHf/5sh3/+bId//zAPv+5fjX/AAAAKwAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKZq
IP/pqTL/56k0/+qsN//tsDn/7asp/+2jFP/vqBj/8aoZ//KsGv/1rhv/9rAc//ixHP/5sh3/+bId//zA
Pv+4fDT/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKRqHv/mpC//5KYz/+epNP/pqzf/66wy/+mhFf/rpBT/7qcY//CqGf/zrBr/9K0b//Ww
HP/2sRz/+LId//zAPv+2ezL/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKRoHf/koi//4KIx/+SmMv/nqDb/6aw4/+ikIP/ooBL/7aQV/+6n
F//xqRn/8qwa//StG//1rhz/9rAc//zAPv+1eTD/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/goC3/36Aw/+CiMP/kpDP/56k2/+en
Lv/mnRL/6KAT/+ujFf/uphj/8KkY//KrGv/0rRv/9a4c//y+Pf+zeC7/AAAAKwAAAA4AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/enSz/3J0v/96f
L//goTD/5KYy/+anM//knRf/5Z0R/+igE//qoxX/7qYX//CpGP/yqxn/86wb//q9Pf+ydi3/AAAAKwAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNo
Hf/dnCr/25wt/9ydLv/eny//4KIw/+OmM//hniD/4ZgO/+WdEv/ooBP/6qIU/+6mF//wqBj/8qsa//m9
O/+wdCv/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKNoHf/bmCj/2Zgs/9qaLf/bnC7/3p8v/+CiMf/goCn/3pUO/+GZD//lnRL/6KAT/+qi
Ff/uphf/8KgY//a5O/+ucyn/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/XlSf/1ZYq/9mYLP/ami3/25wu/92eL//goTH/3Zga/96U
C//hmBD/5ZwS/+efE//qohX/7aYX//W4Ov+tcij/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/WlCb/1JQo/9WVKf/XmCr/2pot/9uc
Lv/enzH/3Z0n/9uSC//elQ3/4ZgQ/+ScEf/nnxP/6qIU//K1OP+rcCb/AAAAJwAAAA0AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/TkiX/0pIo/9OU
KP/VlSj/15cq/9qaLf/bnC//3Z4v/9qSEv/ajwn/3ZUO/+CXD//knBH/558S//GyNv+qbyX/AAAAHwAA
AAkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNo
Hf/SjyT/0I8m/9KSJ//TlCj/1JUp/9eXKv/ZmS3/250w/9qWHv/WjAf/25IL/92UDf/hmBD/5JwR/+2v
Nf+pbiP/AAAAEwAAAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKNoHf/RjCL/zY0l/8+OJv/RkCf/05Mo/9SUKf/Wlyn/2pkt/9qaLP/WjQ//1owI/9qP
Cv/dlA7/5aYz/+qsNP+obCL/AAAACAAAAAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHZ6jaB3/1J1G/9SeRf/XoEf/2qJI/9qlSf/bpkn/3adL/+Cr
Tv/gpkP/25wr/92eLP/goi//46Uv/6ZqIP+jaR+gAAAAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACjaB2eo2gd/6NoHf+jaB3/o2gd/6No
Hf+jaB3/o2gd/6NoHf+jaB3/o2gd/6NoHf+jaB7/pWke/6RpHp4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAD///Af//8AAP//
8B///wAA///gD///AAD//8AH//8AAP//gAP//wAA//8AAf//AAD//wAB//8AAP/+AAD//wAA//wAAH//
AAD/+AAAP/8AAP/wAAAf/wAA//AAAB//AAD/4AAAD/8AAP/AAAAH/wAA/4AAAAP/AAD/AAAAAf8AAP8A
AAAB/wAA/gAAAAD/AAD8AAAAAH8AAPgAAAAAPwAA8AAAAAA/AADwAAAAAB8AAOAAAAAADwAA4AAAAAAP
AADgAAAAAA8AAOAAAAAADwAA4AAAAAAPAADgAAAAAD8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8
AAB//wAA//wAAH//AAD//AAAf/8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8AAB//wAA//wAAH//
AAD//AAAf/8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8
AAD//wAA//4AA///AAAoAAAAIAAAAEAAAAABACAAAAAAAIAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJCKQwWOiQLMQAA
ADAAAAAfAAAACgAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACyHwmPemQ
KPPulSz/w3YbvwAAADgAAAAcAAAABwAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAatq
Hh3qkirx5a1i//KqVP/vly7/klgQiAAAADMAAAAXAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AABOMA0J5I4l1eidNv/dpU7/26JQ//iyXv/ulCz+SisDXQAAAC0AAAARAAAAAwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAABNyJIaPqmzb64ahG/9OEBv/QgAb/3aZU//WpUP/okCj4EgoARAAAACcAAAANAAAAAgAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAALOfhxj6JUt+eesP//dkRD/2IkH/9SDBf/Thg//5bZn//OhQP/ZhSHgAAAAPQAA
ACEAAAAKAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAACsWgUMeONJPjvskb/5Zwa/+CSDf/djgr/2IkH/9WEBf/WjBv/77pt//Ca
NP+6cRiwAAAAOAAAABsAAAAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAY5RDBfdhRrt869E/+2oJv/onRL/5ZgQ/+GUDf/djgv/2ooI/9WF
Bv/ali//+Lhp/++XLv+IUQyAAAAAMgAAABUAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG1YAVy+2pRfvzsjD/76UX/+yhFP/onRP/5ZkQ/+GU
Dv/dkAr/2osI/9aGBv/doEH/+bJd/+2TK/4rGQBQAAAALAAAABAAAAACAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABMl2D5TjmTb7+sVa//WsHP/yqRj/8KYX/+2i
FP/pnhL/5pkR/+KVDv/dkQv/24sI/9iJCv/jsFv/9qlO/+SOJfQAAABAAAAAJgAAAA0AAAACAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAK7bAtd14Qg+/3LZP/6vkH/97Ag//Sr
Gf/yqhn/8KYX/+2iFf/qnhP/5psR/+KWDv/fkQv/24wJ/9mOFP/su2r/86A//9WCHdgAAAA8AAAAIAAA
AAkAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABl1EBKc56Evb6w2D/+8FG//u/
Q//5tCf/9q0Z//SsGv/yqRr/8KYX/+6iFf/qnxP/55sR/+KWD//ekQz/24wJ/9uVIf/0vXD/8Jo0/6xo
EqMAAAA3AAAAGgAAAAYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAVIrAA7Hcwjm8LJR//rB
S//7v0H/+8BD//u6Mf/4sBr/9q4c//WsG//zqhn/8acY/+6jFf/qnxP/55sR/+OXDv/fkg3/240J/96e
Mv/6uGn/7ZUs/2Y+BWoAAAAxAAAAFQAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFv2sHv+Cd
PP74wk7/+r1A//q+Qf/7wEL/+7w6//mxHf/5sRz/964c//StGv/0qxr/8agY/+6iFv/rnxP/6JwR/+SW
EP/gkg3/3I0J/+KoSv/4sFz/6pIo/DokA1MAAAArAAAAEAAAAAIAAAAAAAAAAAAAAAAAAAAAAAAAA7Zj
CYbQhCT7879V//S4O//2uz7/+bxA//q+Qv/7vj//+bQi//mxG//5sh3/968c//WtG//zqhn/8agY/++l
Fv/roBP/6JwR/+WXD//gkg3/3pAP/+m5Yf/2qU7/4Ioi7QAAAD8AAAAlAAAADAAAAAIAAAAAAAAAAAAA
AACtWQRFxXMO++22Uv/vszr/8rY7//W5PP/4vD3/+r5B//q+Qf/5tij/+bEb//myHf/5sR3/97Ac//Wu
G//0qxr/8akZ/++kFv/roRT/6J0Q/+WYDf/gkwr/3pQW//C+bf/ynj3/z38axgAAACkAAAASAAAAAwAA
AAAAAAAAvWoGQrpiA/Trs2D/6rBL/e2ySv3xtEz987dN/fW6Tv30vE/9+L1A//m3L//4sRv/+bId//my
Hf/5sh3/+LAc//atHP/zqxv/87Iw//G1Q/7ws0f987VL/fGySv3vsEn98LZc/vW+a/7tlCv/4I0mmAAA
AAkAAAACAAAAAAAAAACtTgBIsVQCvLNXAP+xVQD/tFcA/7dYAP+5WwD/vF4A/71fAP/5wlLz97g2//aw
G//5sR3/+bId//myHf/5sh3/+LAc//auHP/3vEb/13wQ/9p/E//dgBb/3oMZ/+CGG//jiB7/5o4k/+eO
ItrnjiVwAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAulwA//jA
UfL1uTr/9K8e//awG//5sh3/+bId//myHf/5sh3/+LAd//i+SP/UeQ3/AAAALgAAAA0AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAC3WgD/87xP8vK2Pv/zsSj/9KwZ//awHP/4sR3/+bId//myHf/5sh3/+cBI/9J2Cf8AAAAuAAAADQAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAALRXAP/xuU3y8LM9//KyMv/xqhj/9K0b//avHP/4sh3/+bId//myHf/6wUj/znEG/wAA
AC4AAAANAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAsVQA/+61S/Lsrzn/8LE3/++oGv/xqhj/9K0a//awHP/4sR3/+bId//rB
SP/MbgL/AAAALgAAAA0AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwUgD/6bBI8ueqNv/srzj/7Kch/+2lFP/wqhn/9K0b//av
HP/4shz/+sFI/8hrAP8AAAAuAAAADQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAK9PAP/mrEXy46Yy/+iqOP/pqCv/6aET/+2m
Fv/xqRn/86wa//SuHP/5wEj/xWgA/wAAAC4AAAANAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAArUwA/+KpRPLfoTD/5KU0/+ep
Nf/moBn/6aAS/+2lF//wqRj/86wa//e+SP/CZAD/AAAALgAAAA0AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACqSwD/4KZC8tyd
L//foC//46Y0/+SgIf/kmw//6KEU/+ykFv/wqRj/9bxH/79hAP8AAAAuAAAADQAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKdJ
AP/do0Dy2Zot/9ydLv/fojL/4KAp/9+WD//knBH/6KAT/+2lFv/0ukX/vF8A/wAAAC4AAAANAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAp0gA/9mfPvLWliv/2Zos/9ydL//eoDD/3ZgY/9+VDP/kmxL/558U//C2Q/+5XAD/AAAALgAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAACnSAD/2J498tOTKP/Wlin/2Zks/9ydMf/cmyX/25AK/9+WDv/jmxH/7LJA/7dY
AP8AAAAsAAAADAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKdIAP/Wmjr90ZEn/9OTKP/Vlin/2Zkt/9ucLf/XjxD/2Y8J/9+V
Dv/prj//tFUA/wAAAB4AAAAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAp0gA1tWcRK/SmDz/1Zo9/9eePv/ZoT//3aRE/92g
OP/alyH/3Zsj/+KhJv+zVgHoAAAACwAAAAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACnSABLp0gA1qdIAP+nSAD/p0gA/6dI
AP+nSQD/qUkA/6pLAP+sTgD/sFIA4KJGAE0AAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAP/4D///8Af//+AH///gA///wAH//4AA//8AAP/+AAB//gAAP/wAAB/4AAAP8AAAD+AA
AAfgAAADwAAAAcAAAAGAAAABgAAAA/+AAf//gAH//4AB//+AAf//gAH//4AB//+AAf//gAH//4AB//+A
Af//gAH//4AB//+AAf//gAP/KAAAABgAAAAwAAAAAQAgAAAAAABgCQAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAADGjj9nxo4//8aOP2cAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMSMPGfFjD7/8M+Z/8aO
P//Gjj9nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAwok5Z8OKO//pqz3/450m//DQmf/Gjj//xo4/ZwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAC+hTZnwIY3//Cz
Qf/onBH/5JcP/+OdJf/w0Jn/xY4+/8aOP2cAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAALuBMme8gzP/9LpF/++mFv/soRT/6JwS/+WYEP/jnyb/8dCZ/8WN
Pv/Gjj9nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAuH0tZ7l/
L//5vkj/9Kwa//KpGf/wphf/7aEV/+meEv/lmRD/5J4n//DQmv/FjT3/xY0/ZwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAC0eClntnoq//vFU//6syL/964a//WsG//yqhr/8acY/+2i
Ff/qnhP/5ZkQ/+SfJ//x0Jr/xY09/8WOPmcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAALF0
JGeydib/+8ZU//vAQ//6tyv/+bAa//evHP/1rRv/86sZ//GnGP/tohb/6p8T/+aaEP/loCf/8dGZ/8SM
Pf/FjT5nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAArXAgZ69xIv/3uz7/+r1A//q/Q//6ujP/+bEb//my
Hf/3sBz/9a0b//OqGv/xpxj/7qMV/+qfE//nmhD/5Z8n//HQmv/Dizz/xY09ZwAAAAAAAAAAAAAAAAAA
AAAAAAAAq24e//K2O//2wVD/+sRS//vFVf/7w07/+ro0//myHf/5sh3/+LAc//WuHP/0qxr/9shs//fQ
h//0zob/88yE//HJgv/x0Zj/xIs8/wAAAAAAAAAAAAAAAAAAAAAAAAAAqWscdaptHf+sbx7/rnAg/69y
Iv+wcyP/+bs4//mxHP/5sh3/+bId//mxHf/2rhz/+Mpu/7yCMv+9gzT/voU1/8CGN//AiDj/wok6dQAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACucCH/97w8//ewGv/5sh3/+bId//my
Hf/5sRz/+cxv/7l/L/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAACsbh7/9btD//WtGf/3sRz/+bId//myHf/5sh3/+81v/7h8Lf8AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACqbB3/9LxM//Os
HP/1rRr/97Ed//myHf/5sh3/+85v/7Z6Kv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACpahr/8rtQ//CsI//xqhf/9K4b//exHf/5sh3/+85v/7N3
J/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACoaRn/7rdO/+2sKf/uphX/8qsa//StG//3sBz/+85v/7F1Jf8AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACmZxf/6bNK/+qrMv/qohX/7qYW//Kr
Gv/0rRv/+c1v/69yIv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAClZhb/5axH/+ipN//noyD/6aAR/+2lF//xqhn/98pu/61wIP8AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/4KlE/+Kl
M//koyn/5JsQ/+igFP/tpRb/9sht/6ttHv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/36VC/96gMP/goi//35gT/+SbEP/ooBP/9MZs/6ps
G/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAClZhb/36xU/+GuVf/ksln/5K1K/+SpOv/prkD/8MNp/6hqGv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhZ1pWYW/6VmFv+lZhb/pWYW/6Vm
Fv+lZhb/pmcX/6doGHUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAP///wD/x/8A/4P/AP8B/wD+AP8A/AB/APgAPwDwAB8A4AAPAMAA
BwDAAAcAwAAHAP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A/wD+AP8A////ACgA
AAAQAAAAIAAAAAEAIAAAAAAAQAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACxcSJds3gp/76DM18AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACycSJds3gp/+nJl/+ydib/voMzXwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACxcSJds3gp/+SyXP/VjRf/6MeQ/7J2Jv++gzNfAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACxciJds3gp/+q6Yf/emh7/2pUb/9WOGP/ox5H/uH4v/76DNF0AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACycyNfs3gp/+/BZf/opSP/46Ei/+CbIP/blRz/1Y8Z/+jHkf+4fi//voM0XQAAAAAAAAAAAAAAAAAA
AACxciJes3gp//TNe//uriz/66om/+mmJf/moiP/4Jwf/9yWHP/XkBn/6ceR/7h+L/++gzRdAAAAAAAA
AACwcSJes3gp//bQgP/yvEr/8LMy/+6uJ//sqyj/6acm/+aiI//kpjj/6b9z/+a7cP/pyJH/uH4v/76D
NF0AAAAApWYWqqVmFv+lZhb/pWYW/6VmFv/wryj/764p/+yrKP/qpyX/8MV2/7h+L/+4fi//uH4v/7h+
L/+xdCWqAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/8LAr//CwKf/vryr/7asn//LJef+4fi//AAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAApWYW/++xLv/wryn/8LAq//CvKv/0zHr/uH4v/wAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKVmFv/trzH/7q4n//CwKv/wsCr/9s17/7h+
L/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/6rA4/+urJv/urin/768q//bO
e/+4fi//AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAApWYW/+avPv/npyf/66om/+6u
KP/2z3r/uH4v/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKVmFv/iq0H/46Ys/+am
I//rqyf/9M16/7h+L/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/5Lho/+e3
X//otE//7LlS//PMev+4fi//AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAu4Eyd6Vm
Fv+lZhb/pWYW/6VmFv+lZhb/wIc5dwAAAAAAAAAAAAAAAAAAAAAAAAAA/H8AAPg/AADwHwAA4A8AAMAH
AACAAwAAAAEAAAABAADwHwAA8B8AAPAfAADwHwAA8B8AAPAfAADwHwAA8B8AAA==
</value>
</data>
</root>

View File

@@ -55,7 +55,7 @@ Namespace DownloadObjects
End If
BTT_CLEAR.Visible = ViewMode = ViewModes.Session
RefillList()
Catch ex As Exception
Catch
Finally
Opened = True
End Try
@@ -96,7 +96,7 @@ Namespace DownloadObjects
_TempUsersList.ListAddList(Downloader.Downloaded, LParams)
Else
_TempUsersList.ListAddList(Settings.Users.SelectMany(Of IUserData) _
(Function(u) If(u.IsCollection, DirectCast(u, API.UserDataBind).Collections, {u})), LParams)
(Function(u) If(u.IsCollection, DirectCast(u, API.UserDataBind).Collections, {u})), LParams)
End If
If _TempUsersList.Count > 0 Then
_TempUsersList.Sort(New UsersDateOrder)
@@ -161,12 +161,12 @@ Namespace DownloadObjects
End Sub
Private Sub LIST_DOWN_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_DOWN.MouseDoubleClick
Try
If _LatestSelected >= 0 AndAlso _LatestSelected <= _TempUsersList.Count - 1 AndAlso
If _LatestSelected.ValueBetween(0, _TempUsersList.Count - 1) AndAlso
Not DirectCast(_TempUsersList(_LatestSelected), UserDataBase).Disposed Then _TempUsersList(_LatestSelected).OpenFolder()
Catch ex As Exception
Catch
End Try
End Sub
Friend Sub Downloader_OnDownloadCountChange()
Friend Sub Downloader_DownloadCountChange()
If ViewMode = ViewModes.Session Then RefillList()
End Sub
Private Sub BTT_UP_Click(sender As Object, e As EventArgs) Handles BTT_UP.Click

206
SCrawler/Download/FeedMedia.Designer.vb generated Normal file
View File

@@ -0,0 +1,206 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Public Class FeedMedia : Inherits System.Windows.Forms.UserControl
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim TP_LBL As System.Windows.Forms.TableLayoutPanel
Me.CH_CHECKED = New System.Windows.Forms.CheckBox()
Me.LBL_INFO = New System.Windows.Forms.Label()
Me.CONTEXT_DATA = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.BTT_CONTEXT_OPEN_MEDIA = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_OPEN_USER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_OPEN_USER_URL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_OPEN_USER_POST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_FIND_USER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_INFO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_DELETE = New System.Windows.Forms.ToolStripMenuItem()
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_3 = New System.Windows.Forms.ToolStripSeparator()
TP_LBL = New System.Windows.Forms.TableLayoutPanel()
TP_LBL.SuspendLayout()
Me.CONTEXT_DATA.SuspendLayout()
Me.TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTEXT_SEP_1
'
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(134, 6)
'
'CONTEXT_SEP_2
'
CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
CONTEXT_SEP_2.Size = New System.Drawing.Size(134, 6)
'
'CONTEXT_SEP_3
'
CONTEXT_SEP_3.Name = "CONTEXT_SEP_3"
CONTEXT_SEP_3.Size = New System.Drawing.Size(134, 6)
'
'TP_LBL
'
TP_LBL.ColumnCount = 2
TP_LBL.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_LBL.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_LBL.Controls.Add(Me.CH_CHECKED, 0, 0)
TP_LBL.Controls.Add(Me.LBL_INFO, 1, 0)
TP_LBL.Dock = System.Windows.Forms.DockStyle.Fill
TP_LBL.Location = New System.Drawing.Point(0, 0)
TP_LBL.Margin = New System.Windows.Forms.Padding(0)
TP_LBL.Name = "TP_LBL"
TP_LBL.RowCount = 1
TP_LBL.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_LBL.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_LBL.Size = New System.Drawing.Size(146, 25)
TP_LBL.TabIndex = 0
'
'CH_CHECKED
'
Me.CH_CHECKED.AutoSize = True
Me.CH_CHECKED.CheckAlign = System.Drawing.ContentAlignment.MiddleCenter
Me.CH_CHECKED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_CHECKED.Location = New System.Drawing.Point(3, 3)
Me.CH_CHECKED.Name = "CH_CHECKED"
Me.CH_CHECKED.Size = New System.Drawing.Size(19, 19)
Me.CH_CHECKED.TabIndex = 0
Me.CH_CHECKED.UseVisualStyleBackColor = True
'
'LBL_INFO
'
Me.LBL_INFO.AutoSize = True
Me.LBL_INFO.ContextMenuStrip = Me.CONTEXT_DATA
Me.LBL_INFO.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_INFO.Location = New System.Drawing.Point(28, 0)
Me.LBL_INFO.Name = "LBL_INFO"
Me.LBL_INFO.Size = New System.Drawing.Size(115, 25)
Me.LBL_INFO.TabIndex = 1
Me.LBL_INFO.TextAlign = System.Drawing.ContentAlignment.MiddleLeft
'
'CONTEXT_DATA
'
Me.CONTEXT_DATA.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_OPEN_MEDIA, Me.BTT_CONTEXT_OPEN_USER, CONTEXT_SEP_1, Me.BTT_CONTEXT_OPEN_USER_URL, Me.BTT_CONTEXT_OPEN_USER_POST, CONTEXT_SEP_2, Me.BTT_CONTEXT_FIND_USER, Me.BTT_CONTEXT_INFO, CONTEXT_SEP_3, Me.BTT_CONTEXT_DELETE})
Me.CONTEXT_DATA.Name = "CONTEXT_PIC"
Me.CONTEXT_DATA.Size = New System.Drawing.Size(138, 176)
'
'BTT_CONTEXT_OPEN_MEDIA
'
Me.BTT_CONTEXT_OPEN_MEDIA.Image = Global.SCrawler.My.Resources.Resources.Folder_32
Me.BTT_CONTEXT_OPEN_MEDIA.Name = "BTT_CONTEXT_OPEN_MEDIA"
Me.BTT_CONTEXT_OPEN_MEDIA.Size = New System.Drawing.Size(137, 22)
Me.BTT_CONTEXT_OPEN_MEDIA.Text = "Open"
'
'BTT_CONTEXT_OPEN_USER
'
Me.BTT_CONTEXT_OPEN_USER.Image = Global.SCrawler.My.Resources.Resources.Folder_32
Me.BTT_CONTEXT_OPEN_USER.Name = "BTT_CONTEXT_OPEN_USER"
Me.BTT_CONTEXT_OPEN_USER.Size = New System.Drawing.Size(137, 22)
Me.BTT_CONTEXT_OPEN_USER.Text = "Open user"
'
'BTT_CONTEXT_OPEN_USER_URL
'
Me.BTT_CONTEXT_OPEN_USER_URL.Image = Global.SCrawler.My.Resources.Resources.GlobeBlue_32
Me.BTT_CONTEXT_OPEN_USER_URL.Name = "BTT_CONTEXT_OPEN_USER_URL"
Me.BTT_CONTEXT_OPEN_USER_URL.Size = New System.Drawing.Size(137, 22)
Me.BTT_CONTEXT_OPEN_USER_URL.Text = "Open user"
'
'BTT_CONTEXT_OPEN_USER_POST
'
Me.BTT_CONTEXT_OPEN_USER_POST.Image = Global.SCrawler.My.Resources.Resources.GlobeBlue_32
Me.BTT_CONTEXT_OPEN_USER_POST.Name = "BTT_CONTEXT_OPEN_USER_POST"
Me.BTT_CONTEXT_OPEN_USER_POST.Size = New System.Drawing.Size(137, 22)
Me.BTT_CONTEXT_OPEN_USER_POST.Text = "Open post"
'
'BTT_CONTEXT_FIND_USER
'
Me.BTT_CONTEXT_FIND_USER.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_CONTEXT_FIND_USER.Name = "BTT_CONTEXT_FIND_USER"
Me.BTT_CONTEXT_FIND_USER.Size = New System.Drawing.Size(137, 22)
Me.BTT_CONTEXT_FIND_USER.Text = "Find user"
'
'BTT_CONTEXT_INFO
'
Me.BTT_CONTEXT_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_CONTEXT_INFO.Name = "BTT_CONTEXT_INFO"
Me.BTT_CONTEXT_INFO.Size = New System.Drawing.Size(137, 22)
Me.BTT_CONTEXT_INFO.Text = "Information"
'
'BTT_CONTEXT_DELETE
'
Me.BTT_CONTEXT_DELETE.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_CONTEXT_DELETE.Name = "BTT_CONTEXT_DELETE"
Me.BTT_CONTEXT_DELETE.Size = New System.Drawing.Size(137, 22)
Me.BTT_CONTEXT_DELETE.Text = "Delete"
'
'TP_MAIN
'
Me.TP_MAIN.ColumnCount = 1
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_MAIN.Controls.Add(TP_LBL, 0, 0)
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Margin = New System.Windows.Forms.Padding(0)
Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 2
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(146, 146)
Me.TP_MAIN.TabIndex = 0
'
'FeedMedia
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.BackColor = System.Drawing.SystemColors.Window
Me.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
Me.Controls.Add(Me.TP_MAIN)
Me.ForeColor = System.Drawing.SystemColors.WindowText
Me.Margin = New System.Windows.Forms.Padding(0)
Me.Name = "FeedMedia"
Me.Size = New System.Drawing.Size(146, 146)
TP_LBL.ResumeLayout(False)
TP_LBL.PerformLayout()
Me.CONTEXT_DATA.ResumeLayout(False)
Me.TP_MAIN.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
Private WithEvents TP_MAIN As TableLayoutPanel
Private WithEvents CONTEXT_DATA As ContextMenuStrip
Private WithEvents BTT_CONTEXT_OPEN_MEDIA As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_OPEN_USER_URL As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_OPEN_USER_POST As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_FIND_USER As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_OPEN_USER As ToolStripMenuItem
Private WithEvents CH_CHECKED As CheckBox
Private WithEvents LBL_INFO As Label
Private WithEvents BTT_CONTEXT_INFO As ToolStripMenuItem
End Class
End Namespace

View File

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

View File

@@ -0,0 +1,234 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
'Imports System.Windows.Forms.PropertyGridInternal
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools
Imports SCrawler.API.Base
Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD
Namespace DownloadObjects
<ToolboxItem(False), DesignTimeVisible(False)>
Public Class FeedMedia
#Region "Declarations"
Private Const VideoHeight As Integer = 450
Private WithEvents MyPicture As PictureBox
Private ReadOnly MyImage As ImageRenderer
Private ReadOnly MyVideo As FeedVideo
Friend ReadOnly Property Exists As Boolean
Get
Return Not MyPicture Is Nothing Or Not MyVideo Is Nothing
End Get
End Property
Friend ReadOnly Property HasError As Boolean
Friend ReadOnly File As SFile
Public Shadows Property Width As Integer
Get
Return MyBase.Width
End Get
Set(ByVal w As Integer)
If Size.Width <> w Then
Dim s As New Size(w, If(MyImage Is Nothing, VideoHeight, MyImage.FitToWidthF(w).Height))
Dim objSize As Size = s
objSize.Height += (TP_MAIN.RowStyles(0).Height + PaddingE.GetOf({TP_MAIN}).Vertical(2))
MinimumSize = objSize
MyBase.MaximumSize = objSize
Size = objSize
If Not MyImage Is Nothing Then
With MyPicture
.MinimumSize = Nothing
.MaximumSize = Nothing
.Size = s
.MinimumSize = s
.MaximumSize = s
End With
End If
End If
End Set
End Property
Private ReadOnly UserKey As String
Private ReadOnly Post As UserMedia
Friend ReadOnly Property Checked As Boolean
Get
Return CH_CHECKED.Checked
End Get
End Property
Friend ReadOnly Property Information As String
#End Region
#Region "Initializers"
Public Sub New()
InitializeComponent()
End Sub
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer)
Try
InitializeComponent()
File = Media.Data.File
If Not File.Exists And Media.Data.Type = UserMedia.Types.Video Then File.Path = $"{File.Path.CSFilePS}Video"
If Not File.Exists Then
If Not Media.Data.SpecialFolder.IsEmptyString Then
File.Path = $"{File.Path.CSFilePS}{Media.Data.SpecialFolder}".CSFileP
If Not File.Exists And Media.Data.Type = UserMedia.Types.Video Then File.Path = $"{File.Path.CSFilePS}Video"
End If
End If
If File.Exists Then
Information = $"Type: {Media.Data.Type}"
Information.StringAppendLine($"File: {File.File}")
Information.StringAppendLine($"Address: {File}")
Information.StringAppendLine($"Downloaded: {Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)}")
If Media.Data.Post.Date.HasValue Then Information.StringAppendLine($"Posted: {Media.Data.Post.Date.Value.ToStringDate(ADateTime.Formats.BaseDateTime)}")
Dim info$ = $"[{Media.Data.Type}] - "
Dim h%
Dim s As Size
Post = Media.Data
Select Case Media.Data.Type
Case UserMedia.Types.Picture, UserMedia.Types.GIF
MyImage = New ImageRenderer(File)
s = MyImage.FitToWidthF(Width)
h = s.Height
MyPicture = New PictureBox With {
.SizeMode = PictureBoxSizeMode.Zoom,
.Image = MyImage,
.InitialImage = .Image,
.Dock = DockStyle.None,
.Anchor = AnchorStyles.Left + AnchorStyles.Top,
.Size = s,
.MinimumSize = s,
.MaximumSize = s,
.Tag = File,
.Margin = New Padding(0),
.Padding = New Padding(0),
.ContextMenuStrip = CONTEXT_DATA
}
TP_MAIN.Controls.Add(MyPicture, 0, 1)
BTT_CONTEXT_OPEN_MEDIA.Text &= " picture"
BTT_CONTEXT_DELETE.Text &= " picture"
Case UserMedia.Types.Video
MyVideo = New FeedVideo(File) With {.Tag = File, .Dock = DockStyle.Fill, .ContextMenuStrip = CONTEXT_DATA}
TP_MAIN.Controls.Add(MyVideo, 0, 1)
BTT_CONTEXT_OPEN_MEDIA.Text &= " video"
BTT_CONTEXT_DELETE.Text &= " video"
h = VideoHeight
Case Else : Throw New ArgumentNullException With {.HelpLink = 1}
End Select
If Not Media.User Is Nothing Then
With Media.User
UserKey = .Key
Information &= vbNewLine.StringDup(2)
If .IncludedInCollection Then Information.StringAppendLine($"User collection: { .CollectionName}")
Information.StringAppendLine($"User site: { .Site}")
Information.StringAppendLine($"User name: {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}")
If .Site = API.Instagram.InstagramSite Then BTT_CONTEXT_OPEN_USER_POST.Visible = False
If .IncludedInCollection Then info &= $"[{ .CollectionName}]: "
info &= $"{ .Site} - {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}"
End With
End If
If Not MyVideo Is Nothing Then info &= $" ({MyVideo.VideoLength})"
LBL_INFO.Text = info
'TT_MAIN.SetToolTip(LBL_INFO, Information)
s = New Size(Width, h + TP_MAIN.RowStyles(0).Height + PaddingE.GetOf({TP_MAIN}).Vertical(2))
Size = s
MinimumSize = s
MaximumSize = s
Else
Throw New ArgumentNullException With {.HelpLink = 1}
End If
Catch aex As ArgumentNullException When aex.HelpLink = 1
HasError = True
Catch tex As Threading.ThreadStateException
HasError = True
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[DownloadObjects.FeedMedia({File})]")
HasError = True
End Try
End Sub
#End Region
#Region "Dispose"
Private Sub FeedImage_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MyImage Is Nothing Then MyImage.Dispose()
If Not MyPicture Is Nothing Then MyPicture.Dispose()
If Not MyVideo Is Nothing Then MyVideo.Dispose()
End Sub
#End Region
#Region "LBL"
Private Sub LBL_INFO_DoubleClick(sender As Object, e As EventArgs) Handles LBL_INFO.DoubleClick
If Not UserKey.IsEmptyString Then
Dim u As IUserData = Settings.GetUser(UserKey)
If Not u Is Nothing Then u.OpenFolder()
End If
End Sub
#End Region
#Region "Picture / Video objects"
Private Sub MyPicture_DoubleClick(sender As Object, e As EventArgs) Handles MyPicture.DoubleClick
Try : Process.Start(File) : Catch : End Try
End Sub
#End Region
#Region "Context"
Private Sub BTT_CONTEXT_OPEN_MEDIA_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_MEDIA.Click
File.Open(, EDP.None)
End Sub
Private Sub BTT_CONTEXT_OPEN_USER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER.Click
If Not UserKey.IsEmptyString Then
Dim u As IUserData = Settings.GetUser(UserKey)
If Not u Is Nothing Then u.OpenFolder()
End If
End Sub
Private Sub BTT_CONTEXT_OPEN_USER_URL_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER_URL.Click
If Not UserKey.IsEmptyString Then
Dim u As IUserData = Settings.GetUser(UserKey)
If Not u Is Nothing Then u.OpenSite()
End If
End Sub
Private Sub BTT_CONTEXT_OPEN_USER_POST_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER_POST.Click
Try
If Not UserKey.IsEmptyString And Not Post.Post.ID.IsEmptyString Then
Dim u As IUserData = Settings.GetUser(UserKey)
If Not u Is Nothing Then
Dim url$ = UserDataBase.GetPostUrl(u, Post)
If Not url.IsEmptyString Then
Try : Process.Start(url) : Catch : End Try
End If
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"[FeedMedia.OpenPost({UserKey}, {Post.Post.ID})]")
End Try
End Sub
Private Sub BTT_CONTEXT_FIND_USER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_FIND_USER.Click
If Not UserKey.IsEmptyString Then MainFrameObj.FocusUser(UserKey, True)
End Sub
Private Sub BTT_CONTEXT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_INFO.Click
MsgBoxE({Information, "Post information"})
End Sub
Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click
DeleteFile(False)
End Sub
Friend Function DeleteFile(ByVal Silent As Boolean) As Boolean
Const msgTitle$ = "Deleting a file"
Try
If Silent OrElse MsgBoxE({$"Are you sure you want to delete the [{File.File}] file?{vbCr}{File}", msgTitle}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
If File.Delete(SFO.File, Settings.DeleteMode, EDP.ThrowException) Then
If Not Silent Then MsgBoxE({"File deleted", msgTitle})
LBL_INFO.Height = 0
If Not MyPicture Is Nothing Then MyPicture.Size = New Size(0, 0)
Height = 0
Return True
End If
End If
Return False
Catch ex As Exception
Dim e As New ErrorsDescriber(EDP.LogMessageValue) With {.ShowMainMsg = Not Silent, .ShowExMsg = .ShowMainMsg}
Return ErrorsDescriber.Execute(e, ex, $"[FeedMedia.DeleteFile({File})]", False)
End Try
End Function
#End Region
End Class
End Namespace

181
SCrawler/Download/FeedVideo.Designer.vb generated Normal file
View File

@@ -0,0 +1,181 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Public Class FeedVideo : Inherits System.Windows.Forms.UserControl
<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 TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_BUTTONS As System.Windows.Forms.TableLayoutPanel
Me.MyVideo = New LibVLCSharp.WinForms.VideoView()
Me.TR_POSITION = New System.Windows.Forms.TrackBar()
Me.BTT_PLAY = New System.Windows.Forms.Button()
Me.BTT_PAUSE = New System.Windows.Forms.Button()
Me.BTT_STOP = New System.Windows.Forms.Button()
Me.TR_VOLUME = New System.Windows.Forms.TrackBar()
Me.LBL_TIME = New System.Windows.Forms.Label()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_BUTTONS = New System.Windows.Forms.TableLayoutPanel()
TP_MAIN.SuspendLayout()
CType(Me.MyVideo, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TR_POSITION, System.ComponentModel.ISupportInitialize).BeginInit()
TP_BUTTONS.SuspendLayout()
CType(Me.TR_VOLUME, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'TP_MAIN
'
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(Me.MyVideo, 0, 0)
TP_MAIN.Controls.Add(Me.TR_POSITION, 0, 1)
TP_MAIN.Controls.Add(TP_BUTTONS, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Margin = New System.Windows.Forms.Padding(0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.Size = New System.Drawing.Size(180, 160)
TP_MAIN.TabIndex = 0
'
'MyVideo
'
Me.MyVideo.BackColor = System.Drawing.Color.Black
Me.MyVideo.Dock = System.Windows.Forms.DockStyle.Fill
Me.MyVideo.Location = New System.Drawing.Point(1, 1)
Me.MyVideo.Margin = New System.Windows.Forms.Padding(1)
Me.MyVideo.MediaPlayer = Nothing
Me.MyVideo.Name = "MyVideo"
Me.MyVideo.Size = New System.Drawing.Size(178, 105)
Me.MyVideo.TabIndex = 0
'
'TR_POSITION
'
Me.TR_POSITION.Dock = System.Windows.Forms.DockStyle.Fill
Me.TR_POSITION.Location = New System.Drawing.Point(3, 110)
Me.TR_POSITION.Name = "TR_POSITION"
Me.TR_POSITION.Size = New System.Drawing.Size(174, 19)
Me.TR_POSITION.TabIndex = 1
'
'TP_BUTTONS
'
TP_BUTTONS.ColumnCount = 5
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 100.0!))
TP_BUTTONS.Controls.Add(Me.BTT_PLAY, 0, 0)
TP_BUTTONS.Controls.Add(Me.BTT_PAUSE, 1, 0)
TP_BUTTONS.Controls.Add(Me.BTT_STOP, 2, 0)
TP_BUTTONS.Controls.Add(Me.TR_VOLUME, 4, 0)
TP_BUTTONS.Controls.Add(Me.LBL_TIME, 3, 0)
TP_BUTTONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_BUTTONS.Location = New System.Drawing.Point(1, 133)
TP_BUTTONS.Margin = New System.Windows.Forms.Padding(1)
TP_BUTTONS.Name = "TP_BUTTONS"
TP_BUTTONS.RowCount = 1
TP_BUTTONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BUTTONS.Size = New System.Drawing.Size(178, 26)
TP_BUTTONS.TabIndex = 2
'
'BTT_PLAY
'
Me.BTT_PLAY.BackgroundImage = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_PLAY.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_PLAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_PLAY.Location = New System.Drawing.Point(1, 1)
Me.BTT_PLAY.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_PLAY.Name = "BTT_PLAY"
Me.BTT_PLAY.Size = New System.Drawing.Size(23, 24)
Me.BTT_PLAY.TabIndex = 0
Me.BTT_PLAY.UseVisualStyleBackColor = True
'
'BTT_PAUSE
'
Me.BTT_PAUSE.BackgroundImage = Global.SCrawler.My.Resources.Resources.Pause_Blue_16
Me.BTT_PAUSE.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_PAUSE.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_PAUSE.Location = New System.Drawing.Point(26, 1)
Me.BTT_PAUSE.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_PAUSE.Name = "BTT_PAUSE"
Me.BTT_PAUSE.Size = New System.Drawing.Size(23, 24)
Me.BTT_PAUSE.TabIndex = 1
Me.BTT_PAUSE.UseVisualStyleBackColor = True
'
'BTT_STOP
'
Me.BTT_STOP.BackgroundImage = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_STOP.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_STOP.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_STOP.Location = New System.Drawing.Point(51, 1)
Me.BTT_STOP.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_STOP.Name = "BTT_STOP"
Me.BTT_STOP.Size = New System.Drawing.Size(23, 24)
Me.BTT_STOP.TabIndex = 2
Me.BTT_STOP.UseVisualStyleBackColor = True
'
'TR_VOLUME
'
Me.TR_VOLUME.Dock = System.Windows.Forms.DockStyle.Fill
Me.TR_VOLUME.Location = New System.Drawing.Point(81, 3)
Me.TR_VOLUME.Name = "TR_VOLUME"
Me.TR_VOLUME.Size = New System.Drawing.Size(94, 20)
Me.TR_VOLUME.TabIndex = 3
'
'LBL_TIME
'
Me.LBL_TIME.AutoSize = True
Me.LBL_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_TIME.Location = New System.Drawing.Point(78, 0)
Me.LBL_TIME.Name = "LBL_TIME"
Me.LBL_TIME.Size = New System.Drawing.Size(1, 26)
Me.LBL_TIME.TabIndex = 4
Me.LBL_TIME.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
'
'FeedVideo
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.Controls.Add(TP_MAIN)
Me.Name = "FeedVideo"
Me.Size = New System.Drawing.Size(180, 160)
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
CType(Me.MyVideo, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TR_POSITION, System.ComponentModel.ISupportInitialize).EndInit()
TP_BUTTONS.ResumeLayout(False)
TP_BUTTONS.PerformLayout()
CType(Me.TR_VOLUME, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents MyVideo As LibVLCSharp.WinForms.VideoView
Private WithEvents TR_POSITION As TrackBar
Private WithEvents BTT_PLAY As Button
Private WithEvents BTT_PAUSE As Button
Private WithEvents BTT_STOP As Button
Private WithEvents TR_VOLUME As TrackBar
Private WithEvents LBL_TIME As Label
End Class
End Namespace

View File

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

View File

@@ -0,0 +1,82 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports LibVLCSharp
Imports System.ComponentModel
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Namespace DownloadObjects
<ToolboxItem(False), DesignTimeVisible(False)>
Public Class FeedVideo
Private WithEvents MediaPlayer As [Shared].MediaPlayer
Private ReadOnly TimeChange As Action = Sub()
Dim v# = DivideWithZeroChecking(MediaPlayer.Time, MediaPlayer.Length) * 10
If v > 10 Then TR_POSITION.Value = 10 Else TR_POSITION.Value = v
End Sub
Private ReadOnly TimeChangeLabel As Action = Sub()
If MediaPlayer.Time >= 0 Then
Dim t As TimeSpan = TimeSpan.FromMilliseconds(MediaPlayer.Time)
LBL_TIME.Text = $"{VideoLength}/{t}"
End If
End Sub
Private ReadOnly MyImage As ImageRenderer
Friend ReadOnly VideoLength As TimeSpan
Public Sub New()
InitializeComponent()
End Sub
Friend Sub New(ByVal File As SFile)
InitializeComponent()
Dim debugLogs As Boolean = False
#If DEBUG Then
debugLogs = True
#End If
MediaPlayer = New [Shared].MediaPlayer(New [Shared].Media(New [Shared].LibVLC(enableDebugLogs:=debugLogs), New Uri(File.ToString)))
MyVideo.MediaPlayer = MediaPlayer
TR_VOLUME.Value = MediaPlayer.Volume / 10
If MediaPlayer.Length >= 0 Then VideoLength = TimeSpan.FromMilliseconds(MediaPlayer.Length)
If Settings.UseM3U8 Then
Dim f As SFile = $"{Settings.CachePath.PathWithSeparator}FeedSnapshots\{File.GetHashCode}.png"
If Not f.Exists Then f = FFMPEG.TakeSnapshot(File, f, Settings.FfmpegFile, TimeSpan.FromSeconds(1))
If f.Exists Then
MyImage = New ImageRenderer(f, EDP.None)
If Not MyImage.HasError Then
MyVideo.BackgroundImage = MyImage
MyVideo.BackgroundImageLayout = ImageLayout.Zoom
End If
End If
End If
End Sub
Private Sub FeedVideo_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MediaPlayer Is Nothing Then MediaPlayer.Dispose()
If Not MyImage Is Nothing Then MyImage.Dispose()
End Sub
Private Sub BTT_PLAY_Click(sender As Object, e As EventArgs) Handles BTT_PLAY.Click
Try : MediaPlayer.Play() : Catch : End Try
End Sub
Private Sub BTT_PAUSE_Click(sender As Object, e As EventArgs) Handles BTT_PAUSE.Click
Try : MediaPlayer.Pause() : Catch : End Try
End Sub
Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click
Try : MediaPlayer.Stop() : Catch : End Try
End Sub
Private Sub MediaPlayer_TimeChanged(sender As Object, e As [Shared].MediaPlayerTimeChangedEventArgs) Handles MediaPlayer.TimeChanged
If TR_POSITION.InvokeRequired Then TR_POSITION.Invoke(TimeChange) Else TimeChange.Invoke
If LBL_TIME.InvokeRequired Then LBL_TIME.Invoke(TimeChangeLabel) Else TimeChangeLabel.Invoke
End Sub
Private Sub TR_POSITION_MouseUp(sender As Object, e As MouseEventArgs) Handles TR_POSITION.MouseUp
Try : MediaPlayer.Time = (MediaPlayer.Length / 100) * (TR_POSITION.Value * 10) : Catch : End Try
End Sub
Private Sub TR_VOLUME_MouseUp(sender As Object, e As MouseEventArgs) Handles TR_VOLUME.MouseUp
Try : MediaPlayer.Volume = TR_VOLUME.Value * 10 : Catch : End Try
End Sub
Private Sub MediaPlayer_Stopped(sender As Object, e As EventArgs) Handles MediaPlayer.Stopped
Dim a As Action = Sub() TR_POSITION.Value = TR_POSITION.Maximum
If TR_POSITION.InvokeRequired Then TR_POSITION.Invoke(a) Else a.Invoke
End Sub
End Class
End Namespace

View File

@@ -15,9 +15,6 @@ Namespace DownloadObjects.Groups
Friend Delegate Sub GroupEventHandler(ByVal Sender As DownloadGroup)
Friend Event Deleted As GroupEventHandler
Friend Event Updated As GroupEventHandler
#Region "XML Names"
Private Const Name_Name As String = "Name"
#End Region
Private WithEvents BTT_EDIT As ToolStripMenuItem
Private WithEvents BTT_DELETE As ToolStripMenuItem
Private WithEvents BTT_DOWNLOAD As ToolStripMenuItem
@@ -25,7 +22,6 @@ Namespace DownloadObjects.Groups
Private ReadOnly SEP_1 As ToolStripSeparator
Private WithEvents BTT_MENU As ToolStripMenuItem
Friend Property NameBefore As String = String.Empty
Friend Property Name As String
Private _Key As String = String.Empty
Friend ReadOnly Property Key As String
Get
@@ -52,16 +48,16 @@ Namespace DownloadObjects.Groups
}
BTT_DELETE = New ToolStripMenuItem With {
.Image = PersonalUtilities.My.Resources.DeletePic_02_Red_24,
.BackColor = ColorBttDeleteBack,
.ForeColor = ColorBttDeleteFore,
.BackColor = MyColor.DeleteBack,
.ForeColor = MyColor.DeleteFore,
.Text = "Delete",
.ToolTipText = String.Empty,
.AutoToolTip = False
}
BTT_EDIT = New ToolStripMenuItem With {
.Image = PersonalUtilities.My.Resources.PencilPic_01_48,
.BackColor = ColorBttEditBack,
.ForeColor = ColorBttEditFore,
.BackColor = MyColor.EditBack,
.ForeColor = MyColor.EditFore,
.Text = "Edit",
.ToolTipText = String.Empty,
.AutoToolTip = False
@@ -91,7 +87,7 @@ Namespace DownloadObjects.Groups
If Not e.Value.IsEmptyString Then Labels.ListAddList(e.Value.Split("|"), LAP.NotContainsOnly)
End Sub
Public Overrides Function ToString() As String
Return $"{IIf(Index >= 0 And Index <= 8, $"#{Index + 1}: ", String.Empty)}{Name}"
Return $"{IIf(Index.ValueBetween(0, 8), $"#{Index + 1}: ", String.Empty)}{Name}"
End Function
Private _ControlSent As Boolean = False
Friend Function GetControl() As ToolStripMenuItem

View File

@@ -44,10 +44,7 @@ Namespace DownloadObjects.Groups
End Property
Friend Sub Update()
If Count > 0 Then
Using x As New XmlFile With {.Name = "Groups", .AllowSameNames = True}
x.AddRange(GroupsList)
x.Save(GroupFile)
End Using
Using x As New XmlFile With {.Name = "Groups", .AllowSameNames = True} : x.AddRange(GroupsList) : x.Save(GroupFile) : End Using
Else
GroupFile.Delete()
End If

View File

@@ -18,6 +18,7 @@ Namespace DownloadObjects.Groups
Private ReadOnly CH_READY_FOR_DOWN As CheckBox
Private ReadOnly CH_READY_FOR_DOWN_IGNORE As CheckBox
Private WithEvents TXT_LABELS As TextBoxExtended
Friend WithEvents TXT_NAME As TextBoxExtended
Private ReadOnly Labels As List(Of String)
Public Sub New()
Labels = New List(Of String)
@@ -30,6 +31,15 @@ Namespace DownloadObjects.Groups
.Dock = DockStyle.Fill
.EndInit()
End With
TXT_NAME = New TextBoxExtended
With TXT_NAME
.BeginInit()
.Buttons.Add(ADB.Clear)
.CaptionText = "Name"
.CaptionWidth = 50
.Dock = DockStyle.Fill
.EndInit()
End With
CH_TEMPORARY = New CheckBox With {.Text = "Temporary", .Name = "CH_TEMPORARY", .ThreeState = True, .CheckState = CheckState.Indeterminate, .Dock = DockStyle.Fill}
CH_FAV = New CheckBox With {.Text = "Favorite", .Name = "CH_FAV", .ThreeState = True, .CheckState = CheckState.Indeterminate, .Dock = DockStyle.Fill}
CH_READY_FOR_DOWN = New CheckBox With {.Text = "Ready for download", .Name = "CH_READY_FOR_DOWN", .Checked = True, .Dock = DockStyle.Fill}
@@ -77,18 +87,20 @@ Namespace DownloadObjects.Groups
CellBorderStyle = TableLayoutPanelCellBorderStyle.Single
ColumnCount = 1
ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100))
RowCount = 5
RowCount = 6
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
RowStyles.Add(New RowStyle(SizeType.Percent, 100))
End If
Controls.Add(TP_1, 0, 1)
Controls.Add(TP_2, 0, 2)
Controls.Add(TXT_LABELS, 0, 3)
Controls.Add(TXT_NAME, 0, 1)
Controls.Add(TP_1, 0, 2)
Controls.Add(TP_2, 0, 3)
Controls.Add(TXT_LABELS, 0, 4)
End Sub
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_LABELS.ActionOnButtonClick
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_LABELS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ADB.Edit
Using f As New LabelsForm(Labels)
@@ -105,6 +117,7 @@ Namespace DownloadObjects.Groups
Friend Sub [Get](ByRef Instance As IGroup)
If Not Instance Is Nothing Then
With Instance
.Name = TXT_NAME.Text
.Temporary = CH_TEMPORARY.CheckState
.Favorite = CH_FAV.CheckState
.ReadyForDownload = CH_READY_FOR_DOWN.Checked
@@ -117,6 +130,7 @@ Namespace DownloadObjects.Groups
Friend Sub [Set](ByVal Instance As IGroup)
If Not Instance Is Nothing Then
With Instance
TXT_NAME.Text = .Name
CH_TEMPORARY.CheckState = .Temporary
CH_FAV.CheckState = .Favorite
CH_READY_FOR_DOWN.Checked = .ReadyForDownload

View File

@@ -23,15 +23,10 @@ Namespace DownloadObjects.Groups
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(GroupEditorForm))
Me.DEFS_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
Me.TXT_NAME = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
Me.DEFS_GROUP.SuspendLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
@@ -40,7 +35,7 @@ Namespace DownloadObjects.Groups
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEFS_GROUP)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 134)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 109)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -55,35 +50,19 @@ Namespace DownloadObjects.Groups
Me.DEFS_GROUP.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.DEFS_GROUP.ColumnCount = 1
Me.DEFS_GROUP.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_GROUP.Controls.Add(Me.TXT_NAME, 0, 0)
Me.DEFS_GROUP.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEFS_GROUP.Location = New System.Drawing.Point(0, 0)
Me.DEFS_GROUP.Name = "DEFS_GROUP"
Me.DEFS_GROUP.RowCount = 5
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_GROUP.RowCount = 6
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_GROUP.Size = New System.Drawing.Size(476, 134)
Me.DEFS_GROUP.Size = New System.Drawing.Size(476, 109)
Me.DEFS_GROUP.TabIndex = 1
'
'TXT_NAME
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Index = 0
ActionButton1.Name = "BTT_CLEAR"
Me.TXT_NAME.Buttons.Add(ActionButton1)
Me.TXT_NAME.CaptionText = "Name"
Me.TXT_NAME.CaptionToolTipEnabled = True
Me.TXT_NAME.CaptionToolTipText = "Group name"
Me.TXT_NAME.CaptionWidth = 50.0R
Me.TXT_NAME.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_NAME.Location = New System.Drawing.Point(4, 4)
Me.TXT_NAME.Name = "TXT_NAME"
Me.TXT_NAME.Size = New System.Drawing.Size(468, 22)
Me.TXT_NAME.TabIndex = 0
'
'GroupEditorForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -104,12 +83,9 @@ Namespace DownloadObjects.Groups
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
Me.DEFS_GROUP.ResumeLayout(False)
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents TXT_NAME As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents DEFS_GROUP As GroupDefaults
End Class
End Namespace

View File

@@ -120,13 +120,4 @@
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
</root>

View File

@@ -7,32 +7,35 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Namespace DownloadObjects.Groups
Friend Class GroupEditorForm : Implements IOkCancelToolbar
Private ReadOnly MyDefs As DefaultFormProps
Friend Class GroupEditorForm
Private WithEvents MyDefs As DefaultFormOptions
Friend Property MyGroup As DownloadGroup
Friend Sub New(ByRef g As DownloadGroup)
InitializeComponent()
MyGroup = g
MyDefs = New DefaultFormProps
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Class NameChecker : Implements IFieldsCheckerProvider
Friend Class NameChecker : Implements IFieldsCheckerProvider
Private Property ErrorMessage As String Implements IFieldsCheckerProvider.ErrorMessage
Private Property Name As String Implements IFieldsCheckerProvider.Name
Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError
Private ReadOnly ExistingGroupName As String
Friend Sub New(ByVal _ExistingGroupName As String)
Private ReadOnly Property Source As IEnumerable(Of IGroup)
Private ReadOnly ParamName As String
Friend Sub New(ByVal _ExistingGroupName As String, ByRef _Source As IEnumerable(Of IGroup), ByVal Param As String)
ExistingGroupName = _ExistingGroupName
Source = _Source
ParamName = Param
End Sub
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If Not ACheck(Value) Then
ErrorMessage = "Group name cannot be empty"
ErrorMessage = $"{ParamName} name cannot be empty"
ElseIf Not ExistingGroupName.IsEmptyString AndAlso CStr(Value) = ExistingGroupName Then
Return Value
ElseIf Settings.Groups.Count > 0 AndAlso Settings.Groups.LongCount(Function(g) g.Name = CStr(Value)) > 0 Then
ErrorMessage = "A group with the same name already exists"
ElseIf Source.Count > 0 AndAlso Source.LongCount(Function(g) g.Name = CStr(Value)) > 0 Then
ErrorMessage = $"A {ParamName.ToLower} with the same name already exists"
Else
Return Value
End If
@@ -44,12 +47,10 @@ Namespace DownloadObjects.Groups
End Class
Private Sub GroupEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(Me, Settings.Design, True)
.MyViewInitialize(True)
.AddOkCancelToolbar()
.DelegateClosingChecker()
If Not MyGroup Is Nothing Then
With MyGroup
TXT_NAME.Text = .Name
DEFS_GROUP.Set(MyGroup)
Text &= $" { .Name}"
End With
@@ -57,25 +58,21 @@ Namespace DownloadObjects.Groups
Text = "New Group"
End If
.MyFieldsChecker = New FieldsChecker
DirectCast(.MyFieldsChecker, FieldsChecker).AddControl(Of String)(TXT_NAME, TXT_NAME.CaptionText,, New NameChecker(If(MyGroup?.Name, String.Empty)))
.MyFieldsCheckerE.AddControl(Of String)(DEFS_GROUP.TXT_NAME, DEFS_GROUP.TXT_NAME.CaptionText,,
New NameChecker(If(MyGroup?.Name, String.Empty), Settings.Groups, "Group"))
.MyFieldsChecker.EndLoaderOperations()
.AppendDetectors()
.EndLoaderOperations()
End With
End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then
If MyGroup Is Nothing Then MyGroup = New DownloadGroup
With MyGroup
.NameBefore = .Name
.Name = TXT_NAME.Text
DEFS_GROUP.Get(MyGroup)
End With
MyDefs.CloseForm()
End If
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
End Class
End Namespace

View File

@@ -8,6 +8,7 @@
' but WITHOUT ANY WARRANTY
Namespace DownloadObjects.Groups
Friend Interface IGroup
Property Name As String
ReadOnly Property Labels As List(Of String)
Property Temporary As CheckState
Property Favorite As CheckState
@@ -15,10 +16,12 @@ Namespace DownloadObjects.Groups
Property ReadyForDownloadIgnore As Boolean
End Interface
Friend Class GroupParameters : Implements IGroup, IDisposable
Protected Const Name_Name As String = "Name"
Protected Const Name_Temporary As String = "Temporary"
Protected Const Name_Favorite As String = "Favorite"
Protected Const Name_ReadyForDownload As String = "RFD"
Protected Const Name_ReadyForDownloadIgnore As String = "RFDI"
Friend Property Name As String Implements IGroup.Name
Friend ReadOnly Property Labels As List(Of String) Implements IGroup.Labels
Friend Property Temporary As CheckState = CheckState.Indeterminate Implements IGroup.Temporary
Friend Property Favorite As CheckState = CheckState.Indeterminate Implements IGroup.Favorite

View File

@@ -0,0 +1,175 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class MissingPostsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_3 As System.Windows.Forms.ToolStripSeparator
Me.LIST_DATA = New System.Windows.Forms.ListView()
Me.CONTEXT_OPERATIONS = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.BTT_DOWN = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_OPEN_POST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_OPEN_USER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FIND_USER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_DELETE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_SHOW_POST_INFO = New System.Windows.Forms.ToolStripMenuItem()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_3 = New System.Windows.Forms.ToolStripSeparator()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
Me.CONTEXT_OPERATIONS.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
CONTAINER_MAIN.BottomToolStripPanelVisible = False
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.LIST_DATA)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(284, 236)
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(284, 261)
CONTAINER_MAIN.TabIndex = 0
'
'LIST_DATA
'
Me.LIST_DATA.Activation = System.Windows.Forms.ItemActivation.OneClick
Me.LIST_DATA.ContextMenuStrip = Me.CONTEXT_OPERATIONS
Me.LIST_DATA.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_DATA.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
Me.LIST_DATA.HideSelection = False
Me.LIST_DATA.Location = New System.Drawing.Point(0, 0)
Me.LIST_DATA.Name = "LIST_DATA"
Me.LIST_DATA.Size = New System.Drawing.Size(284, 236)
Me.LIST_DATA.TabIndex = 0
Me.LIST_DATA.TileSize = New System.Drawing.Size(168, 15)
Me.LIST_DATA.UseCompatibleStateImageBehavior = False
Me.LIST_DATA.View = System.Windows.Forms.View.Tile
'
'CONTEXT_SEP_1
'
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(178, 6)
'
'CONTEXT_SEP_2
'
CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
CONTEXT_SEP_2.Size = New System.Drawing.Size(178, 6)
'
'CONTEXT_SEP_3
'
CONTEXT_SEP_3.Name = "CONTEXT_SEP_3"
CONTEXT_SEP_3.Size = New System.Drawing.Size(178, 6)
'
'CONTEXT_OPERATIONS
'
Me.CONTEXT_OPERATIONS.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DOWN, CONTEXT_SEP_1, Me.BTT_OPEN_POST, Me.BTT_OPEN_USER, Me.BTT_CONTEXT_SHOW_POST_INFO, CONTEXT_SEP_2, Me.BTT_FIND_USER, CONTEXT_SEP_3, Me.BTT_DELETE})
Me.CONTEXT_OPERATIONS.Name = "CONTEXT_OPERATIONS"
Me.CONTEXT_OPERATIONS.Size = New System.Drawing.Size(181, 176)
'
'BTT_DOWN
'
Me.BTT_DOWN.AutoToolTip = True
Me.BTT_DOWN.Image = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_DOWN.Name = "BTT_DOWN"
Me.BTT_DOWN.Size = New System.Drawing.Size(181, 22)
Me.BTT_DOWN.Text = "Download"
Me.BTT_DOWN.ToolTipText = "Try downloading the selected posts again"
'
'BTT_OPEN_POST
'
Me.BTT_OPEN_POST.Image = Global.SCrawler.My.Resources.Resources.GlobeBlue_32
Me.BTT_OPEN_POST.Name = "BTT_OPEN_POST"
Me.BTT_OPEN_POST.Size = New System.Drawing.Size(181, 22)
Me.BTT_OPEN_POST.Text = "Open post"
'
'BTT_OPEN_USER
'
Me.BTT_OPEN_USER.Image = Global.SCrawler.My.Resources.Resources.Folder_32
Me.BTT_OPEN_USER.Name = "BTT_OPEN_USER"
Me.BTT_OPEN_USER.Size = New System.Drawing.Size(181, 22)
Me.BTT_OPEN_USER.Text = "Open user folder"
'
'BTT_FIND_USER
'
Me.BTT_FIND_USER.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_FIND_USER.Name = "BTT_FIND_USER"
Me.BTT_FIND_USER.Size = New System.Drawing.Size(181, 22)
Me.BTT_FIND_USER.Text = "Find user"
'
'BTT_DELETE
'
Me.BTT_DELETE.AutoToolTip = True
Me.BTT_DELETE.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_DELETE.Name = "BTT_DELETE"
Me.BTT_DELETE.Size = New System.Drawing.Size(181, 22)
Me.BTT_DELETE.Text = "Delete post"
Me.BTT_DELETE.ToolTipText = "Remove selected posts from user data"
'
'BTT_CONTEXT_SHOW_POST_INFO
'
Me.BTT_CONTEXT_SHOW_POST_INFO.AutoToolTip = True
Me.BTT_CONTEXT_SHOW_POST_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_CONTEXT_SHOW_POST_INFO.Name = "BTT_CONTEXT_SHOW_POST_INFO"
Me.BTT_CONTEXT_SHOW_POST_INFO.Size = New System.Drawing.Size(180, 22)
Me.BTT_CONTEXT_SHOW_POST_INFO.Text = "Show post info"
Me.BTT_CONTEXT_SHOW_POST_INFO.ToolTipText = "Show information about the missing post"
'
'MissingPostsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(284, 261)
Me.Controls.Add(CONTAINER_MAIN)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(300, 300)
Me.Name = "MissingPostsForm"
Me.ShowIcon = False
Me.Text = "Missing posts"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
Me.CONTEXT_OPERATIONS.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_DATA As ListView
Private WithEvents CONTEXT_OPERATIONS As ContextMenuStrip
Private WithEvents BTT_DOWN As ToolStripMenuItem
Private WithEvents BTT_OPEN_POST As ToolStripMenuItem
Private WithEvents BTT_OPEN_USER As ToolStripMenuItem
Private WithEvents BTT_FIND_USER As ToolStripMenuItem
Private WithEvents BTT_DELETE As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_SHOW_POST_INFO As ToolStripMenuItem
End Class
End Namespace

View File

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

View File

@@ -0,0 +1,296 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.Base
Namespace DownloadObjects
Friend Class MissingPostsForm
#Region "Declarations"
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly MUsers As List(Of IUserData)
Private WithEvents BTT_DOWN_ALL As ToolStripButton
Private WithEvents BTT_INFO As ToolStripButton
#End Region
#Region "Initializer"
Friend Sub New()
InitializeComponent()
MUsers = New List(Of IUserData)
MyDefs = New DefaultFormOptions(Me, Settings.Design)
BTT_DOWN_ALL = New ToolStripButton With {
.Text = "Download ALL",
.ToolTipText = String.Empty,
.AutoToolTip = False,
.Image = My.Resources.StartPic_01_Green_16,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_INFO = New ToolStripButton With {
.Text = "Info",
.ToolTipText = "Show information about the missing post (F1)",
.AutoToolTip = True,
.Image = My.Resources.InfoPic_32,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
End Sub
#End Region
#Region "Form handlers"
Private Sub MissingPostsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddEditToolbarPlus({EditToolbar.ControlItem.Separator, BTT_DOWN_ALL, BTT_INFO})
.EndLoaderOperations(False)
End With
RefillList()
End Sub
Private Sub MissingPostsForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub MissingPostsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
MUsers.Clear()
End Sub
Private Sub MissingPostsForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.F1 Then ShowPostInformation() : e.Handled = True
End Sub
#End Region
#Region "RefillList"
Private Overloads Sub RefillList() Handles MyDefs.ButtonUpdateClick
RefillList(True)
End Sub
Friend Overloads Sub RefillList(ByVal User As IUserData)
If MUsers.Count = 0 OrElse Not MUsers.Contains(User) Then MUsers.Add(User) : RefillList(False)
End Sub
Friend Overloads Sub RefillList(ByVal Reload As Boolean)
Try
If Reload Then MUsers.Clear()
LIST_DATA.Items.Clear()
LIST_DATA.Groups.Clear()
If Reload And Settings.Users.Count > 0 Then
MUsers.ListAddList(Settings.Users.SelectMany(Function(ByVal user As IUserData) As IEnumerable(Of IUserData)
DirectCast(user, UserDataBase).LoadContentInformation()
If user.IsCollection Then
With DirectCast(user, API.UserDataBind)
If .Count > 0 Then Return .Where(Function(u) DirectCast(u, UserDataBase).ContentMissingExists)
End With
ElseIf DirectCast(user, UserDataBase).ContentMissingExists Then
Return {user}
End If
Return New IUserData() {}
End Function), LAP.IgnoreICopier)
End If
If MUsers.Count > 0 Then
Dim gName$ = String.Empty
Dim g As ListViewGroup = Nothing
Dim i% = -1
Dim cm As List(Of UserMedia)
For Each uu As UserDataBase In MUsers
i += 1
cm = uu.ContentMissing
If cm.Count > 0 Then
gName = String.Empty
If uu.IncludedInCollection Then gName = $"{uu.CollectionName} - "
gName &= $"{uu.User.Name} ({uu.Site})"
ControlInvoke(LIST_DATA, Sub()
LIST_DATA.Groups.Add(New ListViewGroup(gName) With {.Tag = uu.LVIKey})
g = LIST_DATA.Groups(LIST_DATA.Groups.Count - 1)
End Sub)
For i% = 0 To cm.Count - 1 : ControlInvoke(LIST_DATA, Sub() LIST_DATA.Items.Add(New ListViewItem(cm(i).Post.ID, g))) : Next
End If
Next
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadObjects.MissingPostsForm.RefillList]")
End Try
End Sub
#End Region
#Region "Post actions"
Private Sub BTT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_DOWN.Click
'Try
' If LIST_DATA.SelectedItems.Count > 0 Then
' Dim users As List(Of IUserData) = LIST_DATA.SelectedItems.ToObjectsList.ListCast(Of ListViewItem)().
' Select(Function(d) Settings.GetUser(CStr(d.Group.Tag))).ListWithRemove(Function(d) d Is Nothing)
' If users.ListExists Then
' If MsgBoxE({"The following users will be added to the download queue:" & vbCr & vbCr &
' users.Select(Function(u) u.ToString).ListToString(vbNewLine), "Download users"},,,, {"Process", "Cancel"}) = 0 Then
' users.ForEach(Sub(u) u.DownloadMissingOnly = True)
' Downloader.AddRange(users)
' users.Clear()
' End If
' End If
' Else
' MsgBoxE("No selected posts")
' End If
'Catch ex As Exception
' ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadObjects.MissingPostsForm.Download]")
'End Try
End Sub
Private Sub BTT_OPEN_POST_Click(sender As Object, e As EventArgs) Handles BTT_OPEN_POST.Click
Try
If LIST_DATA.SelectedItems.Count > 0 Then
If LIST_DATA.SelectedItems.Count = 1 OrElse
MsgBoxE({$"Are you sure you want to open {LIST_DATA.SelectedItems.Count} posts?", "Open multiple posts"}, vbExclamation + vbYesNo) = vbYes Then
Dim data As List(Of ListViewItem) = LIST_DATA.SelectedItems.ToObjectsList.ListCast(Of ListViewItem)
If data.ListExists Then
Dim uKey$, url$
Dim u As IUserData = Nothing
Dim i%
Dim cm As List(Of UserMedia)
For Each _d In data
uKey = _d.Group.Tag
If u Is Nothing OrElse Not u.Key = uKey Then u = Settings.GetUser(uKey)
If Not u Is Nothing Then
i = -1
With DirectCast(u, UserDataBase)
cm = .ContentMissing
If cm.Count > 0 Then i = cm.FindIndex(Function(c) c.Post.ID = _d.Text)
If i >= 0 Then
url = UserDataBase.GetPostUrl(u, cm(i))
If Not url.IsEmptyString Then
Try : Process.Start(url) : Catch : End Try
End If
End If
End With
End If
Next
End If
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadObjects.MissingPostsForm.OpenPost]")
End Try
End Sub
Private Sub BTT_OPEN_USER_Click(sender As Object, e As EventArgs) Handles BTT_OPEN_USER.Click
Try
If LIST_DATA.SelectedItems.Count > 0 Then
Dim users As List(Of IUserData) = LIST_DATA.SelectedItems.ToObjectsList.ListCast(Of ListViewItem)().
Select(Function(d) Settings.GetUser(CStr(d.Group.Tag))).ListWithRemove(Function(d) d Is Nothing)
If users.ListExists Then users.ForEach(Sub(u) u.OpenFolder())
Else
MsgBoxE("No selected posts")
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[DownloadObjects.MissingPostsForm.OpenUser]")
End Try
End Sub
Private Sub ShowPostInformation() Handles BTT_INFO.Click, BTT_CONTEXT_SHOW_POST_INFO.Click, LIST_DATA.DoubleClick
Try
If LIST_DATA.SelectedItems.Count > 0 Then
Dim data As ListViewItem = LIST_DATA.SelectedItems.ToObjectsList.ListCast(Of ListViewItem)().First
Dim uKey$, url$
Dim u As IUserData = Nothing
Dim i%
Dim cm As List(Of UserMedia)
Dim m As UserMedia
uKey = data.Group.Tag
If Not uKey.IsEmptyString Then u = Settings.GetUser(uKey)
If Not u Is Nothing Then
i = -1
With DirectCast(u, UserDataBase)
cm = .ContentMissing
If cm.Count > 0 Then i = cm.FindIndex(Function(c) c.Post.ID = data.Text)
If i >= 0 Then
m = cm(i)
url = UserDataBase.GetPostUrl(u, m)
Dim msg As New MMessage("", "Post information") With {.Editable = True}
Dim b As New List(Of MsgBoxButton)
If Not url.IsEmptyString Then b.Add(New MsgBoxButton("Open") With {.IsDialogResultButton = False,
.ToolTip = "Open post in browser",
.KeyCode = Keys.F1,
.CallBack = Sub(result, message, button)
Try : Process.Start(url) : Catch : End Try
End Sub})
b.Add(New MsgBoxButton("OK"))
With msg
.Buttons = b
.DefaultButton = If(b.Count = 2, 1, 0)
.CancelButton = .DefaultButton
.Text = $"Type: {m.Type}"
.Text.StringAppendLine($"Address: {url}")
If m.Post.Date.HasValue Then .Text.StringAppendLine($"Date: {m.Post.Date.Value.ToStringDate(ADateTime.Formats.BaseDateTime)}")
.Text &= vbNewLine.StringDup(2)
If u.IncludedInCollection Then .Text.StringAppendLine($"User collection: {u.CollectionName}")
.Text.StringAppendLine($"User site: {u.Site}")
.Text.StringAppendLine($"User name: {IIf(Not u.FriendlyName.IsEmptyString And Not u.IncludedInCollection, u.FriendlyName, u.Name)}")
End With
MsgBoxE(msg)
b.Clear()
cm.Clear()
End If
End With
End If
Else
MsgBoxE("No selected posts")
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadObjects.MissingPostsForm.ShowPostInformation]")
End Try
End Sub
Private Sub BTT_FIND_USER_Click(sender As Object, e As EventArgs) Handles BTT_FIND_USER.Click
Try
If LIST_DATA.SelectedItems.Count > 0 Then
Dim user As IUserData = LIST_DATA.SelectedItems.ToObjectsList.ListCast(Of ListViewItem)().
Select(Function(d) Settings.GetUser(CStr(d.Group.Tag))).ListWithRemove(Function(d) d Is Nothing).DefaultIfEmpty(Nothing).First
If Not user Is Nothing Then MainFrameObj.FocusUser(user.Key, True)
Else
MsgBoxE("No selected posts")
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[DownloadObjects.MissingPostsForm.FindUser]")
End Try
End Sub
Private Sub DeletePost() Handles MyDefs.ButtonDeleteClickE, BTT_DELETE.Click
Const MsgTitle$ = "Remove missing posts"
Dim UsersToUpdate As New List(Of UserDataBase)
Try
Dim data As List(Of ListViewItem) = LIST_DATA.SelectedItems.ToObjectsList.ListCast(Of ListViewItem)
If data.ListExists Then
Dim lp As New ListAddParams(LAP.NotContainsOnly)
Dim usersCount% = ListAddList(Nothing, data.Select(Function(d) d.Group.Name), LAP.NotContainsOnly).ListIfNothing.Count
If MsgBoxE({"Are you sure you want to delete the selected missing posts?" & vbCr &
$"Number of affected users: {usersCount}." & vbCr &
$"Number of posts to be deleted: {data.Count}.", MsgTitle}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Dim uKey$
Dim u As UserDataBase = Nothing
Dim cm As List(Of UserMedia)
Dim i%
For Each _d In data
uKey = _d.Group.Tag
If u Is Nothing OrElse Not u.LVIKey = uKey Then u = Settings.GetUser(uKey)
If Not u Is Nothing Then
i = -1
cm = u.ContentMissing
If cm.Count > 0 Then i = cm.FindIndex(Function(c) c.Post.ID = _d.Text)
If i >= 0 Then u.RemoveMedia(cm(i), UserMedia.States.Missing) : UsersToUpdate.ListAddValue(u, lp)
End If
Next
MsgBoxE({"The selected posts have been successfully deleted", MsgTitle})
Else
MsgBoxE({"Operation canceled", MsgTitle})
End If
Else
MsgBoxE({"No selected posts", MsgTitle})
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadObjects.MissingPostsForm.DeletePost]")
Finally
UpdateUsers(UsersToUpdate)
UsersToUpdate.Clear()
End Try
End Sub
Private Sub UpdateUsers(ByVal UserList As List(Of UserDataBase))
Try
If UserList.ListExists Then UserList.ForEach(Sub(u) u.UpdateContentInformation())
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadObjects.MissingPostsForm.UpdateUsers]")
End Try
End Sub
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,141 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools
Imports SCrawler.DownloadObjects.Groups
Imports System.Threading
Namespace DownloadObjects
Friend Class Scheduler : Implements IEnumerable(Of AutoDownloader), IMyEnumerator(Of AutoDownloader), IDisposable
Friend Const Name_Plan As String = "Plan"
Private ReadOnly Plans As List(Of AutoDownloader)
Private ReadOnly File As SFile = $"Settings\AutoDownload.xml"
Private ReadOnly PlanWorking As Predicate(Of AutoDownloader) = Function(Plan) Plan.Working
Private ReadOnly PlanDownloading As Predicate(Of AutoDownloader) = Function(Plan) Plan.Downloading
Private ReadOnly PlansWaiter As Action(Of Predicate(Of AutoDownloader)) = Sub(ByVal Predicate As Predicate(Of AutoDownloader))
While Plans.Exists(Predicate) : Thread.Sleep(200) : End While
End Sub
Friend Sub New()
Plans = New List(Of AutoDownloader)
If File.Exists Then
Using x As New XmlFile(File,, False) With {.AllowSameNames = True}
x.LoadData()
If x.Contains(Name_Plan) Then
For Each e In x : Plans.Add(New AutoDownloader(e)) : Next
Else
Plans.Add(New AutoDownloader(x))
End If
End Using
End If
If Plans.Count > 0 Then Plans.ForEach(Sub(p) p.Source = Me)
End Sub
Default Friend ReadOnly Property Item(ByVal Index As Integer) As AutoDownloader Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorObject
Get
Return Plans(Index)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorCount
Get
Return Plans.Count
End Get
End Property
Friend Function NotificationClicked(ByVal Key As String) As Boolean
Return Count > 0 AndAlso Plans.Exists(Function(p) p.NotificationClicked(Key))
End Function
Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me
Plans.Add(Plan)
Update()
End Sub
Friend Async Function RemoveAt(ByVal Index As Integer) As Task
If Index.ValueBetween(0, Count - 1) Then
With Plans(Index)
.Stop()
If .Working Then
Await Task.Run(Sub()
While .Working : Thread.Sleep(510) : End While
End Sub)
End If
.Dispose()
End With
Plans.RemoveAt(Index)
Update()
End If
End Function
Private _UpdateRequired As Boolean = False
Friend Sub Update()
_UpdateRequired = True
Try
If Plans.Count > 0 Then
Using x As New XmlFile With {.Name = "Scheduler", .AllowSameNames = True} : x.AddRange(Plans) : x.Save(File) : End Using
Else
File.Delete()
End If
_UpdateRequired = False
Catch
End Try
End Sub
#Region "Groups Support"
Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup)
If Count > 0 Then Plans.ForEach(Sub(p) p.GROUPS_Updated(Sender))
End Sub
Friend Sub GROUPS_Deleted(ByVal Sender As DownloadGroup)
If Count > 0 Then Plans.ForEach(Sub(p) p.GROUPS_Deleted(Sender))
End Sub
#End Region
#Region "Execution"
Friend Async Sub Start(ByVal Init As Boolean)
If Count > 0 Then
If Plans.Exists(PlanDownloading) Then Await Task.Run(Sub() PlansWaiter(PlanDownloading))
For Each Plan In Plans : Plan.Start(Init) : Thread.Sleep(200) : Next
End If
End Sub
Friend Sub [Stop]()
If Count > 0 Then Plans.ForEach(Sub(p) p.Stop())
End Sub
Friend Property Pause As Boolean
Get
If Count > 0 Then Return Plans(0).Pause Else Return False
End Get
Set(ByVal p As Boolean)
If Count > 0 Then Plans.ForEach(Sub(pp) pp.Pause = p)
End Set
End Property
#End Region
#Region "IEnumerable Support"
Private Function GetEnumerator() As IEnumerator(Of AutoDownloader) Implements IEnumerable(Of AutoDownloader).GetEnumerator
Return New MyEnumerator(Of AutoDownloader)(Me)
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
[Stop]()
If Plans.Exists(PlanWorking) Then Task.WaitAll(Task.Run(Sub() PlansWaiter(PlanWorking)))
If _UpdateRequired Then Update()
Plans.ListClearDispose
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,76 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SchedulerEditorForm : 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_PLANS = 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.BottomToolStripPanelVisible = False
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.LIST_PLANS)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(414, 316)
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(414, 341)
CONTAINER_MAIN.TabIndex = 0
'
'LIST_PLANS
'
Me.LIST_PLANS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_PLANS.FormattingEnabled = True
Me.LIST_PLANS.Location = New System.Drawing.Point(0, 0)
Me.LIST_PLANS.Name = "LIST_PLANS"
Me.LIST_PLANS.Size = New System.Drawing.Size(414, 316)
Me.LIST_PLANS.TabIndex = 0
'
'SchedulerEditorForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(414, 341)
Me.Controls.Add(CONTAINER_MAIN)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(430, 380)
Me.Name = "SchedulerEditorForm"
Me.ShowIcon = False
Me.Text = "Scheduler"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_PLANS As ListBox
End Class
End Namespace

View File

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

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