geonu/SCrawler
1
0
Fork 0
mirror of https://github.com/AAndyProgram/SCrawler.git synced 2026-03-14 15:52:18 +00:00
Code Issues Packages Projects Releases Wiki Activity

2023.5.12.0

Browse Source 
IPluginContentProvider: add 'ProgressPreChanged' and 'ProgressPreMaximumChanged' events
YT.MediaItem: change folder opening on double click
YT.VideoListForm: change the icon for the 'Download' button

Add advanced progress
Add user metrics calculation
UserDataBase: fix GIF hash bug
Instagram: heic to jpg
Mastodon.SiteSettings: add the main domain to the list of domains with saving the settings
Mastodon.UserData: handle 'Forbidden' error; fix bug in parsing non-user posts
Pinterest: remove cookies requirement for saved posts
PornHub: fix resolutions issue; add 'DownloadUHD' option
Reddit: fix missing images bug; fix broken images bug; update container parsing function
MainFrame: fix collection pointing bug
This commit is contained in:
Andy
2023-05-12 20:00:32 +03:00
parent b2a9b22478
commit e868c2e694
55 changed files with 1980 additions and 402 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
Changelog.md
View File

@@ -1,3 +1,21 @@
# 2023.5.12.0
*2023-05-12*
- Added
- Advanced progress (make progress bars more informative)
- User metrics calculation
- Reddit: improve parsing function
- PornHub: add `Download UHD` option
- Fixed
- MD5 GIF hash bug
- Mastodon: handle 'Forbidden' error
- Mastodon: bug in parsing non-user posts
- Pinterest: remove cookies requirement for saved posts
- PornHub: resolutions issue
- Reddit: missing & broken images bug
- Main window: collection pointing bug
# 2023.4.28.0 # 2023.4.28.0
*2023-04-28* *2023-04-28*

BIN
ProgramScreenshots/SeparateVideoDownloader.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 6.9 KiB

BIN
ProgramScreenshots/SettingsSitePornHub.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 16 KiB

BIN
ProgramScreenshots/UserMetrics.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 14 KiB

29
README.md
View File

@@ -19,7 +19,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
![Main window](ProgramScreenshots/MainWindow.png) ![Main window](ProgramScreenshots/MainWindow.png)
![Channels window](ProgramScreenshots/Channels.png) ![Channels window](ProgramScreenshots/Channels.png)
[**YouTube standalone application:**](https://github.com/AAndyProgram/SCrawler/wiki/YouTube%20downloader) [**YouTube standalone application:**](https://github.com/AAndyProgram/SCrawler/wiki/YouTube-downloader)
![YouTube application](ProgramScreenshots/AppYouTube.png) ![YouTube application](ProgramScreenshots/AppYouTube.png)
@@ -38,7 +38,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- PornHub images, videos, save (liked) posts; - PornHub images, videos, save (liked) posts;
- XHamster images, videos, saved posts; - XHamster images, videos, saved posts;
- XVIDEOS videos, saved posts; - XVIDEOS videos, saved posts;
- ThiVid images, videos, saved posts; - ThisVid images, videos, saved posts;
- [Other](#supported-sites) supported sites - [Other](#supported-sites) supported sites
- Parse [channel and view data](https://github.com/AAndyProgram/SCrawler/wiki/Channels) - Parse [channel and view data](https://github.com/AAndyProgram/SCrawler/wiki/Channels)
- Download [saved Reddit, Twitter and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts) - Download [saved Reddit, Twitter and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
@@ -158,11 +158,34 @@ The program has an intuitive interface.
Just add a user profile and **click the ```Download``` button**. Just add a user profile and **click the ```Download``` button**.
Read more about adding users and subreddits [here](https://github.com/AAndyProgram/SCrawler/wiki#Add%20user) ```mermaid
stateDiagram
Start: Add site credentials
What: What would I like to do
DownUser: Download user
DownVideo: Download video
AUser: Add user (1)
OVIF: Open standalone downloader (2)
AVideo: Add video url
F5: Press 'F5' or click the download button
[*]-->Start
Start-->What
What-->DownUser
What-->DownVideo
DownUser-->AUser
DownVideo-->OVIF
OVIF-->AVideo
AVideo-->F5
AUser-->F5
F5-->[*]
```
1. Press `Insert` or click the `Download` button ([read more here](https://github.com/AAndyProgram/SCrawler/wiki#users-list), [hot keys](https://github.com/AAndyProgram/SCrawler/wiki#hot-keys))
2. Click the `Download` button, then `Standalone downloader` ([read more here](https://github.com/AAndyProgram/SCrawler/wiki#download-separate-video))
![Add user](ProgramScreenshots/CreateUserClear.png) ![Add user](ProgramScreenshots/CreateUserClear.png)
# Contact me # Contact me
Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org
Discord: AndyProgram#3804 Discord: AndyProgram#3804

2
SCrawler.PluginProvider/Interfaces/IPluginContentProvider.vb
View File

@@ -10,6 +10,8 @@ Namespace Plugin
Public Interface IPluginContentProvider : Inherits IDisposable Public Interface IPluginContentProvider : Inherits IDisposable
Event ProgressChanged(ByVal Value As Integer) Event ProgressChanged(ByVal Value As Integer)
Event ProgressMaximumChanged(ByVal Value As Integer, ByVal Add As Boolean) Event ProgressMaximumChanged(ByVal Value As Integer, ByVal Add As Boolean)
Event ProgressPreChanged As ProgressChangedEventHandler
Event ProgressPreMaximumChanged As ProgressMaximumChangedEventHandler
Property Thrower As IThrower Property Thrower As IThrower
Property LogProvider As ILogProvider Property LogProvider As ILogProvider
Property Settings As ISiteSettings Property Settings As ISiteSettings

4
SCrawler.PluginProvider/My Project/AssemblyInfo.vb
View File

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

BIN
SCrawler.YouTube/Content/Pictures/StartPic_Green_16.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 373 B

2
SCrawler.YouTube/Downloader/MediaItem.vb
View File

@@ -367,7 +367,7 @@ Namespace DownloadObjects.STDownloader
If FileOption = SFO.File And MyContainer.File.Exists(SFO.File, False) Then If FileOption = SFO.File And MyContainer.File.Exists(SFO.File, False) Then
MyContainer.File.Open(SFO.File,, EDP.ShowMainMsg) MyContainer.File.Open(SFO.File,, EDP.ShowMainMsg)
ElseIf MyContainer.File.Exists(SFO.Path, False) Then ElseIf MyContainer.File.Exists(SFO.Path, False) Then
MyContainer.File.Open(SFO.Path,, EDP.ShowMainMsg) GlobalOpenPath(MyContainer.File, EDP.ShowMainMsg)
Else Else
m.Show() m.Show()
End If End If

3
SCrawler.YouTube/Downloader/VideoListForm.Designer.vb generated
View File

@@ -182,7 +182,7 @@ Namespace DownloadObjects.STDownloader
' '
'BTT_DOWN 'BTT_DOWN
' '
Me.BTT_DOWN.Image = CType(resources.GetObject("BTT_DOWN.Image"), System.Drawing.Image) Me.BTT_DOWN.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN.ImageTransparentColor = System.Drawing.Color.Magenta Me.BTT_DOWN.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DOWN.Name = "BTT_DOWN" Me.BTT_DOWN.Name = "BTT_DOWN"
Me.BTT_DOWN.Size = New System.Drawing.Size(81, 22) Me.BTT_DOWN.Size = New System.Drawing.Size(81, 22)
@@ -192,6 +192,7 @@ Namespace DownloadObjects.STDownloader
'BTT_STOP 'BTT_STOP
' '
Me.BTT_STOP.AutoToolTip = False Me.BTT_STOP.AutoToolTip = False
Me.BTT_STOP.Enabled = False
Me.BTT_STOP.Image = CType(resources.GetObject("BTT_STOP.Image"), System.Drawing.Image) Me.BTT_STOP.Image = CType(resources.GetObject("BTT_STOP.Image"), System.Drawing.Image)
Me.BTT_STOP.ImageTransparentColor = System.Drawing.Color.Magenta Me.BTT_STOP.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_STOP.Name = "BTT_STOP" Me.BTT_STOP.Name = "BTT_STOP"

371
SCrawler.YouTube/Downloader/VideoListForm.resx
View File

@@ -136,109 +136,25 @@
<data name="BTT_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN7SURBVEhLrZVJTFNRFIafQhgkQA1OZYriSI0UtUI0vIKg YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN5SURBVEhLrZVJTFNRFIafljBIgBqcymAU54oWGSRCK1oU
UEGNBRSUIQ4MihElUAgOqeKwcGM07owLYoxxYzSuHBZIjAoKrfpaoBZLJyiaYNxf83vus0QWBAy+k/xp KqixAoIyiMqgGBAChYCaOsed0bgzLogxxo3RuHJYqDEqKFD1tUItKZ2gaIJxf8nvuc8SWRAw8E7yp03u
k3vzf+ee99/3hNkq7GZIZ/itEEwnvhbcNvfiRmlWDcu1iNj5UYRBItlE7HflyZDgtrkXN9n4ScMWdAuI zf+de95/3xNmquCbis6QWwpMJb4W2Db74kaJFjXT9+mw+7MOBpFk1aHImS1BAttmX9xE80XNFrwREPle
eSsg7r2AhL5Q1PoKlQPoJA2LfSdg8ft5WG4JR7oUg9ZAiXKATALwzlOs4dhkj0XO4FJc+V6pHECU0liK QPRHAbE9Qaj25skHSBbVLOqDgMUf52FFXwiSxEi0+gvkA6QRgHeeYAlBsi0KO/qX4srPMvkAmWIiS7CE
NQJb7CoUOOJp/qtwc6JOOcBRScd0NhUKHQk4NLIWde503P3ZqBygWcpihi+JqHKnosGzCc3ebbj/0/Rv Is2mRK49hua/GjfHauQDHBeTWapViTx7LI4MrUONKwl3fzfIB2gWM5jhexzKXRtQ505GsycD93+b/g8w
gJlyPqkjluxfle51OOXRoW1UxKVAPjp/tGDRg8gZpX4U1Sl3mDeZccp30aCIYkcuql0FOOXdi3b/flwN Xc4ndLQna7zMtR717lS0Detw0Z+Dzl8tWPQgbFqpHoV3Sh1mT2Sc8p3fr8NBux4VzlzUe/aj3VeEq/4K
VNN/Hc769egIFODyuAGdEy24N2GSQXcmGnHjew06xivQ6i+lERahwV0G9eMoyABuHvOGMt4jINESBi3F +p+KDt92XPLn4vKoAZ1jLbg3ZpJAd8YacONnFS6NlqLVV0gjzEedqxiqx+GQANw88h1lvEtAXF8wNBRD
kCfFOJyCI+71OO3NxLnR7WRgwLXxQhlwaSyfzETUedJxYHg18oaWQWuLQVJ/GFTkU2Yz/gXwzrk5X9Ta nhTjYAKOuTbijCcdZ4d3koEB10bzJMDFkRwy06HGnYRDg2uQPbAMGmsk4nuDoSSfYqvxH4B3zs35osYa
ommzGiVB8zO+TJz35+JywECAfFwYy4XJn0XPYjMOj2iwz7kC2YNLsEGKRrwlFKpeAZF0KUs+TgEU2UUk QZtVKAiYN3rTcc6nx2W/gQA5OD+ih8mnpWeRgsohNQ44ViKrfwk2iRGI6QuCsltAGF3Kgs+TAPk2HZaT
k3k6dZDnUMsxrPVo0eTLwNnRHJwn03Z/Nky+LJzxbkE9rVW5NdjjXA49nVQ27w8Fv4zcfN5zAcbeKYCD eRJ1kG1XSTGsdmvQ5N2KjuEdOEem7b4smLxaNHrSUEtr5S419jlWYDudVDLvDQK/jNx83nMBxu5JgMP2
jh3Yao+jGCaiwrUOjfQwWygpbWTITZt922Q10ajqaSQ8TbudycgaWILUz1FQfwhBNI04okuA8Iz0mACv Xdhmi6YYxqHUuR4N9DBbKCltZMhNm70ZkppoVLU0Ep6mvY7l0H5bgg1fw6H6pEAEjTj0lQDhGekxAd5O
pwBOSBnMNKBnZmcVMw8fY+av9czsqqPf4+yi/SS7/e0EmWeg1q1F+cgaFDqT0OatRtmHHb9qpGxWKYms ApwSU5nJqmVmezkzfz/BzI5aZh6sod+TzCyeZrd/nCLzrah2aVAytBZ5jni0eSpQ1K0frxJ1rEzMZCUk
nKQniZ9IfaQekckAHtPpIjYpvun6QBur9aSh3LUau+iUmXTaBk+5vDajeExnK76xw97EDtBzKRhKwGa6 LSnzC6mH1JXJJACP6VQRmxDfdN3axqrdm1HiXIM9dMp0Om2du0Ram1Y8pjMV33hBbGKH6LnkDsQihW70
0SutkTjsKpZNgtvmXtzELDWw/KF4+UXH36ZxlJRDjuCM/7f+AGrYRlssEikpCynO/NtQOpnz/y1u0ihV KksYKp0HJZPAttkXNzGLdSxnIEZ60fG3aTQl5Yg9MOO51l9AFdtijUIcJWUhxZl/Gwoncj7X4iYNYimL
sKT+cKgohgteCQh5QSmxKgg4KukZN4+gzufzGD4lwDsFARUUv0jqXKALJDwhPSRAt4KA0s9GeSTGHhJd 7w2BkmK44LUAxQtKiUVGwHFRy7h5KHU+n8fwKQE+yAgopfiFUecCXSDhCekhAd7ICCj8apRGYuwi0QUy
IGMX6aVSAMoyN5pWs+ZcEH4DgcGuQfDpaFIAAAAASUVORK5CYII= viK9lAtAWeZGU2rGnAvCHy5drfKWDYjrAAAAAElFTkSuQmCC
</value> </value>
</data> </data>
<data name="BTT_ADD_PLS_ARR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_ADD_PLS_ARR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN6SURBVEhLrZVbSJNhGMe/UjyiLixrnig7J7WVphXOLa25
tKKlluYBy1MZWaJLNGNkh6sgiu6iC4mIbsLoqsNFRZRa6bRva1vW3MlmgeH9G/+e92OSF6Jh3wN/Nnhf
/r/nfb7/+33CfBV2M6Qn/FYIZhNfC25beHEjtSWd5Q1psHdYA4NIsmpQ6sqXIMFtCy9ukjGSzqJeC4h9
JyD+vYCkj6Go9xXKB8gS01lcn4Bl7xdh5VA41GIszgeK5QPsJADvPM0Sjm22OOjsy3HlZ6V8AK2oZmmW
CGy3KVDgTKT5r8HNyQb5ACfELJZpVaDQmYRjY+vR4Fbj7lSzfIBWMZcZviSjyr0RTZ5taPXuwv0p078B
5sr5tGqHdb8r3RtwxpOJ9nENLgX06PnVhqUPIueU8lF0j9Rh/nTGKd9Fdg0OO/NQ7SrAGe9BdPhLcTVQ
Tf8z0enPRXegAJcnDOiZbMO9SZMEujPZjBs/69A9UYHz/hIaYRGa3Eeh7I2GBODmsW8p4/0CkofCoKIY
8qQYv6bhuDsdZ73ZuDC+mwwMuDZRKAEufdeTmQYNHjWOfF2LfMcKqKyxSBkMg4J8jlqNfwG8c27OF1XW
GNqsRHHQ/JwvG13+PFwOGAigx8XveTD5c+hZZKBmbBMOja6C1p6AzWIMEodCoRgQEEmXsnh4BqDIpkEq
maupg3ynUophvUeFFl8WOsd16CLTDr8WJl8Oznm3o5HWqtybcGB0JXLppJL5YCj4ZeTmi54JMA7MAJQ7
92CnLZ5imIwK1wY008Nso6S0kyE3bfXtktRCo2qkkfA07R9NRc7nBGz8FA3lhxDE0IgjXgoQnpJ6CfBm
BuCUbQczOXTM/K2KmV21zDzWyMzuBvo9ybrtp9ntH6fIPAv1bhXKxtahcDQF7d5qlA/qf9eJu1mlqGVl
JB1JO0L6SOrXMgnAYzpbxKbFN113tLN6zxaUudZiH50ym07b5CmT1uYUj+l8xTdesbewI/RcChxJyKAb
vdoSiRrXYckkuG3hxU3M1iamdyRKLzr+No2npBxzBmf8vyUBxDq21RqHZErKEooz/zaUTOf8f4ubNIsV
LGUwHAqKYdQrASHPKSUWGQEnRB3j5hHU+WIewycE6JMRUEHxi6TOBbpAwmPSQwK8lhFQ8skojcTYT6IL
ZHxJeiEXgLLMjWbVvDkXhD8Iya6ZQXWVtAAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_ADD_NO_SHORTS.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAOBSURBVEhLrZVbSJNhGMe/Ujwk6sJO8xBlJy1qljapnKUr
nd8qmlqtPNDBQxmtRJd0IrKSbiKKoIvoQiKimyi66nBREZWabtVmbk12tplheP/Gv+f92MgL0bDvgT8M
3pf/73mf9/9+E6aqmBtRnbE3ozCR+Fp42/SLG22yqlmxRYNtnzTQ2Uh2DXa7tRIkvG36xU0KP6vZrDcC
kt4LSOkRkNYbjfqAKB+gyKZmyR8EzO2ZgUWWWOTYknAqVCEfYCsBeOeZ1lis60/GloH5uDxSLR9AtG1i
mdY4rO9XoNSZSvNfihujDfIBDn0tYnl2BURnGvZ7VqDBm4O7Yyb5AC2uMqb7lo4abzaafOvQ4t+I+2Pm
fwNMlvOITC7972pvFo778tA2pMHFUAk6f7VizoP4SaV8lNApdaiNZJzyrR/QoNxZjFp3KY77d+J0cDeu
hGrpdx7OBAvRHirFpWEdOkdbcW/ULIHujJpwfaQO7cNVOBWspBHq0eTdC+XjBEgAbp70jjLeJSDdEgMV
xZAnxTCYiYPeVTjhz8fZoSIy0KFjWJQAF7+XkJkGDb4c7BlcBq1jAVT2JGT0xUBBPnvthr8A3jk354sq
eyJtVqIibH4ykI9zwWJcCukIUILz34thDhbQXeTigGcldrkWY/PAPKy2JSLVEg1Ft4B4epQVn8YB9P0a
LCTzHOpA61RKMaz3qdAcUOPM0BacI9PTwc0wBwpw0r8ejbRW412JHa5FKKSTSuZ90eCPkZvPeC7A0D0O
sM+5FRv6UyiG6ahyZ8FEl9lKSWkjQ27aEtgoqZlG1Ugj4Wna7lqIgq/zkP0lAcqPUUikEce9EiA8Iz0m
wNtxgKNeLTMH9OzCcA1r/3GYdYw0so6fDezqyBF2zX+M3fpxlMzVqPeqYPQsh+jKQJu/FnUOw+8613ZW
7RCZ0SYyPUn8TOoldYlMAvCYThSxiPim24E2Vu9bA6N7GcrolPl02iafUVqbVDymUxXfeN3fzPbQvZQ6
0pBLL3qJNR4H3OWSSXjb9IubXPY0sRJHqvSh41/TFErKfmd4xv9b3OTCYB1ba09GOiVlNsWZ/zdURnL+
v8VNTM4qltEXCwXFcNZrAVEvKCVWGQGH7HrGzeOo85k8hk8J8EFGQBXFL546F+gBCU9IDwnwRkZA5ReD
NBJDF4kekOEV6aVcAMoyN5pQU+ZcEP4ATUiw5fkSx60AAAAASUVORK5CYII=
</value>
</data>
<data name="BTT_ADD_SHORTS_ONLY.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAOBSURBVEhLrZVbSJNhGMe/Ujwk6sJO8xBlJy1qljapnKUr
nd8qmlqtPNDBQxmtRJd0IrKSbiKKoIvoQiKimyi66nBREZWabtVmbk12tplheP/Gv+f92MgL0bDvgT8M
3pf/73mf9/9+E6aqmBtRnbE3ozCR+Fp42/SLG22yqlmxRYNtnzTQ2Uh2DXa7tRIkvG36xU0KP6vZrDcC
kt4LSOkRkNYbjfqAKB+gyKZmyR8EzO2ZgUWWWOTYknAqVCEfYCsBeOeZ1lis60/GloH5uDxSLR9AtG1i
mdY4rO9XoNSZSvNfihujDfIBDn0tYnl2BURnGvZ7VqDBm4O7Yyb5AC2uMqb7lo4abzaafOvQ4t+I+2Pm
fwNMlvOITC7972pvFo778tA2pMHFUAk6f7VizoP4SaV8lNApdaiNZJzyrR/QoNxZjFp3KY77d+J0cDeu
hGrpdx7OBAvRHirFpWEdOkdbcW/ULIHujJpwfaQO7cNVOBWspBHq0eTdC+XjBEgAbp70jjLeJSDdEgMV
xZAnxTCYiYPeVTjhz8fZoSIy0KFjWJQAF7+XkJkGDb4c7BlcBq1jAVT2JGT0xUBBPnvthr8A3jk354sq
eyJtVqIibH4ykI9zwWJcCukIUILz34thDhbQXeTigGcldrkWY/PAPKy2JSLVEg1Ft4B4epQVn8YB9P0a
LCTzHOpA61RKMaz3qdAcUOPM0BacI9PTwc0wBwpw0r8ejbRW412JHa5FKKSTSuZ90eCPkZvPeC7A0D0O
sM+5FRv6UyiG6ahyZ8FEl9lKSWkjQ27aEtgoqZlG1Ugj4Wna7lqIgq/zkP0lAcqPUUikEce9EiA8Iz0m
wNtxgKNeLTMH9OzCcA1r/3GYdYw0so6fDezqyBF2zX+M3fpxlMzVqPeqYPQsh+jKQJu/FnUOw+8613ZW
7RCZ0SYyPUn8TOoldYlMAvCYThSxiPim24E2Vu9bA6N7GcrolPl02iafUVqbVDymUxXfeN3fzPbQvZQ6
0pBLL3qJNR4H3OWSSXjb9IubXPY0sRJHqvSh41/TFErKfmd4xv9b3OTCYB1ba09GOiVlNsWZ/zdURnL+
v8VNTM4qltEXCwXFcNZrAVEvKCVWGQGH7HrGzeOo85k8hk8J8EFGQBXFL546F+gBCU9IDwnwRkZA5ReD
NBJDF4kekOEV6aVcAMoyN5pQU+ZcEP4ATUiw5fkSx60AAAAASUVORK5CYII=
</value>
</data>
<data name="MENU_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN/SURBVEhLrZVbSJNhGMc/Uzwk6sJO80RZdqRm5ZTElc3S
bVa01LQ8YOWhDE3RKZ0INesmiiK6iS4kIroJo6sOFxZRWalTtzXnYu5kU8Ho/o1/z/s1yQvR0O+BPwze
h//vfZ/3/34T5qvgO4GdIXcDMZv4mr9t4cWN0o1Kpu5X4cCAChoTyaxCgSNLhPjbFl7cRDWoZEvfCYj8
KCD6i4DY3iBUenTSATJNShb1ScCKLwFY0x+CZFMkmn150gGyCMB3nmgMwU5LFDKtq3BtskQ6gNaUzhKN
oVBaZMixxdD81+POVJV0gFOWTJZilkFni8WJ0Y2ocibj4a866QCNIxqmGYlDqXMzalw70ehOx+Nfhv8D
zJXzadWO6H6XODeh1pWCljEVWn3Z6PzZhOVPwuaU/Fl4599LnM445TvXqsJRmxpljhzUug/jgrcAHb4y
+p2Ci949aPPloH1cg86pJjyaMoigB1N1uD1ZgbbxYjR782mEuahxFkLeFQ4RwM0jP1DGewTE9QdDQTHk
SdF/T8RJ51acd6fh0tg+MtDg+rhOBLT+yCYzFapcyTj2PQlZw6uhMEcivi8YMvIpNOv/AfjOuTlfVJgj
qFmOPL95vScNl71qtPs0BMjGlR9qGLwZdBe7UD66BUfsa7HXuhLbTBGI6Q+C7LOAMHqUeQMzALkWFRLI
PJl2kGWTizGsdCnQ4EnFxbFMXCbTC969MHgyUO9WoprWSp1bcMi+BnvopKJ5XxD4Y+TmAa8E6D/PABy3
7cduSzTFMA7Fjk2oo8tsoqS0kCE3bfSki2qgUVXTSHiaDtoTkPFtJTYPhUP+NRARNOLQbgHCS1IXAd7P
AJwdVTODW8eu+kpZ6/hp1jFRzTomq9iNiTPspuscuzdxlsxTUelUoGh0A3T2eLS4y3DaeuR3xUguK7Fq
WZFJy3Qk7SCpl9SjZSKAx3S2iE2LN913t7BK13YUOZKgpVOm0WlrXEXi2pziMZ2veOMtVwM7RveSMxyL
XfSi1xnDUO44Kpr42xZe3KTdUcOyh2PEDx3/mkZTUk7Y/DNebHGTq/YKtsMchThKyjKKM/9vyJ/O+WKL
m9QNF7P4vhDIKIZL3woIfE0pMUoIOGXSMW4eSjtfwmP4ggCfJAQUU/zCaOcCPSDhOekpAd5JCMgf0osj
0feQ6AHpu0lvpAJQlrnRrJo354LwB0sEsKr2elKBAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_DOWN.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN7SURBVEhLrZVJTFNRFIafQhgkQA1OZYriSI0UtUI0vIKg YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN7SURBVEhLrZVJTFNRFIafQhgkQA1OZYriSI0UtUI0vIKg
@@ -257,122 +173,185 @@
0SutkTjsKpZNgtvmXtzELDWw/KF4+UXH36ZxlJRDjuCM/7f+AGrYRlssEikpCynO/NtQOpnz/y1u0ihV 0SutkTjsKpZNgtvmXtzELDWw/KF4+UXH36ZxlJRDjuCM/7f+AGrYRlssEikpCynO/NtQOpnz/y1u0ihV
sKT+cKgohgteCQh5QSmxKgg4KukZN4+gzufzGD4lwDsFARUUv0jqXKALJDwhPSRAt4KA0s9GeSTGHhJd sKT+cKgohgteCQh5QSmxKgg4KukZN4+gzufzGD4lwDsFARUUv0jqXKALJDwhPSRAt4KA0s9GeSTGHhJd
IGMX6aVSAMoyN5pWs+ZcEH4DgcGuQfDpaFIAAAAASUVORK5CYII= IGMX6aVSAMoyN5pWs+ZcEH4DgcGuQfDpaFIAAAAASUVORK5CYII=
</value>
</data>
<data name="BTT_ADD_NO_SHORTS.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAOBSURBVEhLrZVZSFRRGMdvKS6JOmHbuETZpkaN1ZQYTtZY
zp2xbVLLcqHMpaws0UnaqMx6iYiinqIHiYheouip5aEkKjV1qhmXmzXeWXSmwOj9xL/vXEbyQTTsfvCH
gXP4/77znf+5I0xWYTdCWsJvhmA88bXgtqkXN8q065mx24AtHw0QHSSnAYWuHAUS3Db14iZZn/RsRquA
mHcC4joEJHSGotJrUQ+Q7dCz2PcCZndMw4LucKQ7YnDSn68ewEgA3nmyPRyre2KxsW8umn+UqAcQHZks
2R6BtT0amKR4mv9i3BipUg9Q7sxmeqcGFikB+waXoUpOx91fteoB6iUTE78kolRORY17Neo963H/l+3f
ABPlfFRHJfPvEjkFx9x6NA4ZcNGfi5afDZj1IHJCaR9FtSgd5oxmnPKd12fALsmIMpcJxzzbccpXiMv+
Mvqtx2nfBjT5TbgUENEy0oB7IzYFdGekFtd/VKApUIyTvgIaYR5q5D3QPo6CAuDmMW8p420CErvDoKMY
8qRYvybjgLwcxz0ZODO0iQxEXAlYFMDF4VwyM6DKnY7dX5cgp38edM4YJHWFQUM+e5zWvwDeOTfnizpn
NG3WIj9ofsKbgbM+Iy75RQLk4tywETZfFt3FGuwfTMPOgYXI7puDFY5oxHeHQtMuIJIeZf7HMYC8HgPm
k3k6dZAjaZUYVrp1qPOuw+mhjThLpqd82bB5s3DCsxbVtFYqp2HbwAJsoJMq5l2h4I+Rm097LsDaPgaw
V9qMzJ44imEiil0pqKXLbKCkNJIhN633rldUR6OqppHwNG0dmI+s3jlI/RwF7YcQRNOII14JEJ6RHhPg
zRjAYdcmZnOb2fnhUnbBf5A1B6pZ8/cqdiVwiF2Vj7Bb3w+T+TpUyjoUDS6FZSAJjZ4ylPfu+F0hWVhJ
r8iKHCIzk8RPpE5Sm8gUAI/peBEbFd90293IKt0rUeRaAjOdMoNOW+MuUtYmFI/pZMU3XpPr2G66F1N/
AtbQi15kj8R+1y7FJLht6sVNmr7VsNz+eOVDx7+mcZSUfVJwxv9b3OT8lwq2yhmLRErKTIoz/28oGM35
/xY3qe0rZkld4dBQDGe8FhDyglJiVxFQ7jAzbh5BnU/nMXxKgPcqAoopfpHUuUAPSHhCekiAVhUBBZ+t
ykisbSR6QNZXpJdqASjL3GhcTZpzQfgDSh6wcB+AKZwAAAAASUVORK5CYII=
</value>
</data>
<data name="BTT_ADD_SHORTS_ONLY.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAOBSURBVEhLrZVZSFRRGMdvKS6JOmHbuETZpkaN1ZQYTtZY
zp2xbVLLcqHMpaws0UnaqMx6iYiinqIHiYheouip5aEkKjV1qhmXmzXeWXSmwOj9xL/vXEbyQTTsfvCH
gXP4/77znf+5I0xWYTdCWsJvhmA88bXgtqkXN8q065mx24AtHw0QHSSnAYWuHAUS3Db14iZZn/RsRquA
mHcC4joEJHSGotJrUQ+Q7dCz2PcCZndMw4LucKQ7YnDSn68ewEgA3nmyPRyre2KxsW8umn+UqAcQHZks
2R6BtT0amKR4mv9i3BipUg9Q7sxmeqcGFikB+waXoUpOx91fteoB6iUTE78kolRORY17Neo963H/l+3f
ABPlfFRHJfPvEjkFx9x6NA4ZcNGfi5afDZj1IHJCaR9FtSgd5oxmnPKd12fALsmIMpcJxzzbccpXiMv+
Mvqtx2nfBjT5TbgUENEy0oB7IzYFdGekFtd/VKApUIyTvgIaYR5q5D3QPo6CAuDmMW8p420CErvDoKMY
8qRYvybjgLwcxz0ZODO0iQxEXAlYFMDF4VwyM6DKnY7dX5cgp38edM4YJHWFQUM+e5zWvwDeOTfnizpn
NG3WIj9ofsKbgbM+Iy75RQLk4tywETZfFt3FGuwfTMPOgYXI7puDFY5oxHeHQtMuIJIeZf7HMYC8HgPm
k3k6dZAjaZUYVrp1qPOuw+mhjThLpqd82bB5s3DCsxbVtFYqp2HbwAJsoJMq5l2h4I+Rm097LsDaPgaw
V9qMzJ44imEiil0pqKXLbKCkNJIhN633rldUR6OqppHwNG0dmI+s3jlI/RwF7YcQRNOII14JEJ6RHhPg
zRjAYdcmZnOb2fnhUnbBf5A1B6pZ8/cqdiVwiF2Vj7Bb3w+T+TpUyjoUDS6FZSAJjZ4ylPfu+F0hWVhJ
r8iKHCIzk8RPpE5Sm8gUAI/peBEbFd90293IKt0rUeRaAjOdMoNOW+MuUtYmFI/pZMU3XpPr2G66F1N/
AtbQi15kj8R+1y7FJLht6sVNmr7VsNz+eOVDx7+mcZSUfVJwxv9b3OT8lwq2yhmLRErKTIoz/28oGM35
/xY3qe0rZkld4dBQDGe8FhDyglJiVxFQ7jAzbh5BnU/nMXxKgPcqAoopfpHUuUAPSHhCekiAVhUBBZ+t
ykisbSR6QNZXpJdqASjL3GhcTZpzQfgDSh6wcB+AKZwAAAAASUVORK5CYII=
</value>
</data>
<data name="MENU_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAOASURBVEhLrZVZSFRRGMdvKS6JOmHbuGG2FzXWaLY4Zlpz
b1rRpJblQotLKVmik7QhZvUQQRS+RQ8SEb2E0VPLQ0VUtuhkM5MzaTN3NscCo/cT/75zGckH0bD7wR8G
zuH/+853/ueOMFVF3AjrirwZhonE10Lbpl/caINFz/L7DNj+yQDJSrIZUOoqUCChbdMvbrK5X89mvRQQ
90ZAwnsBSR/DUeMrVA+Qa9Wz+LcC5r6fgbS+SGRY43A6WKweYCsBeOfplkiss8cjb2A+Lv2oUA8gWjew
dEsUsuwaiM5Emv9i3BitVQ9wxJrLMm0aFDqTcNC9DLVyBm7/alQP0OwwMulrMirlFaj3rEOzdxPu/jL/
G2CynI+pwSH9rpCX44QnE60BA9qDRnT9bMGce9GTSvsgpkvpsGAs45TvogED9jrzUeUSccK7G2f8pbgc
rKLfmTjrz8XFoIiOEQldoy24M2pWQLdGG3H9RzUujpTjtL+ERliEenk/tN0xUADcPO41ZbxHQHJfBHQU
Q54U01A6DsurcNKbjXOBrWQg4cpIoQJoHzaSmQG1ngzsG1qCAscC6GxxSOmNgIZ89ttMfwG8c27OF3W2
WNqsRXHI/JQvG+f9+egISgQw4sJwPsz+HLoLPQ65V2LP4EJsGZiH1dZYJPaFQ/NOQDQ9yuJP4wBFdgNS
yTyDOihwapUY1nh0aPKtx9lAHs6T6Rn/Fph9OTjlzUIdrVXKK7FrMA25dFLFvDcc/DFy8xlPBJjejQMc
cG7DRnsCxTAZ5a7laKTLbKGktJIhN232bVLURKOqo5HwNO0cTEXOl3lY8TkG2g9hiKURRz0XIDwmdRPg
1TjA8W95zCxLrC1QydqGj7KOYB3rGKlll4PH2FV3A+v8fpzM16NG1qHMvRSFgylo9VbhsH3372rHDlZh
F1mZVWQSSewnfST1iEwB8JhOFLEx8U2dciur8axBmWsJdtAps+m09Z4yZW1S8ZhOVXzjNXcT20f3IjqS
oKcXvcgSjUOuvYpJaNv0i5u0D9UzoyNR+dDxr2kCJeWgMzTj/y1u0uasZmtt8UimpMymOPP/hpKxnP9v
cZPGL+UspTcSGorhrBcCwp5SSiwqAo5YJcbNo6jzmTyGjwjwVkVAOcUvmjoX6AEJD0n3CfBSRUDJZ5My
ElMPiR6Q6TnpmVoAyjI3mlBT5lwQ/gBJOLA2lU2mdgAAAABJRU5ErkJggg==
</value> </value>
</data> </data>
<data name="BTT_STOP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_STOP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVrTJNXGMcLQmdHO6AdarLSOcQBAgX61tK6 YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVESURBVEhLjZVtTFNXGMcLQmdHO6AdarLCHOIAgRZ6a2nd
qTAuUrRgC4KOETWj4gqKF5QoRmM00SgmS/Zh+7B92DKTGbdEl2VjwiibCmTKAKdbuQ5rKb0XXnZJFujZ FBwvUrRgSwUdI2pGxRUUX1CiGI3RRKOYLNmH7cP2YctMZtwSXZaNCaNmTiBDBm7iKkWHtZS+Fy57SRbo
/5RWZywbT/JL+57znP/z73NOz8uh0V9QEGVMSPiwc8WK4RsSyQebxeKXMBzhn/yfGFIolL9JJDdHli/v 2f+UVmcsG0/yy+095zn/59/nnHsvh8ZQSUmcKTX1w+vLllmupaR8sFEsfgnDMcHJ/4kRhUL5W0rKjdGl
u5aYWI6hKBDmn6Rx32Dg3yko+HyoqYmMX7pE7jU2+m4olR3ZAsFqTEfOZ4UOE8O8bt2x4yF74QKZaWkh SwevpKXpMRQHooKTNO4Yjfz+kpLPR1pbydiFC2SopSVwTanszhcIVmI6di4rcpgZ5nX7tm0P2XPnyHR7
wxUV7veSk+sk0dGxmJ4v0rFq1fuDhw6RsdOnyfipU8SCZPPRo6RVqbwpFQheRUrIIiMq1RsQN7MXLxIW O7FUV3vfy8hoTImPT8T0XJHuFSvev3fgAHlw8iQZO3GC2JBsPXyYdCiVNyQCwatIiVhkVKV6A+JW9vx5
a9nmZjJz8iQZ1Gg8X4rF7yJFCCI4nSKRhYqPNTaSh8ePEwuSJs+dI6amJt8NheJWukCQhMSniqAthdbK wmIt29ZGpo8fJ/c0Gt+XYvG7SBGCGM51kchGxR+0tJCHR48SG5Imzpwhd1tbA9cUih9yBIJ0JD5VBG0p
Sgt1TsVnIM4eOUJmYMxbXU2McXEPkKYEAk57fPzl4ZoaMo4CZmA5doxYscB+9iwZQrvalcruND4/Gcn+ tdfU2KhzKj4NcfbQITINY/66OmJKShpGmhIIOF3JyRct9fVkDAWswHbkCLFjgfP0aWJGu7qUyt5sPj8D
IkMyWeFkRYVl+vx5wsLMDEyxWDdz8CCZ2ruXtCoUzp0i0VWkFgMhR7dy5cutcvnNgd27fY+QNAEm4caO ycEiIzJZ6UR1tW3q7FnCwsw0TLFYN71/P5ncvZt0KBTu7SLRZaSWAyFHt3z5yx1y+Y3BnTsDj5A0Dibg
PXGhZY7Dh0knimTx+Sk/MUzBRHm5dfrMGX9LWDhm0V62oYFMQ9yYleVO4vE+gbAeSAHdcE4kIxIlo0i3 xok98aBlroMHyXUUyePzM39imJJxvd4+depUsCUsHLNoL9vcTKYgbsrL86bzeJ9A2AAkgG44J5YRiTJQ
eedOYt23j9jq64n9wAHiRDEPhEbr6309KtXAaGmphT1xwu+YxRyLXLau7rF4Co93GXo1IDUgHg78wc0S pNe6fTux79lDHE1NxLlvH3GjmA9ClqamQJ9Kdft+ZaWNPXYs6JjFHItctrHxsXgmj3cRevUgKyQeDYLB
ClO+lcm6fq2q8tlqa4kDuAwG4oaAF8W8+/eTabidpsJ4ZvHsF0d7u+Ryj5TPp+LU+RqwFDw5qoHgKoTC zRMKM7+VyXqGa2sDjoYG4gIeo5F4IeBHMf/evWQKbqeoMO5Z3AfF0d4eudwn4fOpOHW+CiwGT45qKLgK
Ne0ZGd3WbduIY9cu4gIevZ544XAKBaewgVOlpcSbm0u8KhVxg67sbG+mQHAF6/cA6pwHnhEPBndtbGxq oXBVl1Taa9+yhbh27CAe4DMYiB8OJ1FwEhs4WVlJ/OvXE79KRbygJz/fnysQXML6XYA654FnxMPBXZ2Y
u1TaPZibO+vevp241GriYhjiFIuJUyAgzshI4lyyhIzy+b62hASPMiaGbmgtSAPPgwXFg+Fv1x2ptH8S mNUlkfT+WlAw4926lXjUauJhGOIWi4lbICDu2FjiXrSIWPj8QGdqqk+ZkEA3tAFkg+fBvOLhCLarXyIZ
gjaI2YEDUGE/ERGkLyPjr/Lk5K+R/w5IB4sS94e1utpgVanMNh7vWXFAx0yJibNGjWY0JT6+FEuiweLE moCgA2JO4AJUOEhMDBmUSv/SZ2R8jfx3QA5YkHgw7HV1RrtKZXXweM+KAzp2Ny1txqTR3M9MTq7Ekniw
vXr9YWdentMG9wuJT4CHwJyaSvq02gdvrluXiaX/ea34w6XXNzs2bXLZoqKeEXeg97RdVHwcDIeHk/ug MHG/wXDQXVTkdsD9fOLj4CGwZmWRQa12+M01a3Kx9D9fK8HwGAxtrg0bPI64uGfEXeg9bRcVHwOW6Ghy
NzPT119W9ku5UknbtHARz549x+1FRe5Qzh0iEXlUVPT3UFKSj4oPBcVBF+hmmLl++ksWKoKj2GzLy/PY B/Tn5gaGqqru6pVK2qb5i/h27TrqLCvzRnLuEonIo7Kyv83p6QEqPhISHwA94CbDzA7RfzJfERzFNkdR
+Hy/8FNtWbaMmIqLfz+zYUNP75Ytk+aUFPIzRO+C2+AHYAS31q6d+7G8fCBPKqUX5JOr3l1T00TF7aHE kc/B5weFn2rLkiXEXF7++6l16/oGNm2asGZmkl8geosKg++BiV5Xr579Ua+/XSSR0Bfkk1e9t76+lYo7
4+KIaePGP+oYph2p9UVpaW89KCkZNaH3QfEO0AZaQadCMddTVtb7sUZDN54LwjjurVst9piY0M4hXiuT I4knJRFzQcEfjQzThdSmsuzst4YrKu6b0fuweDfoBB3ApFDM9lVVDXys0dCN54IojnfzZpszISGyc4g3
tSHRAOhGCg/k5LzWp9ONDKSnPxb/BnwFroN+mWz2rk43iNyVgMuxabUmt0QS0rmBYb5DUl1APPim4h7M yGSdSDQCupHCfYWFrw3qdKO3c3Iei38DvgJXwVBu7swtne4ecpcDLseh1Zq9KSkRnRsZ5jskNYbEw18q
z1f2lZWNfJ+e7vu3+BdhYeRuVtasUa2eQF4BiOX0VFXtmFSrXS6IBp3fLyz8c19o8WBwG3JysrGxw3cy 7v7iYuVgVdWoKScn8G/xL6KiyC2pdMakVo8jrwQkcvpqa7dNqNUeD0TDzu+Ulv65J7J4OLjNhYX52FhL
Msi1gLgxO3vuM7X6UfHq1R8hZ74AYmlbRcUJS0mJZ0yp9FHnDXJ5B8YXEg8GV79+vYy2A9e5z6hSzV2F v1RKroTETfn5s5+p1Y/KV678CDlzBRCLO6urj9kqKnyjSmWAOm+Wy7sxPp94OLiGtWtltB3dWGdSqWYv
8xd4vBbMacF8ixBhTEJCdK9O9+lYSYnjSn4+Tl94A8YZwKfzNGmB4F6vrHz7nlY7cVujcRYlJdF3gQ6I w/kLPF475rRgrkWIKCY1NX5Ap/v0QUWF61JxMU5fdDPGGcCn8zRpnuBeral5+2etdvymRuMuS0+n3wId
AT2uj9fSLzFADjYHPhf7938O0KNJT84W8AoI+YdbAqhj+rKmn/R5MUFN0Pv/xQC0YMAYh/MP1UTZ10sP EAN6XB+vpT8SgBxsDF0X+vg/B+jRpCdnE3gFRHzgFgHqmH6s6ZXeLySoCfr+fzEELRgyxuH8Aw1h2aqt
VAUAAAAASUVORK5CYII= epieAAAAAElFTkSuQmCC
</value> </value>
</data> </data>
<data name="BTT_DELETE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_DELETE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lls3 YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVBSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC39sVN
FeVFihZsqaBjRM2ouILiC0oUozGaaHxJluzD9mH7sGUmM26JLsuGwqiZE5jKQAcGAR3WUvpeuOwlWaRn xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RZVEmjJoxgUyROnFBQIe1lL4XLntJFunZ
/1NanbFsPMkvt/ec5/yff59z7r08Gn1FRTHmpKRPri1aNHxVJvt4nVT6GoajApP/E0MqFfubTHZ9ZOHC /5RWZywbT/LL7T3nOf/n3+ecey+HhqW4OM6ckvLp9SVLRq5JJJ+sF4tfw3BMcPJ/YlihUP0mkXSPLl48
3kvJyQYMxYCIwCSNfpNJeKuo6Kuh5mYyeu4cudnU5L/Ksh15ItFSTEfPZIWPQYZ527Z58yPu9GkydfYs cCk11YChOBAVnKQxaDLxbxYXfz3c0kLGzp0jfc3NgWsqVZdSIFiO6djZrMgxxDBv27dsecSeOUOm29rI
Ga6s9HyYmlovi42Nx/RMkY4lSz66v3cveXjsGBk9epRYkWw5cIC0sux1uUj0JlLCFhlRq9dA3MKdOUM4 SFWV96P09AZJfHwipmeLdC1b9vH9ffvIw+PHydixY8SGZOvBg6RdpeqWCgRvIiVikVG1+h2IW9mzZwmL
rOVaWsjUkSPkvlbr/UYq/QApYhDFuyaRWKn4w6Ym8ujQIWJF0vjJk6Svudl/VaX6KUskSkHic0XQlmJb tWxrK5k+epTc12p934rFHyJFCGI410UiGxV/2NxMHh0+TGxImjh1itxuaQlcUyh+yhEI0pD4XBG0pcRe
VZWVOqfiUxDn9u8nUzDmq6kh5oSEAaSxQMRrT0w8P1xbS0ZRwAKsBw8SGxY4Tpwgd9GudpbtyhQKU5Ec XW2jzqn4NMTZAwfINIz5a2uJOSnpHtJUQMDpTE4+P1JXR8ZQwApshw4ROxY4T54kFrSrU6Xqzebz05Ec
KDKkUBSPV1ZaJ0+dIhzMTMEUh3VTe/aQiR07SKtK5doikVxEaikQ8/SLF7/eqlRe/3nbNv9jJI2Bcbhx LDIsk5VMVFXZpk6fJizMTMMUi3XTe/eSyZ07SbtC4d4qEl1EahkQcvRLl77eLpd3927fHniMpHEwATdO
YE/caJlz3z5yDUVyhcK0XximaMxgsE0ePx5oCQfHHNrLNTaSSYibc3M9KQLB5xA2AjmgG86LZiSSVBTp 7IkHLXPt30+uo0g+n59xm2GKxw0G+9SJE8GWsHDMor1sUxOZgrg5P9+bxuN9AWEjkAK64ZxYRiRKR5Fe
smzZQmw7dxJ7QwNx7N5NXCjmhdBAQ4O/W62+86C83ModPhxwzGGOQy5XX/9UPE0gOA+9WpARFI8EgeDn 69atxL5rF3E0NhLnnj3EjWI+CN1tbAz0qdV3HlRU2NgjR4KOWcyxyGUbGp6KZ/B456FXB7JC4tEgGNx8
isVpVxSKzt7qar+9ro44gdtkIh4I+FDMt2sXmYTbSSqMew73AXG0t1Op9MqFQipOnaeD+eDZUQ0GXyUW oTDje5msp7+mJuCorycu4DGZiBcCfhTz795NpuB2igrjnsV9UBzt7ZHLfVI+n4pT55lgIXh2VEPBVQiF
p7dnZ3fZNm4kzq1biRt4jUbig8MJFJzABk6UlxPf6tXEp1YTD+jMy/PliEQXsH47oM4F4AXxUPCXxcdn mZ25ub32TZuIa9s24gE+o5H44XASBSexgZMVFcS/di3xq9XEC3qUSn+eQHAB63cA6pwHXhAPB3dFYmJW
tMvlXf1q9RPPpk3ErdEQN8MQl1RKXCIRcUVHE9e8eWRAKPS3JSV52bg4uqF1IBO8DGYVD0WgXbfk8r5x p1TaO6hUPvFu3kw8Gg3xMAxxi8XELRAQd2wscS9YQO7y+YGOlBSfKiGBbmg9yAYvgznFwxFs102p1DIB
CNoh5gBOQIUDREWR3uzsvwypqd8h/32QBeYkHghbTY3JplZb7ALBi+KAjvUnJz8xa7UP0hITy7EkFsxN QQfEnMAFqHCQmBgykJv7lyE9/QryPwA5YF7iwbDX1prsarXVweO9KA7o2GBq6hOzVvsgIzm5AkviwfzE
3Gc07nMVFLjscD+b+Bh4BCwZGaRXpxt4Z/nyHCz9z9dKINxGY4tz7Vq3PSbmBXEnek/bRcVHwXBkJOkH /UbjfndhodsB93OJj4NHwJqVRQZ0unvvrlyZh6X/+VoJhsdobHWtW+dxxMW9IO5C72m7qPgYGImOJoOg
N3Jy/H0VFfcMLEvbNHsR7/bthxwlJZ5wzp0SCXlcUvL33ZQUPxUfCor3gE5gZpjpPvpPZiuCo9hiLyjw Oy8vYKms/NWgUtE2zV3Et2PHYWdpqTeSc5dIRB6Xlv5tSUsLUPHhkHg/6AFmhpmx0H8yVxEcxVZHYaHP
2oXCgPBzbVmwgAyWlv5+fOXK7p7168ctaWnkV4jeBjfAj7QAZdmy6ZsGw50CuZy+IJ+96j21tc1U3BFO wecHhZ9ry6JFZKis7PcTq1f39W/YMGHNyCB3IXoL3AA/0gKUFStmfjYY7hRKpfQF+exV762ra6Hizkji
PCGBDK5a9Uc9w7QjtaEkM/PdgbKyB4PofUi8A7SBVlpEpZrurqjo+UyrpRvPBxE8z4YNVkdcXHjnEK9T SUlkaM2aPxoYphOpjaXZ2e/dKy9/MITeh8W7QAdop0UUipm+ysr+z7VauvFcEMXxbtxocyYkRHYO8XqZ
KNqQaAJ0I8W78/Pf6tXrR+5kZT0V/x58Cy6DvvT0J7f1+vvIXQz4PLtON+iRycI6NzHMD0iqD4qHvlT8 rAOJJkA3UrinoOCtAb1+9E5OzlPxq+A7cBlYMjOf3NLr7yN3KeByHDrdkFciiejcxDA/IKkhJB7+UnH3
PYWFbG9FxciVrCz/v8W/joggt1HArNGMIa8IxPO6q6s3j2s0bjdEQ877i4v/3BlePBT8xvz8PGzs8K3s FhWpBiorR6/m5AT+Lf5NVBS5hQJmjWYcecUgkdNXU7NlQqPxeCAadj5YUvLnrsji4eA2FRQosbEjN3Nz
bHIpKG7Oy5v+UqN5XLp06afImSmAmN9WWXnYWlbmvceyfuq8UanswPhs4qHgG1esUNB24OvnN6vV0xfh yaWQuFmpnPlKo3lctnz5Z8iZLYBY2FFVdcRWXu4bVKkC1HmTXN6F8bnEw8E1rlolo+24gnVmtXrmIpy/
/BWB4CzmdGCmRYgIJikptkev/+JhWZnzQmEhTl9kI8YZIKTzNGmW4F+uqnrvrk43dkOrdZWkpNBvgR5I wuO1YU4HZluEiGJSUuL79fovH5aXuy4UFeH0RTdhnAF8Ok+T5gju5erq93/R6cZvaLXu0rQ0+i3QAzGg
AT2uT9fSH3FACdYFr3N9/F8C9GjSk7MevAHCPnDzAHVMP9b0Su/nEtQEff+/GoQWDBrj8f4B7pXZMs39 x/XpWvojAcjB+tB1vo//S4AeTXpyNoA3QMQHbgGgjunHml7p/XyCmqDv/1dD0IIhYxzOP1xr2RYPr44i
OqoAAAAASUVORK5CYII= AAAAAElFTkSuQmCC
</value> </value>
</data> </data>
<data name="BTT_CLEAR_DONE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_CLEAR_DONE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lls3 YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVBSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC39sVN
FeVFihZsqaBjRM2ouILiC0oUozGaaHxJluzD9mH7sGUmM26JLsuGwqiZE5jKQAcGAR3WUvpeuOwlWaRn xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RZVEmjJoxgUyROnFBQIe1lL4XLntJFunZ
/1NanbFsPMkvt/ec5/yff59z7r08Gn1FRTHmpKRPri1aNHxVJvt4nVT6GoajApP/E0MqFfubTHZ9ZOHC /5RWZywbT/LL7T3nOf/n3+ecey+HhqW4OM6ckvLp9SVLRq5JJJ+sF4tfw3BMcPJ/YlihUP0mkXSPLl48
3kvJyQYMxYCIwCSNfpNJeKuo6Kuh5mYyeu4cudnU5L/Ksh15ItFSTEfPZIWPQYZ527Z58yPu9GkydfYs cCk11YChOBAVnKQxaDLxbxYXfz3c0kLGzp0jfc3NgWsqVZdSIFiO6djZrMgxxDBv27dsecSeOUOm29rI
Ga6s9HyYmlovi42Nx/RMkY4lSz66v3cveXjsGBk9epRYkWw5cIC0sux1uUj0JlLCFhlRq9dA3MKdOUM4 SFWV96P09AZJfHwipmeLdC1b9vH9ffvIw+PHydixY8SGZOvBg6RdpeqWCgRvIiVikVG1+h2IW9mzZwmL
rOVaWsjUkSPkvlbr/UYq/QApYhDFuyaRWKn4w6Ym8ujQIWJF0vjJk6Svudl/VaX6KUskSkHic0XQlmJb tWxrK5k+epTc12p934rFHyJFCGI410UiGxV/2NxMHh0+TGxImjh1itxuaQlcUyh+yhEI0pD4XBG0pcRe
VZWVOqfiUxDn9u8nUzDmq6kh5oSEAaSxQMRrT0w8P1xbS0ZRwAKsBw8SGxY4Tpwgd9GudpbtyhQKU5Ec XW2jzqn4NMTZAwfINIz5a2uJOSnpHtJUQMDpTE4+P1JXR8ZQwApshw4ROxY4T54kFrSrU6Xqzebz05Ec
KDKkUBSPV1ZaJ0+dIhzMTMEUh3VTe/aQiR07SKtK5doikVxEaikQ8/SLF7/eqlRe/3nbNv9jJI2Bcbhx LDIsk5VMVFXZpk6fJizMTMMUi3XTe/eSyZ07SbtC4d4qEl1EahkQcvRLl77eLpd3927fHniMpHEwATdO
YE/caJlz3z5yDUVyhcK0XximaMxgsE0ePx5oCQfHHNrLNTaSSYibc3M9KQLB5xA2AjmgG86LZiSSVBTp 7IkHLXPt30+uo0g+n59xm2GKxw0G+9SJE8GWsHDMor1sUxOZgrg5P9+bxuN9AWEjkAK64ZxYRiRKR5Fe
smzZQmw7dxJ7QwNx7N5NXCjmhdBAQ4O/W62+86C83ModPhxwzGGOQy5XX/9UPE0gOA+9WpARFI8EgeDn 69atxL5rF3E0NhLnnj3EjWI+CN1tbAz0qdV3HlRU2NgjR4KOWcyxyGUbGp6KZ/B456FXB7JC4tEgGNx8
isVpVxSKzt7qar+9ro44gdtkIh4I+FDMt2sXmYTbSSqMew73AXG0t1Op9MqFQipOnaeD+eDZUQ0GXyUW oTDje5msp7+mJuCorycu4DGZiBcCfhTz795NpuB2igrjnsV9UBzt7ZHLfVI+n4pT55lgIXh2VEPBVQiF
p7dnZ3fZNm4kzq1biRt4jUbig8MJFJzABk6UlxPf6tXEp1YTD+jMy/PliEQXsH47oM4F4AXxUPCXxcdn mZ25ub32TZuIa9s24gE+o5H44XASBSexgZMVFcS/di3xq9XEC3qUSn+eQHAB63cA6pwHXhAPB3dFYmJW
tMvlXf1q9RPPpk3ErdEQN8MQl1RKXCIRcUVHE9e8eWRAKPS3JSV52bg4uqF1IBO8DGYVD0WgXbfk8r5x p1TaO6hUPvFu3kw8Gg3xMAxxi8XELRAQd2wscS9YQO7y+YGOlBSfKiGBbmg9yAYvgznFwxFs102p1DIB
CNoh5gBOQIUDREWR3uzsvwypqd8h/32QBeYkHghbTY3JplZb7ALBi+KAjvUnJz8xa7UP0hITy7EkFsxN QQfEnMAFqHCQmBgykJv7lyE9/QryPwA5YF7iwbDX1prsarXVweO9KA7o2GBq6hOzVvsgIzm5AkviwfzE
3Gc07nMVFLjscD+b+Bh4BCwZGaRXpxt4Z/nyHCz9z9dKINxGY4tz7Vq3PSbmBXEnek/bRcVHwXBkJOkH /UbjfndhodsB93OJj4NHwJqVRQZ0unvvrlyZh6X/+VoJhsdobHWtW+dxxMW9IO5C72m7qPgYGImOJoOg
N3Jy/H0VFfcMLEvbNHsR7/bthxwlJZ5wzp0SCXlcUvL33ZQUPxUfCor3gE5gZpjpPvpPZiuCo9hiLyjw Oy8vYKms/NWgUtE2zV3Et2PHYWdpqTeSc5dIRB6Xlv5tSUsLUPHhkHg/6AFmhpmx0H8yVxEcxVZHYaHP
2oXCgPBzbVmwgAyWlv5+fOXK7p7168ctaWnkV4jeBjfAj7QAZdmy6ZsGw50CuZy+IJ+96j21tc1U3BFO wecHhZ9ry6JFZKis7PcTq1f39W/YMGHNyCB3IXoL3AA/0gKUFStmfjYY7hRKpfQF+exV762ra6Hizkji
PCGBDK5a9Uc9w7QjtaEkM/PdgbKyB4PofUi8A7SBVlpEpZrurqjo+UyrpRvPBxE8z4YNVkdcXHjnEK9T SUlkaM2aPxoYphOpjaXZ2e/dKy9/MITeh8W7QAdop0UUipm+ysr+z7VauvFcEMXxbtxocyYkRHYO8XqZ
KNqQaAJ0I8W78/Pf6tXrR+5kZT0V/x58Cy6DvvT0J7f1+vvIXQz4PLtON+iRycI6NzHMD0iqD4qHvlT8 rAOJJkA3UrinoOCtAb1+9E5OzlPxq+A7cBlYMjOf3NLr7yN3KeByHDrdkFciiejcxDA/IKkhJB7+UnH3
PYWFbG9FxciVrCz/v8W/joggt1HArNGMIa8IxPO6q6s3j2s0bjdEQ877i4v/3BlePBT8xvz8PGzs8K3s FhWpBiorR6/m5AT+Lf5NVBS5hQJmjWYcecUgkdNXU7NlQqPxeCAadj5YUvLnrsji4eA2FRQosbEjN3Nz
bHIpKG7Oy5v+UqN5XLp06afImSmAmN9WWXnYWlbmvceyfuq8UanswPhs4qHgG1esUNB24OvnN6vV0xfh yaWQuFmpnPlKo3lctnz5Z8iZLYBY2FFVdcRWXu4bVKkC1HmTXN6F8bnEw8E1rlolo+24gnVmtXrmIpy/
/BWB4CzmdGCmRYgIJikptkev/+JhWZnzQmEhTl9kI8YZIKTzNGmW4F+uqnrvrk43dkOrdZWkpNBvgR5I wuO1YU4HZluEiGJSUuL79fovH5aXuy4UFeH0RTdhnAF8Ok+T5gju5erq93/R6cZvaLXu0rQ0+i3QAzGg
AT2uT9fSH3FACdYFr3N9/F8C9GjSk7MevAHCPnDzAHVMP9b0Su/nEtQEff+/GoQWDBrj8f4B7pXZMs39 x/XpWvojAcjB+tB1vo//S4AeTXpyNoA3QMQHbgGgjunHml7p/XyCmqDv/1dD0IIhYxzOP1xr2RYPr44i
OqoAAAAASUVORK5CYII= AAAAAElFTkSuQmCC
</value> </value>
</data> </data>
<data name="BTT_CLEAR_ALL.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_CLEAR_ALL.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lls3 YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVBSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC39sVN
FeVFihZsqaBjRM2ouILiC0oUozGaaHxJluzD9mH7sGUmM26JLsuGwqiZE5jKQAcGAR3WUvpeuOwlWaRn xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RZVEmjJoxgUyROnFBQIe1lL4XLntJFunZ
/1NanbFsPMkvt/ec5/yff59z7r08Gn1FRTHmpKRPri1aNHxVJvt4nVT6GoajApP/E0MqFfubTHZ9ZOHC /5RWZywbT/LL7T3nOf/n3+ecey+HhqW4OM6ckvLp9SVLRq5JJJ+sF4tfw3BMcPJ/YlihUP0mkXSPLl48
3kvJyQYMxYCIwCSNfpNJeKuo6Kuh5mYyeu4cudnU5L/Ksh15ItFSTEfPZIWPQYZ527Z58yPu9GkydfYs cCk11YChOBAVnKQxaDLxbxYXfz3c0kLGzp0jfc3NgWsqVZdSIFiO6djZrMgxxDBv27dsecSeOUOm29rI
Ga6s9HyYmlovi42Nx/RMkY4lSz66v3cveXjsGBk9epRYkWw5cIC0sux1uUj0JlLCFhlRq9dA3MKdOUM4 SFWV96P09AZJfHwipmeLdC1b9vH9ffvIw+PHydixY8SGZOvBg6RdpeqWCgRvIiVikVG1+h2IW9mzZwmL
rOVaWsjUkSPkvlbr/UYq/QApYhDFuyaRWKn4w6Ym8ujQIWJF0vjJk6Svudl/VaX6KUskSkHic0XQlmJb tWxrK5k+epTc12p934rFHyJFCGI410UiGxV/2NxMHh0+TGxImjh1itxuaQlcUyh+yhEI0pD4XBG0pcRe
VZWVOqfiUxDn9u8nUzDmq6kh5oSEAaSxQMRrT0w8P1xbS0ZRwAKsBw8SGxY4Tpwgd9GudpbtyhQKU5Ec XW2jzqn4NMTZAwfINIz5a2uJOSnpHtJUQMDpTE4+P1JXR8ZQwApshw4ROxY4T54kFrSrU6Xqzebz05Ec
KDKkUBSPV1ZaJ0+dIhzMTMEUh3VTe/aQiR07SKtK5doikVxEaikQ8/SLF7/eqlRe/3nbNv9jJI2Bcbhx LDIsk5VMVFXZpk6fJizMTMMUi3XTe/eSyZ07SbtC4d4qEl1EahkQcvRLl77eLpd3927fHniMpHEwATdO
YE/caJlz3z5yDUVyhcK0XximaMxgsE0ePx5oCQfHHNrLNTaSSYibc3M9KQLB5xA2AjmgG86LZiSSVBTp 7IkHLXPt30+uo0g+n59xm2GKxw0G+9SJE8GWsHDMor1sUxOZgrg5P9+bxuN9AWEjkAK64ZxYRiRKR5Fe
smzZQmw7dxJ7QwNx7N5NXCjmhdBAQ4O/W62+86C83ModPhxwzGGOQy5XX/9UPE0gOA+9WpARFI8EgeDn 69atxL5rF3E0NhLnnj3EjWI+CN1tbAz0qdV3HlRU2NgjR4KOWcyxyGUbGp6KZ/B456FXB7JC4tEgGNx8
isVpVxSKzt7qar+9ro44gdtkIh4I+FDMt2sXmYTbSSqMew73AXG0t1Op9MqFQipOnaeD+eDZUQ0GXyUW oTDje5msp7+mJuCorycu4DGZiBcCfhTz795NpuB2igrjnsV9UBzt7ZHLfVI+n4pT55lgIXh2VEPBVQiF
p7dnZ3fZNm4kzq1biRt4jUbig8MJFJzABk6UlxPf6tXEp1YTD+jMy/PliEQXsH47oM4F4AXxUPCXxcdn mZ25ub32TZuIa9s24gE+o5H44XASBSexgZMVFcS/di3xq9XEC3qUSn+eQHAB63cA6pwHXhAPB3dFYmJW
tMvlXf1q9RPPpk3ErdEQN8MQl1RKXCIRcUVHE9e8eWRAKPS3JSV52bg4uqF1IBO8DGYVD0WgXbfk8r5x p1TaO6hUPvFu3kw8Gg3xMAxxi8XELRAQd2wscS9YQO7y+YGOlBSfKiGBbmg9yAYvgznFwxFs102p1DIB
CNoh5gBOQIUDREWR3uzsvwypqd8h/32QBeYkHghbTY3JplZb7ALBi+KAjvUnJz8xa7UP0hITy7EkFsxN QQfEnMAFqHCQmBgykJv7lyE9/QryPwA5YF7iwbDX1prsarXVweO9KA7o2GBq6hOzVvsgIzm5AkviwfzE
3Gc07nMVFLjscD+b+Bh4BCwZGaRXpxt4Z/nyHCz9z9dKINxGY4tz7Vq3PSbmBXEnek/bRcVHwXBkJOkH /UbjfndhodsB93OJj4NHwJqVRQZ0unvvrlyZh6X/+VoJhsdobHWtW+dxxMW9IO5C72m7qPgYGImOJoOg
N3Jy/H0VFfcMLEvbNHsR7/bthxwlJZ5wzp0SCXlcUvL33ZQUPxUfCor3gE5gZpjpPvpPZiuCo9hiLyjw Oy8vYKms/NWgUtE2zV3Et2PHYWdpqTeSc5dIRB6Xlv5tSUsLUPHhkHg/6AFmhpmx0H8yVxEcxVZHYaHP
2oXCgPBzbVmwgAyWlv5+fOXK7p7168ctaWnkV4jeBjfAj7QAZdmy6ZsGw50CuZy+IJ+96j21tc1U3BFO wecHhZ9ry6JFZKis7PcTq1f39W/YMGHNyCB3IXoL3AA/0gKUFStmfjYY7hRKpfQF+exV762ra6Hizkji
PCGBDK5a9Uc9w7QjtaEkM/PdgbKyB4PofUi8A7SBVlpEpZrurqjo+UyrpRvPBxE8z4YNVkdcXHjnEK9T SUlkaM2aPxoYphOpjaXZ2e/dKy9/MITeh8W7QAdop0UUipm+ysr+z7VauvFcEMXxbtxocyYkRHYO8XqZ
KNqQaAJ0I8W78/Pf6tXrR+5kZT0V/x58Cy6DvvT0J7f1+vvIXQz4PLtON+iRycI6NzHMD0iqD4qHvlT8 rAOJJkA3UrinoOCtAb1+9E5OzlPxq+A7cBlYMjOf3NLr7yN3KeByHDrdkFciiejcxDA/IKkhJB7+UnH3
PYWFbG9FxciVrCz/v8W/joggt1HArNGMIa8IxPO6q6s3j2s0bjdEQ877i4v/3BlePBT8xvz8PGzs8K3s FhWpBiorR6/m5AT+Lf5NVBS5hQJmjWYcecUgkdNXU7NlQqPxeCAadj5YUvLnrsji4eA2FRQosbEjN3Nz
bHIpKG7Oy5v+UqN5XLp06afImSmAmN9WWXnYWlbmvceyfuq8UanswPhs4qHgG1esUNB24OvnN6vV0xfh yaWQuFmpnPlKo3lctnz5Z8iZLYBY2FFVdcRWXu4bVKkC1HmTXN6F8bnEw8E1rlolo+24gnVmtXrmIpy/
/BWB4CzmdGCmRYgIJikptkev/+JhWZnzQmEhTl9kI8YZIKTzNGmW4F+uqnrvrk43dkOrdZWkpNBvgR5I wuO1YU4HZluEiGJSUuL79fovH5aXuy4UFeH0RTdhnAF8Ok+T5gju5erq93/R6cZvaLXu0rQ0+i3QAzGg
AT2uT9fSH3FACdYFr3N9/F8C9GjSk7MevAHCPnDzAHVMP9b0Su/nEtQEff+/GoQWDBrj8f4B7pXZMs39 x/XpWvojAcjB+tB1vo//S4AeTXpyNoA3QMQHbgGgjunHml7p/XyCmqDv/1dD0IIhYxzOP1xr2RYPr44i
OqoAAAAASUVORK5CYII= AAAAAElFTkSuQmCC
</value> </value>
</data> </data>
<data name="BTT_LOG.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_LOG.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">

4
SCrawler.YouTube/My Project/AssemblyInfo.vb
View File

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

10
SCrawler.YouTube/My Project/Resources.Designer.vb generated
View File

@@ -150,6 +150,16 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>
Public ReadOnly Property StartPic_Green_16() As System.Drawing.Bitmap
Get
Dim obj As Object = ResourceManager.GetObject("StartPic_Green_16", resourceCulture)
Return CType(obj,System.Drawing.Bitmap)
End Get
End Property
'''<summary> '''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap. ''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary> '''</summary>

3
SCrawler.YouTube/My Project/Resources.resx
View File

@@ -145,6 +145,9 @@
<data name="SettingsPic_16" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="SettingsPic_16" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\SettingsPic_16.bmp;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value> <value>..\Content\Pictures\SettingsPic_16.bmp;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data> </data>
<data name="StartPic_Green_16" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\StartPic_Green_16.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="VideoCamera_32" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="VideoCamera_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\VideoCamera_32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value> <value>..\Content\Pictures\VideoCamera_32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data> </data>

3
SCrawler.YouTube/SCrawler.YouTube.vbproj
View File

@@ -314,5 +314,8 @@
<ItemGroup> <ItemGroup>
<None Include="Content\Pictures\ImagePic_32.png" /> <None Include="Content\Pictures\ImagePic_32.png" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<None Include="Content\Pictures\StartPic_Green_16.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>

4
SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb
View File

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

79
SCrawler/API/Base/M3U8Base.vb
View File

@@ -33,40 +33,55 @@ Namespace API.Base
End If End If
End Function End Function
Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing, Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing,
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing) As SFile Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing,
Optional ByVal UsePreProgress As Boolean = True) As SFile
Dim Cache As CacheKeeper = Nothing Dim Cache As CacheKeeper = Nothing
Try Using tmpPr As New PreProgress(Progress)
If URLs.ListExists Then Try
Dim ConcatFile As SFile = DestinationFile If URLs.ListExists Then
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile" Dim ConcatFile As SFile = DestinationFile
ConcatFile.Extension = "mp4" If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\") ConcatFile.Extension = "mp4"
Dim cache2 As CacheKeeper = Cache.NewInstance Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\")
If cache2.RootDirectory.Exists(SFO.Path) Then Dim cache2 As CacheKeeper = Cache.NewInstance
Dim progressExists As Boolean = Not Progress Is Nothing If cache2.RootDirectory.Exists(SFO.Path) Then
If progressExists Then Progress.Maximum += URLs.Count Dim progressExists As Boolean = Not Progress Is Nothing
Dim p As SFileNumbers = SFileNumbers.Default(ConcatFile.Name) If progressExists Then
ConcatFile = SFile.IndexReindex(ConcatFile,,, p, EDP.ReturnValue) If UsePreProgress Then
Dim i% tmpPr.ChangeMax(URLs.Count)
Dim dFile As SFile = cache2.RootDirectory Else
dFile.Extension = "ts" Progress.Maximum += URLs.Count
Using w As New DownloadObjects.WebClient2(Responser) End If
For i = 0 To URLs.Count - 1 End If
If progressExists Then Progress.Perform() Dim p As SFileNumbers = SFileNumbers.Default(ConcatFile.Name)
Token.ThrowIfCancellationRequested() ConcatFile = SFile.IndexReindex(ConcatFile,,, p, EDP.ReturnValue)
dFile.Name = $"ConPart_{i}" Dim i%
w.DownloadFile(URLs(i), dFile) Dim dFile As SFile = cache2.RootDirectory
cache2.AddFile(dFile, True) dFile.Extension = "ts"
Next Using w As New DownloadObjects.WebClient2(Responser)
End Using For i = 0 To URLs.Count - 1
DestinationFile = FFMPEG.ConcatenateFiles(cache2, Settings.FfmpegFile.File, ConcatFile, Settings.CMDEncoding, p, EDP.ThrowException) If progressExists Then
Return DestinationFile If UsePreProgress Then
tmpPr.Perform()
Else
Progress.Perform()
End If
End If
Token.ThrowIfCancellationRequested()
dFile.Name = $"ConPart_{i}"
w.DownloadFile(URLs(i), dFile)
cache2.AddFile(dFile, True)
Next
End Using
DestinationFile = FFMPEG.ConcatenateFiles(cache2, Settings.FfmpegFile.File, ConcatFile, Settings.CMDEncoding, p, EDP.ThrowException)
Return DestinationFile
End If
End If End If
End If Return Nothing
Return Nothing Finally
Finally Cache.DisposeIfReady
Cache.DisposeIfReady End Try
End Try End Using
End Function End Function
End Class End Class
End Namespace End Namespace

45
SCrawler/API/Base/UserDataBase.vb
View File

@@ -146,7 +146,18 @@ Namespace API.Base
Return HOST.Name Return HOST.Name
End Get End Get
End Property End Property
Private _Progress As MyProgress
Friend Property Progress As MyProgress Friend Property Progress As MyProgress
Get
Return _Progress
End Get
Set(ByVal p As MyProgress)
_Progress = p
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
ProgressPre = New PreProgress(_Progress)
End Set
End Property
Protected Property ProgressPre As PreProgress = Nothing
#End Region #End Region
#Region "User name, ID, exist, suspend" #Region "User name, ID, exist, suspend"
Friend User As UserInfo Friend User As UserInfo
@@ -566,6 +577,8 @@ BlockNullPicture:
#Region "Plugins Support" #Region "Plugins Support"
Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged
Protected Event ProgressMaximumChanged As IPluginContentProvider.ProgressMaximumChangedEventHandler Implements IPluginContentProvider.ProgressMaximumChanged Protected Event ProgressMaximumChanged As IPluginContentProvider.ProgressMaximumChangedEventHandler Implements IPluginContentProvider.ProgressMaximumChanged
Protected Event ProgressPreChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressPreChanged
Protected Event ProgressPreMaximumChanged As IPluginContentProvider.ProgressMaximumChangedEventHandler Implements IPluginContentProvider.ProgressPreMaximumChanged
Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings
Get Get
Return HOST.Source Return HOST.Source
@@ -911,6 +924,7 @@ BlockNullPicture:
Private _PictureExists As Boolean Private _PictureExists As Boolean
Private _EnvirInvokeUserUpdated As Boolean = False Private _EnvirInvokeUserUpdated As Boolean = False
Protected Sub EnvirDownloadSet() Protected Sub EnvirDownloadSet()
ProgressPre.Reset()
UpdateDataFiles() UpdateDataFiles()
_DownloadInProgress = True _DownloadInProgress = True
_DescriptionChecked = False _DescriptionChecked = False
@@ -962,10 +976,12 @@ BlockNullPicture:
If Not DownloadMissingOnly Then If Not DownloadMissingOnly Then
ThrowAny(Token) ThrowAny(Token)
DownloadDataF(Token) DownloadDataF(Token)
ProgressPre.Done()
ThrowAny(Token) ThrowAny(Token)
If Settings.ReparseMissingInTheRoutine Then ReparseMissing(Token) : ThrowAny(Token) If Settings.ReparseMissingInTheRoutine Then ReparseMissing(Token) : ProgressPre.Done() : ThrowAny(Token)
Else Else
ReparseMissing(Token) ReparseMissing(Token)
ProgressPre.Done()
End If End If
If _TempMediaList.Count > 0 Then If _TempMediaList.Count > 0 Then
@@ -976,9 +992,10 @@ BlockNullPicture:
End If End If
ReparseVideo(Token) ReparseVideo(Token)
ProgressPre.Done()
ThrowAny(Token) ThrowAny(Token)
If UseMD5Comparison Then ValidateMD5(Token) : ThrowAny(Token) If UseMD5Comparison Then ValidateMD5(Token) : ProgressPre.Done() : ThrowAny(Token)
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then _ If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then _
TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None) TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None)
@@ -1031,6 +1048,7 @@ BlockNullPicture:
DownloadMissingOnly = False DownloadMissingOnly = False
_ForceSaveUserData = False _ForceSaveUserData = False
_ForceSaveUserInfo = False _ForceSaveUserInfo = False
ProgressPre.Done()
End Try End Try
End Sub End Sub
Protected Sub UpdateDataFiles() Protected Sub UpdateDataFiles()
@@ -1064,8 +1082,6 @@ BlockNullPicture:
If Not HOST Is Nothing AndAlso Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser) If Not HOST Is Nothing AndAlso Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
SeparateVideoFolder = False SeparateVideoFolder = False
IsSingleObjectDownload = True IsSingleObjectDownload = True
UseInternalDownloadFileFunction_UseProgress = True
UseInternalM3U8Function_UseProgress = True
DownloadSingleObject_GetPosts(Data, Token) DownloadSingleObject_GetPosts(Data, Token)
DownloadSingleObject_CreateMedia(Data, Token) DownloadSingleObject_CreateMedia(Data, Token)
DownloadSingleObject_Download(Data, Token) DownloadSingleObject_Download(Data, Token)
@@ -1157,15 +1173,17 @@ BlockNullPicture:
ImgFormat = GetImageFormat(__data.File) ImgFormat = GetImageFormat(__data.File)
End If End If
If ImgFormat Is Nothing Then ImgFormat = Imaging.ImageFormat.Jpeg If ImgFormat Is Nothing Then ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then If IsUrl And Not __isGif Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL_BASE.IfNullOrEmpty(__data.URL), ErrMD5), ImgFormat, ErrMD5)) hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
ElseIf IsUrl And __isGif Then
hash = ByteArrayToString(GetMD5FromBytes(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ErrMD5))
Else Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5)) hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If End If
If hash.IsEmptyString And Not __isGif Then If hash.IsEmptyString And Not __isGif Then
If ImgFormat Is Imaging.ImageFormat.Jpeg Then ImgFormat = Imaging.ImageFormat.Png Else ImgFormat = Imaging.ImageFormat.Jpeg If ImgFormat Is Imaging.ImageFormat.Jpeg Then ImgFormat = Imaging.ImageFormat.Png Else ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL_BASE.IfNullOrEmpty(__data.URL), ErrMD5), ImgFormat, ErrMD5)) hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
Else Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5)) hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If End If
@@ -1186,7 +1204,9 @@ BlockNullPicture:
_ForceSaveUserInfo = True _ForceSaveUserInfo = True
If existingFiles.Count > 0 Then If existingFiles.Count > 0 Then
Dim h$ Dim h$
ProgressPre.ChangeMax(existingFiles.Count)
For i = existingFiles.Count - 1 To 0 Step -1 For i = existingFiles.Count - 1 To 0 Step -1
ProgressPre.Perform()
h = __getMD5(New UserMedia With {.File = existingFiles(i)}, False) h = __getMD5(New UserMedia With {.File = existingFiles(i)}, False)
If Not h.IsEmptyString Then If Not h.IsEmptyString Then
If hashList.ContainsKey(h) Then If hashList.ContainsKey(h) Then
@@ -1200,8 +1220,10 @@ BlockNullPicture:
Next Next
End If End If
End If End If
ProgressPre.ChangeMax(_ContentList.Count)
For i = 0 To _ContentList.Count - 1 For i = 0 To _ContentList.Count - 1
data = _ContentList(i) data = _ContentList(i)
ProgressPre.Perform()
If (data.Type = UTypes.GIF Or data.Type = UTypes.Picture) Then If (data.Type = UTypes.GIF Or data.Type = UTypes.Picture) Then
If data.MD5.IsEmptyString Then If data.MD5.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
@@ -1215,8 +1237,10 @@ BlockNullPicture:
End If End If
Next Next
If existingFiles.Count > 0 Then If existingFiles.Count > 0 Then
ProgressPre.ChangeMax(existingFiles.Count)
For i = 0 To existingFiles.Count - 1 For i = 0 To existingFiles.Count - 1
f = existingFiles(i) f = existingFiles(i)
ProgressPre.Perform()
data = New UserMedia(f.File) With { data = New UserMedia(f.File) With {
.State = UStates.Downloaded, .State = UStates.Downloaded,
.Type = IIf(f.Extension = "gif", UTypes.GIF, UTypes.Picture), .Type = IIf(f.Extension = "gif", UTypes.GIF, UTypes.Picture),
@@ -1238,7 +1262,9 @@ BlockNullPicture:
End With End With
End If End If
ProgressPre.ChangeMax(_TempMediaList.Count)
For i = _TempMediaList.Count - 1 To 0 Step -1 For i = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If limit > 0 And itemsCount >= limit Then If limit > 0 And itemsCount >= limit Then
_TempMediaList.RemoveAt(i) _TempMediaList.RemoveAt(i)
Else Else
@@ -1262,6 +1288,8 @@ BlockNullPicture:
Catch iex As ArgumentOutOfRangeException When Disposed Catch iex As ArgumentOutOfRangeException When Disposed
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "ValidateMD5",, VALIDATE_MD5_ERROR) ProcessException(ex, Token, "ValidateMD5",, VALIDATE_MD5_ERROR)
Finally
ProgressPre.Done()
End Try End Try
End Sub End Sub
#End Region #End Region
@@ -1434,13 +1462,11 @@ BlockNullPicture:
End Try End Try
End Sub End Sub
Protected UseInternalM3U8Function As Boolean = False Protected UseInternalM3U8Function As Boolean = False
Protected UseInternalM3U8Function_UseProgress As Boolean = False
Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile ByVal Token As CancellationToken) As SFile
Return Nothing Return Nothing
End Function End Function
Protected UseInternalDownloadFileFunction As Boolean = False Protected UseInternalDownloadFileFunction As Boolean = False
Protected UseInternalDownloadFileFunction_UseProgress As Boolean = False
Protected Overridable Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, Protected Overridable Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile ByVal Token As CancellationToken) As SFile
Return Nothing Return Nothing
@@ -1798,6 +1824,7 @@ BlockNullPicture:
LatestData.Clear() LatestData.Clear()
_TempMediaList.Clear() _TempMediaList.Clear()
_TempPostsList.Clear() _TempPostsList.Clear()
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose() If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()
If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose() If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose()

30
SCrawler/API/Instagram/UserData.vb
View File

@@ -207,19 +207,21 @@ Namespace API.Instagram
If dt.Invoke And Not LastCursor.IsEmptyString Then If dt.Invoke And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token) DownloadData(LastCursor, s, Token)
ProgressPre.Done()
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If dt.Invoke And Not HasError Then If dt.Invoke And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token) DownloadData(String.Empty, s, Token)
ProgressPre.Done()
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If FirstLoadingDone Then LastCursor = String.Empty If FirstLoadingDone Then LastCursor = String.Empty
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
End If End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException Catch eex As ExitException
@@ -229,9 +231,24 @@ Namespace API.Instagram
Finally Finally
E560Thrown = False E560Thrown = False
UpdateResponser() UpdateResponser()
ValidateExtension()
If Not errorFound Then LoadSavePostsKV(False) If Not errorFound Then LoadSavePostsKV(False)
End Try End Try
End Sub End Sub
Private Sub ValidateExtension()
Try
Const heic$ = "heic"
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then
Dim m As UserMedia
For i% = 0 To _TempMediaList.Count - 1
m = _TempMediaList(i)
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _
m.File.Extension = "jpg" : _TempMediaList(i) = m
Next
End If
Catch ex As Exception
End Try
End Sub
Private Sub UpdateResponser() Private Sub UpdateResponser()
Try Try
If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
@@ -470,7 +487,9 @@ Namespace API.Instagram
HasNextPage = False HasNextPage = False
End If End If
If If(.Item("edges")?.Count, 0) > 0 Then If If(.Item("edges")?.Count, 0) > 0 Then
ProgressPre.ChangeMax(.Item("edges").Count)
For Each nn In .Item("edges") For Each nn In .Item("edges")
ProgressPre.Perform()
PostIDKV = New PostKV(Section) PostIDKV = New PostKV(Section)
If nn.Count > 0 AndAlso nn(0).Count > 0 Then If nn.Count > 0 AndAlso nn(0).Count > 0 Then
With nn(0) With nn(0)
@@ -527,6 +546,7 @@ Namespace API.Instagram
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim dValue% = 1 Dim dValue% = 1
Dim _Index% = 0 Dim _Index% = 0
If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
Try Try
Do While dValue = 1 Do While dValue = 1
ThrowAny(Token) ThrowAny(Token)
@@ -538,7 +558,9 @@ Namespace API.Instagram
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
If PostsToReparse.Count > 0 And _Index <= PostsToReparse.Count - 1 Then If PostsToReparse.Count > 0 And _Index <= PostsToReparse.Count - 1 Then
Dim e As New ErrorsDescriber(EDP.ThrowException) Dim e As New ErrorsDescriber(EDP.ThrowException)
If Index > 0 Then ProgressPre.ChangeMax(1)
For i% = _Index To PostsToReparse.Count - 1 For i% = _Index To PostsToReparse.Count - 1
ProgressPre.Perform()
_Index = i _Index = i
URL = $"https://www.instagram.com/api/v1/media/{PostsToReparse(i).ID}/info/" URL = $"https://www.instagram.com/api/v1/media/{PostsToReparse(i).ID}/info/"
ThrowAny(Token) ThrowAny(Token)
@@ -611,7 +633,9 @@ Namespace API.Instagram
Case Else : SpecFolder = String.Empty Case Else : SpecFolder = String.Empty
End Select End Select
End If End If
ProgressPre.ChangeMax(Items.Count)
For Each nn In Items For Each nn In Items
ProgressPre.Perform()
With nn With nn
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section) PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
Pinned = .Contains("timeline_pinned_user_ids") Pinned = .Contains("timeline_pinned_user_ids")
@@ -799,7 +823,9 @@ Namespace API.Instagram
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("reels") Then If j.Contains("reels") Then
ProgressPre.ChangeMax(j("reels").Count)
For Each jj In j("reels") For Each jj In j("reels")
ProgressPre.Perform()
i += 1 i += 1
sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols
storyID = jj.Value("id").Replace("highlight:", String.Empty) storyID = jj.Value("id").Replace("highlight:", String.Empty)

2
SCrawler/API/LPSG/UserData.vb
View File

@@ -73,7 +73,9 @@ Namespace API.LPSG
Dim r As Func(Of String, Integer, String) Dim r As Func(Of String, Integer, String)
Dim indx% = 0 Dim indx% = 0
Dim ude As New ErrorsDescriber(EDP.ReturnValue) Dim ude As New ErrorsDescriber(EDP.ReturnValue)
ProgressPre.ChangeMax(l.Count)
For Each url$ In l For Each url$ In l
ProgressPre.Perform()
If Not url.IsEmptyString Then u = SymbolsConverter.Decode(url, {Converters.HTML, Converters.ASCII}, ude) Else u = String.Empty If Not url.IsEmptyString Then u = SymbolsConverter.Decode(url, {Converters.HTML, Converters.ASCII}, ude) Else u = String.Empty
If Not u.IsEmptyString Then If Not u.IsEmptyString Then
exists = Not IsEmptyString(RegexReplace(u, FileExistsRegEx)) exists = Not IsEmptyString(RegexReplace(u, FileExistsRegEx))

9
SCrawler/API/Mastodon/SiteSettings.vb
View File

@@ -124,6 +124,15 @@ Namespace API.Mastodon
If _SiteEditorFormOpened Then If _SiteEditorFormOpened Then
Dim tf$ = GifsSpecialFolder.Value Dim tf$ = GifsSpecialFolder.Value
If Not tf.IsEmptyString Then tf = tf.StringTrim("\") : GifsSpecialFolder.Value = tf If Not tf.IsEmptyString Then tf = tf.StringTrim("\") : GifsSpecialFolder.Value = tf
Dim md$ = AConvert(Of String)(MyDomain.Value, String.Empty)
If Not md.IsEmptyString AndAlso Not Domains.Domains.Contains(md) AndAlso Not Domains.DomainsTemp.Contains(md) Then
If Domains.Changed Then
Domains.DomainsTemp.Add(md)
Else
Domains.Domains.Add(md)
Domains.Save()
End If
End If
End If End If
MyBase.Update() MyBase.Update()
End Sub End Sub

6
SCrawler/API/Mastodon/UserData.vb
View File

@@ -120,7 +120,9 @@ Namespace API.Mastodon
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If If(j?.Count, 0) > 0 Then If If(j?.Count, 0) > 0 Then
ProgressPre.ChangeMax(j.Count)
For Each jj As EContainer In j For Each jj As EContainer In j
ProgressPre.Perform()
With jj With jj
If Not IsSavedPosts And POST.IsEmptyString And Not .Item("account") Is Nothing Then If Not IsSavedPosts And POST.IsEmptyString And Not .Item("account") Is Nothing Then
With .Item("account") With .Item("account")
@@ -166,7 +168,7 @@ Namespace API.Mastodon
If If(.Item("media_attachments")?.Count, 0) > 0 Then If If(.Item("media_attachments")?.Count, 0) > 0 Then
s = .Item("media_attachments") s = .Item("media_attachments")
Else Else
s = .Item({"reblog", "account"}, "media_attachments") s = .Item({"reblog"}, "media_attachments")
End If End If
If s.ListExists Then If s.ListExists Then
For Each ss In s : ObtainMedia(ss, PostID, PostDate) : Next For Each ss In s : ObtainMedia(ss, PostID, PostDate) : Next
@@ -268,7 +270,7 @@ Namespace API.Mastodon
If Responser.Status = Net.WebExceptionStatus.NameResolutionFailure Then If Responser.Status = Net.WebExceptionStatus.NameResolutionFailure Then
MyMainLOG = $"User domain ({UserDomain}) not found: {ToStringForLog()}" MyMainLOG = $"User domain ({UserDomain}) not found: {ToStringForLog()}"
Return 1 Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Or Responser.StatusCode = Net.HttpStatusCode.Forbidden Then
UserExists = False UserExists = False
Return 1 Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.Unauthorized Then ElseIf Responser.StatusCode = Net.HttpStatusCode.Unauthorized Then

3
SCrawler/API/Pinterest/SiteSettings.vb
View File

@@ -62,8 +62,7 @@ Namespace API.Pinterest
Return New UserData Return New UserData
End Function End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Settings.GalleryDLFile.Exists And (Not What = ISiteSettings.Download.SavedPosts OrElse Return Settings.GalleryDLFile.Exists And (Not What = ISiteSettings.Download.SavedPosts OrElse ACheck(SavedPostsUserName.Value))
(Responser.CookiesExists And ACheck(SavedPostsUserName.Value)))
End Function End Function
#End Region #End Region
#Region "IsMyUser, IsMyImageVideo, GetUserUrl, GetUserPostUrl" #Region "IsMyUser, IsMyImageVideo, GetUserUrl, GetUserPostUrl"

8
SCrawler/API/Pinterest/UserData.vb
View File

@@ -113,6 +113,8 @@ Namespace API.Pinterest
End If End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"data downloading error [{URL}]")
Finally
ProgressPre.Done()
End Try End Try
End Sub End Sub
#End Region #End Region
@@ -129,7 +131,9 @@ Namespace API.Pinterest
Dim urls As List(Of String) = GetDataFromGalleryDL(URL, True) Dim urls As List(Of String) = GetDataFromGalleryDL(URL, True)
If urls.ListExists Then urls.RemoveAll(Function(__url) Not __url.Contains("BoardsResource/get/")) If urls.ListExists Then urls.RemoveAll(Function(__url) Not __url.Contains("BoardsResource/get/"))
If urls.ListExists Then If urls.ListExists Then
ProgressPre.ChangeMax(urls.Count)
For Each URL In urls For Each URL In urls
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
r = Responser.GetResponse(URL,, EDP.ReturnValue) r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -176,14 +180,18 @@ Namespace API.Pinterest
Dim l As List(Of String) = GetDataFromGalleryDL(Board.URL, False) Dim l As List(Of String) = GetDataFromGalleryDL(Board.URL, False)
If l.ListExists Then l.RemoveAll(Function(ll) Not ll.Contains("BoardFeedResource/get/")) If l.ListExists Then l.RemoveAll(Function(ll) Not ll.Contains("BoardFeedResource/get/"))
If l.ListExists Then If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
For Each bUrl In l For Each bUrl In l
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
r = Responser.GetResponse(bUrl,, EDP.ReturnValue) r = Responser.GetResponse(bUrl,, EDP.ReturnValue)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, jErr) j = JsonDocument.Parse(r, jErr)
If Not j Is Nothing Then If Not j Is Nothing Then
If If(j(rootNode)?.Count, 0) > 0 Then If If(j(rootNode)?.Count, 0) > 0 Then
ProgressPre.ChangeMax(j(rootNode).Count)
For Each jj In j(rootNode) For Each jj In j(rootNode)
ProgressPre.Perform()
With jj With jj
If .Contains("images") Then If .Contains("images") Then
images = .Item("images").Select(imgSelector).ToList images = .Item("images").Select(imgSelector).ToList

7
SCrawler/API/PornHub/Declarations.vb
View File

@@ -13,9 +13,13 @@ Namespace API.PornHub
Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue) Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue)
#End Region #End Region
#Region "Declarations video" #Region "Declarations video"
Friend ReadOnly RegexVideo_FlashVarsBlock As RParams = RParams.DM("(?<=flashvars_\['[nN]ext[vV]ideo'\];[\r\n]*?)(.+?)(?=;flashvars_\d+?)", 0, EDP.ReturnValue) Friend ReadOnly RegexVideo_FlashVarsBlocks As RParams = RParams.DM("(?<=(flashvars_\['[nN]ext[vV]ideo'\]|flashvars_\d+[^ ]+? = media_\d+?);[\r\n]*?)(.+?)(?=;flashvars_\d+?)",
0, RegexReturn.List, EDP.ReturnValue)
'TODELETE: PornHub old 'RegexVideo_FlashVarsBlock' declaration
'Friend ReadOnly RegexVideo_FlashVarsBlock As RParams = RParams.DM("(?<=flashvars_\['[nN]ext[vV]ideo'\];[\r\n]*?)(.+?)(?=;flashvars_\d+?)", 0, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List) Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_Compiler As RParams = RParams.DM("(?<=\*/)([\w\d\S]{10,})", 0, RegexReturn.List) Friend ReadOnly RegexVideo_FlashVars_Compiler As RParams = RParams.DM("(?<=\*/)([\w\d\S]{10,})", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_UrlResolution As RParams = RParams.DMS("/(\d+)[^/]+\.mp4", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideo_Video_All As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""", Friend ReadOnly RegexVideo_Video_All As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""",
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter) 0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Friend ReadOnly RegexVideo_Video_Wrong As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?(?=\<div class=""videoUploaderBlock)", Friend ReadOnly RegexVideo_Video_Wrong As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?(?=\<div class=""videoUploaderBlock)",
@@ -26,6 +30,7 @@ Namespace API.PornHub
Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue) Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue)
#End Region #End Region
#Region "Declarations M3U8" #Region "Declarations M3U8"
Friend ReadOnly Regex_M3U8_FilesList As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]*?(.+?m3u8.*)", 0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly Regex_M3U8_FirstFileRegEx As RParams = RParams.DM(".+?m3u8.*", 0) Friend ReadOnly Regex_M3U8_FirstFileRegEx As RParams = RParams.DM(".+?m3u8.*", 0)
Friend ReadOnly Regex_M3U8_FileUrl As RParams = RParams.DMS("((https://([^/]+)/.+?)([^/]+?m3u8))(.*)", 2, EDP.ReturnValue) Friend ReadOnly Regex_M3U8_FileUrl As RParams = RParams.DMS("((https://([^/]+)/.+?)([^/]+?m3u8))(.*)", 2, EDP.ReturnValue)
#End Region #End Region

18
SCrawler/API/PornHub/M3U8.vb
View File

@@ -16,11 +16,19 @@ Namespace API.PornHub
Friend NotInheritable Class M3U8 Friend NotInheritable Class M3U8
Private Sub New() Private Sub New()
End Sub End Sub
Private Shared Function GetUrlsList(ByVal URL As String, ByVal Responser As Responser) As List(Of String) Private Shared Function GetUrlsList(ByVal URL As String, ByVal Responser As Responser, ByVal DownloadUHD As Boolean) As List(Of String)
Dim appender$ = RegexReplace(URL, Regex_M3U8_FileUrl) Dim appender$ = RegexReplace(URL, Regex_M3U8_FileUrl)
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim file$ = RegexReplace(r, Regex_M3U8_FirstFileRegEx) Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_FilesList}, {1, 2}, EDP.ReturnValue)
Dim file$
If files.ListExists Then files.RemoveAll(Function(f) f.Value = 0 Or (Not DownloadUHD And f.Value > 1080))
If files.ListExists Then
files.Sort()
file = files(0).Data
Else
file = RegexReplace(r, Regex_M3U8_FirstFileRegEx)
End If
If Not file.IsEmptyString Then If Not file.IsEmptyString Then
Dim NewUrl$ = M3U8Base.CreateUrl(appender, file) Dim NewUrl$ = M3U8Base.CreateUrl(appender, file)
If Not NewUrl.IsEmptyString Then If Not NewUrl.IsEmptyString Then
@@ -37,9 +45,9 @@ Namespace API.PornHub
End If End If
Return Nothing Return Nothing
End Function End Function
Friend Shared Function Download(ByVal URL As String, ByVal Responser As Responser, ByVal Destination As SFile, Friend Shared Function Download(ByVal URL As String, ByVal Responser As Responser, ByVal Destination As SFile, ByVal DownloadUHD As Boolean,
ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile ByVal Token As CancellationToken, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Return M3U8Base.Download(GetUrlsList(URL, Responser), Destination, Responser, Token, Progress) Return M3U8Base.Download(GetUrlsList(URL, Responser, DownloadUHD), Destination, Responser, Token, Progress, UsePreProgress)
End Function End Function
End Class End Class
End Namespace End Namespace

3
SCrawler/API/PornHub/SiteSettings.vb
View File

@@ -25,6 +25,8 @@ Namespace API.PornHub
Return My.Resources.SiteResources.PornHubPic_16 Return My.Resources.SiteResources.PornHubPic_16
End Get End Get
End Property End Property
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
Friend Property DownloadUHD As PropertyValue
<PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML> <PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML>
Friend ReadOnly Property DownloadGifs As PropertyValue Friend ReadOnly Property DownloadGifs As PropertyValue
<PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML> <PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML>
@@ -41,6 +43,7 @@ Namespace API.PornHub
MyBase.New("PornHub", "pornhub.com") MyBase.New("PornHub", "pornhub.com")
With Responser : .CurlSslNoRevoke = True : .CurlInsecure = True : End With With Responser : .CurlSslNoRevoke = True : .CurlInsecure = True : End With
DownloadUHD = New PropertyValue(False)
DownloadGifsAsMp4 = New PropertyValue(True) DownloadGifsAsMp4 = New PropertyValue(True)
DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer)) DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer))
DownloadPhotoOnlyFromModelHub = New PropertyValue(True) DownloadPhotoOnlyFromModelHub = New PropertyValue(True)

113
SCrawler/API/PornHub/UserData.vb
View File

@@ -23,6 +23,7 @@ Namespace API.PornHub
Private Const Name_NameTrue As String = "NameTrue" Private Const Name_NameTrue As String = "NameTrue"
Private Const Name_VideoPageModel As String = "VideoPageModel" Private Const Name_VideoPageModel As String = "VideoPageModel"
Private Const Name_PhotoPageModel As String = "PhotoPageModel" Private Const Name_PhotoPageModel As String = "PhotoPageModel"
Private Const Name_DownloadUHD As String = "DownloadUHD"
Private Const Name_DownloadGifs As String = "DownloadGifs" Private Const Name_DownloadGifs As String = "DownloadGifs"
Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub" Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub"
#End Region #End Region
@@ -112,6 +113,7 @@ Namespace API.PornHub
#Region "Advanced fields" #Region "Advanced fields"
Friend Property VideoPageModel As VideoPageModels = VideoPageModels.Undefined Friend Property VideoPageModel As VideoPageModels = VideoPageModels.Undefined
Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined
Friend Property DownloadUHD As Boolean = False
Friend Property DownloadGifs As Boolean Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
#End Region #End Region
@@ -122,6 +124,7 @@ Namespace API.PornHub
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions) With DirectCast(Obj, UserExchangeOptions)
DownloadUHD = .DownloadUHD
DownloadGifs = .DownloadGifs DownloadGifs = .DownloadGifs
DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub
End With End With
@@ -157,6 +160,7 @@ Namespace API.PornHub
NameTrue = .Value(Name_NameTrue) NameTrue = .Value(Name_NameTrue)
VideoPageModel = .Value(Name_VideoPageModel).FromXML(Of Integer)(VideoPageModels.Undefined) VideoPageModel = .Value(Name_VideoPageModel).FromXML(Of Integer)(VideoPageModels.Undefined)
PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined) PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined)
DownloadUHD = .Value(Name_DownloadUHD).FromXML(Of Boolean)(False)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False) DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True) DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
SetNames.Invoke() SetNames.Invoke()
@@ -166,6 +170,7 @@ Namespace API.PornHub
.Add(Name_NameTrue, NameTrue) .Add(Name_NameTrue, NameTrue)
.Add(Name_VideoPageModel, CInt(VideoPageModel)) .Add(Name_VideoPageModel, CInt(VideoPageModel))
.Add(Name_PhotoPageModel, CInt(PhotoPageModel)) .Add(Name_PhotoPageModel, CInt(PhotoPageModel))
.Add(Name_DownloadUHD, DownloadUHD.BoolToInteger)
.Add(Name_DownloadGifs, DownloadGifs.BoolToInteger) .Add(Name_DownloadGifs, DownloadGifs.BoolToInteger)
.Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger) .Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger)
End If End If
@@ -224,6 +229,7 @@ Namespace API.PornHub
Finally Finally
Responser.Mode = Responser.Modes.Default Responser.Mode = Responser.Modes.Default
Responser.Method = "GET" Responser.Method = "GET"
ProgressPre.Done()
End Try End Try
End Sub End Sub
#End Region #End Region
@@ -246,6 +252,7 @@ Namespace API.PornHub
Const VideoUrlPattern$ = "https://www.pornhub.com/{0}/{1}{2}{3}" Const VideoUrlPattern$ = "https://www.pornhub.com/{0}/{1}{2}{3}"
Const HtmlPageNotFoundVideo$ = "<span>Error Page Not Found</span>" Const HtmlPageNotFoundVideo$ = "<span>Error Page Not Found</span>"
Dim URL$ = String.Empty Dim URL$ = String.Empty
ProgressPre.ChangeMax(1)
Try Try
Dim p$ Dim p$
If PersonType = PersonTypeUser Then If PersonType = PersonTypeUser Then
@@ -289,6 +296,8 @@ Namespace API.PornHub
End If End If
Catch ex As Exception Catch ex As Exception
Return ProcessException(ex, Token, $"videos downloading error [{URL}]") Return ProcessException(ex, Token, $"videos downloading error [{URL}]")
Finally
ProgressPre.Perform()
End Try End Try
End Function End Function
#End Region #End Region
@@ -306,11 +315,13 @@ Namespace API.PornHub
Dim l3 As List(Of String) = Nothing Dim l3 As List(Of String) = Nothing
If l.ListExists Then l2 = l.Select(Function(ll) $"gif/{ll.Arr(0).Replace("gif", String.Empty)}").ToList If l.ListExists Then l2 = l.Select(Function(ll) $"gif/{ll.Arr(0).Replace("gif", String.Empty)}").ToList
If l2.ListExists Then If l2.ListExists Then
ProgressPre.ChangeMax(l2.Count)
For Each gif$ In l2 For Each gif$ In l2
If Not _TempPostsList.Contains(gif) Then If Not _TempPostsList.Contains(gif) Then
_TempPostsList.Add(gif) _TempPostsList.Add(gif)
URL = $"https://www.pornhub.com/{gif}" URL = $"https://www.pornhub.com/{gif}"
m = New UserMedia(URL, UTypes.Video) With {.Post = gif, .SpecialFolder = "GIFs\"} m = New UserMedia(URL, UTypes.Video) With {.Post = gif, .SpecialFolder = "GIFs\"}
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
Try Try
r = Responser.GetResponse(URL) r = Responser.GetResponse(URL)
@@ -385,8 +396,10 @@ Namespace API.PornHub
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2}) Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2})
If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString) If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString)
If l.ListExists Then If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
Dim albumRegex As RParams = RParams.DMS("", 1, EDP.ReturnValue) Dim albumRegex As RParams = RParams.DMS("", 1, EDP.ReturnValue)
For Each block As PhotoBlock In l For Each block As PhotoBlock In l
ProgressPre.Perform()
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
albumRegex.Pattern = "<li id=""" & block.AlbumID & """ class=""modelBox"">[\r\n\s]*?<div class=""modelPhoto"">[\r\n\s]*?\<[^\>]*?alt=""([^""]*)""" albumRegex.Pattern = "<li id=""" & block.AlbumID & """ class=""modelBox"">[\r\n\s]*?<div class=""modelPhoto"">[\r\n\s]*?\<[^\>]*?alt=""([^""]*)"""
albumName = StringTrim(RegexReplace(r, albumRegex)) albumName = StringTrim(RegexReplace(r, albumRegex))
@@ -421,7 +434,9 @@ Namespace API.PornHub
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1}) Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1})
If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString) If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString)
If l.ListExists Then If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
For Each block As PhotoBlock In l For Each block As PhotoBlock In l
ProgressPre.Perform()
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
albumName = block.Data albumName = block.Data
If albumName.IsEmptyString Then If albumName.IsEmptyString Then
@@ -449,7 +464,9 @@ Namespace API.PornHub
Dim l As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr) Dim l As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
If l.ListExists Then l.RemoveAll(Function(_url) _url.IsEmptyString) If l.ListExists Then l.RemoveAll(Function(_url) _url.IsEmptyString)
If l.ListExists Then If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
For Each url$ In l For Each url$ In l
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
Try Try
r = Responser.GetResponse(url) r = Responser.GetResponse(url)
@@ -492,7 +509,9 @@ Namespace API.PornHub
Dim lBefore% = l2.Count Dim lBefore% = l2.Count
If _TempPostsList.Count > 0 Then l2.RemoveAll(Function(media) _TempPostsList.Contains(media.Post.ID)) If _TempPostsList.Count > 0 Then l2.RemoveAll(Function(media) _TempPostsList.Contains(media.Post.ID))
If l2.Count > 0 Then If l2.Count > 0 Then
ProgressPre.ChangeMax(l2.Count)
For i% = 0 To l2.Count - 1 For i% = 0 To l2.Count - 1
ProgressPre.Perform()
m = l2(i) m = l2(i)
ThrowAny(Token) ThrowAny(Token)
Try Try
@@ -537,7 +556,9 @@ Namespace API.PornHub
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia Dim m As UserMedia
Dim r$, NewUrl$, tmpName$ Dim r$, NewUrl$, tmpName$
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If _TempMediaList(i).Type = UTypes.VideoPre Then If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i) m = _TempMediaList(i)
ThrowAny(Token) ThrowAny(Token)
@@ -588,7 +609,9 @@ Namespace API.PornHub
Dim m As UserMedia Dim m As UserMedia
Dim r$ Dim r$
Dim eCurl As New ErrorsDescriber(EDP.ReturnValue) Dim eCurl As New ErrorsDescriber(EDP.ReturnValue)
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i) m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
@@ -619,31 +642,91 @@ Namespace API.PornHub
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(URL, Responser, DestinationFile, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing)) Return M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
#End Region #End Region
#Region "CreateVideoURL" #Region "CreateVideoURL"
'TODELETE: PornHub old 'CreateVideoURL' function
'Private Function CreateVideoURL(ByVal r As String) As String
' Try
' Dim OutStr$ = String.Empty
' If Not r.IsEmptyString Then
' Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock)
' If Not _VarBlock.IsEmptyString Then
' Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
' Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
' If vars.ListExists And compiler.ListExists Then
' Dim v$
' Dim i%
' For Each var$ In compiler
' i = vars.IndexOf(var)
' If i >= 0 Then
' v = vars(i).Value
' If Not v.IsEmptyString Then OutStr &= v
' End If
' Next
' End If
' End If
' End If
' Return OutStr
' Catch ex As Exception
' Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
' End Try
'End Function
Private Function CreateVideoURL(ByVal r As String) As String Private Function CreateVideoURL(ByVal r As String) As String
Try Try
Dim OutStr$ = String.Empty Dim OutStr$ = String.Empty
Dim OutList As New List(Of String)
Dim tmpUrl$
Dim i%
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock) Dim _VarBlock$, var$, v$
If Not _VarBlock.IsEmptyString Then Dim vars As List(Of FlashVar)
Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2}) Dim compiler As List(Of String)
Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler) Dim _VarBlocks As List(Of String) = RegexReplace(r, RegexVideo_FlashVarsBlocks)
If vars.ListExists And compiler.ListExists Then If _VarBlocks.ListExists Then
Dim v$ For Each _VarBlock In _VarBlocks
Dim i% tmpUrl = String.Empty
For Each var$ In compiler vars = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
i = vars.IndexOf(var) compiler = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
If i >= 0 Then If vars.ListExists And compiler.ListExists Then
v = vars(i).Value For Each var In compiler
If Not v.IsEmptyString Then OutStr &= v i = vars.IndexOf(var)
End If If i >= 0 Then
Next v = vars(i).Value
If Not v.IsEmptyString Then tmpUrl &= v
End If
Next
vars.Clear()
compiler.Clear()
End If
If Not tmpUrl.IsEmptyString Then OutList.Add(tmpUrl)
Next
End If
End If
If outList.Count > 0 Then outList.RemoveAll(Function(u) u.IsEmptyString)
If outList.Count > 0 Then
i = OutList.FindIndex(Function(u) u.Contains("urlset"))
If i >= 0 Then
OutStr = OutList(i)
Else
Dim newUrls As New List(Of Sizes)
Dim tmpSize%?
For Each tmpUrl In OutList
tmpSize = AConvert(Of Integer)(RegexReplace(tmpUrl, RegexVideo_FlashVars_UrlResolution), AModes.Var, Nothing)
If tmpSize.HasValue Then newUrls.Add(New Sizes(tmpSize.Value, tmpUrl))
Next
If newUrls.Count > 0 Then
newUrls.Sort()
OutStr = newUrls(0).Data
newUrls.Clear()
Else
OutStr = OutList(0)
End If End If
End If End If
End If End If
OutList.Clear()
Return OutStr Return OutStr
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty) Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)

4
SCrawler/API/PornHub/UserExchangeOptions.vb
View File

@@ -9,18 +9,22 @@
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.PornHub Namespace API.PornHub
Friend Class UserExchangeOptions Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.DownloadUHD), NameOf(MySettings))>
Friend Property DownloadUHD As Boolean
<PSetting(Caption:="Download gifs")> <PSetting(Caption:="Download gifs")>
Friend Property DownloadGifs As Boolean Friend Property DownloadGifs As Boolean
<PSetting(NameOf(SiteSettings.DownloadPhotoOnlyFromModelHub), NameOf(MySettings), Caption:="Download photo only from ModelHub")> <PSetting(NameOf(SiteSettings.DownloadPhotoOnlyFromModelHub), NameOf(MySettings), Caption:="Download photo only from ModelHub")>
Friend Property DownloadPhotoOnlyFromModelHub As Boolean Friend Property DownloadPhotoOnlyFromModelHub As Boolean
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
DownloadUHD = u.DownloadUHD
DownloadGifs = u.DownloadGifs DownloadGifs = u.DownloadGifs
DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
MySettings = u.HOST.Source MySettings = u.HOST.Source
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
Dim v As CheckState = CInt(s.DownloadGifs.Value) Dim v As CheckState = CInt(s.DownloadGifs.Value)
DownloadUHD = s.DownloadUHD.Value
DownloadGifs = Not v = CheckState.Unchecked DownloadGifs = Not v = CheckState.Unchecked
DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value
MySettings = s MySettings = s

28
SCrawler/API/Reddit/M3U8.vb
View File

@@ -59,8 +59,10 @@ Namespace API.Reddit
Private ReadOnly CacheFiles As CacheKeeper Private ReadOnly CacheFiles As CacheKeeper
Private ReadOnly Property Progress As MyProgress Private ReadOnly Property Progress As MyProgress
Private ReadOnly ProgressExists As Boolean Private ReadOnly ProgressExists As Boolean
Private ReadOnly Property ProgressPre As PreProgress
Private ReadOnly UsePreProgress As Boolean
#End Region #End Region
Private Sub New(ByVal URL As String, ByVal OutFile As SFile, ByVal Progress As MyProgress) Private Sub New(ByVal URL As String, ByVal OutFile As SFile, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean)
PlayListURL = URL PlayListURL = URL
BaseURL = RegexReplace(URL, BaseUrlPattern) BaseURL = RegexReplace(URL, BaseUrlPattern)
Video = New List(Of String) Video = New List(Of String)
@@ -70,6 +72,8 @@ Namespace API.Reddit
Me.OutFile.Extension = "mp4" Me.OutFile.Extension = "mp4"
Me.Progress = Progress Me.Progress = Progress
ProgressExists = Not Me.Progress Is Nothing ProgressExists = Not Me.Progress Is Nothing
ProgressPre = New PreProgress(Progress)
Me.UsePreProgress = UsePreProgress
Cache = New CacheKeeper($"{OutFile.PathWithSeparator}_{Base.M3U8Base.TempCacheFolderName}\") Cache = New CacheKeeper($"{OutFile.PathWithSeparator}_{Base.M3U8Base.TempCacheFolderName}\")
CacheFiles = Cache.NewInstance CacheFiles = Cache.NewInstance
End Sub End Sub
@@ -142,12 +146,24 @@ Namespace API.Reddit
If tmpCache.Validate Then If tmpCache.Validate Then
Dim i% Dim i%
Dim dFile As SFile = tmpCache.RootDirectory Dim dFile As SFile = tmpCache.RootDirectory
If ProgressExists Then Progress.Maximum += Urls.Count If ProgressExists Then
If UsePreProgress Then
ProgressPre.ChangeMax(Urls.Count)
Else
Progress.Maximum += Urls.Count
End If
End If
dFile.Extension = New SFile(Urls(0)).Extension dFile.Extension = New SFile(Urls(0)).Extension
If dFile.Extension.IsEmptyString Then dFile.Extension = "ts" If dFile.Extension.IsEmptyString Then dFile.Extension = "ts"
Using w As New WebClient Using w As New WebClient
For i = 0 To Urls.Count - 1 For i = 0 To Urls.Count - 1
If ProgressExists Then Progress.Perform() If ProgressExists Then
If UsePreProgress Then
ProgressPre.Perform()
Else
Progress.Perform()
End If
End If
Token.ThrowIfCancellationRequested() Token.ThrowIfCancellationRequested()
dFile.Name = $"ConPart_{i}" dFile.Name = $"ConPart_{i}"
w.DownloadFile(Urls(i), dFile) w.DownloadFile(Urls(i), dFile)
@@ -185,8 +201,9 @@ Namespace API.Reddit
End Function End Function
#End Region #End Region
#Region "Statics" #Region "Statics"
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile, ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile Friend Shared Function Download(ByVal URL As String, ByVal f As SFile, ByVal Token As CancellationToken,
Using m As New M3U8(URL, f, Progress) : Return m.Download(Token) : End Using ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Using m As New M3U8(URL, f, Progress, UsePreProgress) : Return m.Download(Token) : End Using
End Function End Function
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"
@@ -197,6 +214,7 @@ Namespace API.Reddit
Video.Clear() Video.Clear()
Audio.Clear() Audio.Clear()
Cache.Dispose() Cache.Dispose()
ProgressPre.Dispose()
End If End If
disposedValue = True disposedValue = True
End If End If

151
SCrawler/API/Reddit/UserData.vb
View File

@@ -14,6 +14,7 @@ Imports SCrawler.API.YouTube.Objects
Imports SCrawler.Plugin.Hosts Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
@@ -222,6 +223,7 @@ Namespace API.Reddit
GetUserInfo() GetUserInfo()
DownloadDataUser(String.Empty, Token) DownloadDataUser(String.Empty, Token)
End If End If
ProgressPre.Done()
End Sub End Sub
#End Region #End Region
#Region "Download Functions (User, Channel)" #Region "Download Functions (User, Channel)"
@@ -247,7 +249,6 @@ Namespace API.Reddit
Dim ExistsDetected As Boolean = False Dim ExistsDetected As Boolean = False
Dim IsCrossPost As Predicate(Of EContainer) = Function(e) Not e.Value(Node_CrosspostRootId).IsEmptyString Or Not e.Value(Node_CrosspostParentId).IsEmptyString Or Not e.Value(Node_CrosspostParent).IsEmptyString Dim IsCrossPost As Predicate(Of EContainer) = Function(e) Not e.Value(Node_CrosspostRootId).IsEmptyString Or Not e.Value(Node_CrosspostParentId).IsEmptyString Or Not e.Value(Node_CrosspostParent).IsEmptyString
Dim CheckNode As Predicate(Of EContainer) = Function(e) Not ParseUserMediaOnly OrElse If(e("author")?.Value, "/").ToLower.Equals(TrueName.StringToLower) Dim CheckNode As Predicate(Of EContainer) = Function(e) Not ParseUserMediaOnly OrElse If(e("author")?.Value, "/").ToLower.Equals(TrueName.StringToLower)
Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
Dim _PostID As Func(Of String) = Function() PostTmp.IfNullOrEmpty(PostID) Dim _PostID As Func(Of String) = Function() PostTmp.IfNullOrEmpty(PostID)
URL = $"https://gateway.reddit.com/desktopapi/v1/user/{TrueName}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic" URL = $"https://gateway.reddit.com/desktopapi/v1/user/{TrueName}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
@@ -258,7 +259,9 @@ Namespace API.Reddit
If w.Count > 0 Then If w.Count > 0 Then
n = w.GetNode(JsonNodesJson) n = w.GetNode(JsonNodesJson)
If Not n Is Nothing AndAlso n.Count > 0 Then If Not n Is Nothing AndAlso n.Count > 0 Then
ProgressPre.ChangeMax(n.Count)
For Each nn In n For Each nn In n
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
If nn.Count > 0 Then If nn.Count > 0 Then
If CheckNode(nn) Then If CheckNode(nn) Then
@@ -340,7 +343,9 @@ Namespace API.Reddit
If w.Count > 0 Then If w.Count > 0 Then
n = w.GetNode(ChannelJsonNodes) n = w.GetNode(ChannelJsonNodes)
If Not n Is Nothing AndAlso n.Count > 0 Then If Not n Is Nothing AndAlso n.Count > 0 Then
ProgressPre.ChangeMax(n.Count)
For Each nn In n For Each nn In n
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
s = nn.ItemF({eCount}) s = nn.ItemF({eCount})
If If(s?.Count, 0) > 0 Then If If(s?.Count, 0) > 0 Then
@@ -467,8 +472,40 @@ Namespace API.Reddit
Select Case t Select Case t
Case "gallery" : If DownloadGallery(.Self, PostID, PostDate) Then _TotalPostsDownloaded += 1 Else added = False Case "gallery" : If DownloadGallery(.Self, PostID, PostDate) Then _TotalPostsDownloaded += 1 Else added = False
Case "image", "gifvideo" Case "image", "gifvideo"
Dim resolution As Sizes = Nothing
Dim content As Sizes = Nothing
Dim chosenVal$ = String.Empty
ParseResolutions(e("media"), e("preview"), resolution)
If .Contains("content") Then If .Contains("content") Then
_TempMediaList.ListAddValue(MediaFromData(UPicType(t), .Value("content"), PostID, PostDate, UserID), LNC) content = CreateSize(.Self, "content")
If content.HasError Or content.Data.IsEmptyString Then content = Nothing
End If
If UPicType(t) = UTypes.Picture Then
If Not content.Data.IsEmptyString Then
If Not resolution.Data.IsEmptyString Then
If content.Value >= resolution.Value AndAlso TryImage(content.Data) Then
chosenVal = content.Data
Else
chosenVal = resolution.Data
End If
Else
chosenVal = content.Data
End If
Else
chosenVal = resolution.Data
End If
Else
If Not resolution.Data.IsEmptyString Then
chosenVal = resolution.Data
ElseIf Not content.Data.IsEmptyString Then
chosenVal = content.Data
End If
End If
If Not chosenVal.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UPicType(t), chosenVal, PostID, PostDate, UserID), LNC)
_TotalPostsDownloaded += 1 _TotalPostsDownloaded += 1
Else Else
added = False added = False
@@ -512,15 +549,17 @@ Namespace API.Reddit
added = ParseContainer(e.ItemF({"crosspost_parent_list", 0}), PostID, PostDate, UserID, True) added = ParseContainer(e.ItemF({"crosspost_parent_list", 0}), PostID, PostDate, UserID, True)
Else Else
Dim tPostId$ = e.Value(Node_CrosspostParent).IfNullOrEmpty(e.Value(Node_CrosspostParentId)).IfNullOrEmpty(e.Value(Node_CrosspostRootId)) Dim tPostId$ = e.Value(Node_CrosspostParent).IfNullOrEmpty(e.Value(Node_CrosspostParentId)).IfNullOrEmpty(e.Value(Node_CrosspostRootId))
Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue) If Not PostID.IsEmptyString Then
If Not r.IsEmptyString Then Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue) If Not r.IsEmptyString Then
If j.ListExists Then Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
With j.ItemF({0, "data", "children", 0, "data"}) If j.ListExists Then
If .ListExists Then added = ParseContainer(.Self, PostID, PostDate, UserID, False) With j.ItemF({0, "data", "children", 0, "data"})
End With If .ListExists Then added = ParseContainer(.Self, PostID, PostDate, UserID, False)
End If End With
End Using End If
End Using
End If
End If End If
End If End If
End If End If
@@ -557,6 +596,19 @@ Namespace API.Reddit
Return False Return False
End If End If
End Function End Function
Private Function TryImage(ByVal URL As String) As Boolean
Try
Dim img As Image = GetImage(SFile.GetBytesFromNet(URL, EDP.ThrowException), EDP.ThrowException)
If Not img Is Nothing Then
img.Dispose()
Return True
Else
Return False
End If
Catch
Return False
End Try
End Function
#End Region #End Region
#Region "Download Base Functions" #Region "Download Base Functions"
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
@@ -640,26 +692,7 @@ Namespace API.Reddit
If Not Node Is Nothing Then If Not Node Is Nothing Then
Dim n As EContainer = Node.ItemF({"preview", "images", 0}) Dim n As EContainer = Node.ItemF({"preview", "images", 0})
Dim DestNode$() = Nothing Dim DestNode$() = Nothing
If If(n?.Count, 0) > 0 Then If If(n?.Count, 0) > 0 Then Return ParseResolutions(n)
If If(n("resolutions")?.Count, 0) > 0 Then
DestNode = {"resolutions"}
ElseIf If(n({"variants", "nsfw", "resolutions"})?.Count, 0) > 0 Then
DestNode = {"variants", "nsfw", "resolutions"}
End If
If Not DestNode Is Nothing Then
With n(DestNode)
Dim sl As List(Of Sizes) = .Select(Function(e) New Sizes(e.Value("width"), e.Value("url"))).
ListWithRemove(Function(ss) ss.HasError Or ss.Data.IsEmptyString)
If sl.ListExists Then
Dim s As Sizes
sl.Sort()
s = sl.First
sl.Clear()
Return s.Data
End If
End With
End If
End If
End If End If
Return String.Empty Return String.Empty
Catch ex As Exception Catch ex As Exception
@@ -667,6 +700,46 @@ Namespace API.Reddit
Return String.Empty Return String.Empty
End Try End Try
End Function End Function
Private Function ParseResolutions(ByVal Node As EContainer, Optional ByVal PreviewNode As EContainer = Nothing,
Optional ByRef SResult As Sizes = Nothing) As String
Try
If If(Node?.Count, 0) > 0 Then
Dim DestNode$() = Nothing
If If(Node("resolutions")?.Count, 0) > 0 Then
DestNode = {"resolutions"}
ElseIf If(Node({"variants", "nsfw", "resolutions"})?.Count, 0) > 0 Then
DestNode = {"variants", "nsfw", "resolutions"}
End If
If Not DestNode Is Nothing Then
With Node(DestNode)
Dim sl As List(Of Sizes) = .Select(Function(e) CreateSize(e)).
ListWithRemove(Function(ss) ss.HasError Or ss.Data.IsEmptyString)
If If(PreviewNode?.Count, 0) > 0 Then
Dim sp As Sizes = CreateSize(PreviewNode)
If Not sp.HasError And Not sp.Data.IsEmptyString Then
If sl Is Nothing Then sl = New List(Of Sizes)
sl.Add(sp)
End If
End If
If sl.ListExists Then
Dim s As Sizes
sl.Sort()
s = sl.First
sl.Clear()
SResult = s
Return s.Data
End If
End With
End If
End If
Return String.Empty
Catch ex As Exception
Return String.Empty
End Try
End Function
Private Function CreateSize(ByVal Node As EContainer, Optional ByVal UrlNodeName As String = "url") As Sizes
Return New Sizes(Node.Value("width"), Node.Value(UrlNodeName))
End Function
#End Region #End Region
#Region "ReparseVideo" #Region "ReparseVideo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken) Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
@@ -681,8 +754,10 @@ Namespace API.Reddit
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey) Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
Dim _repeatForRedgifs As Boolean Dim _repeatForRedgifs As Boolean
RedGifsResponser = RedGifsHost.Responser.Copy RedGifsResponser = RedGifsHost.Responser.Copy
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ThrowAny(Token) ThrowAny(Token)
ProgressPre.Perform()
If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then
m = _TempMediaList(i) m = _TempMediaList(i)
If _TempMediaList(i).Type = UTypes.VideoPre Then If _TempMediaList(i).Type = UTypes.VideoPre Then
@@ -728,6 +803,7 @@ Namespace API.Reddit
ProcessException(ex, Token, "video reparsing error", False) ProcessException(ex, Token, "video reparsing error", False)
Finally Finally
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose() If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
ProgressPre.Done()
End Try End Try
End Sub End Sub
#End Region #End Region
@@ -744,8 +820,10 @@ Namespace API.Reddit
Dim r$ Dim r$
Dim j As EContainer Dim j As EContainer
Dim lastCount%, li% Dim lastCount%, li%
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
m = _ContentList(i) m = _ContentList(i)
ProgressPre.Perform()
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, EDP.ReturnValue) r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
@@ -781,6 +859,7 @@ Namespace API.Reddit
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear() rList.Clear()
End If End If
ProgressPre.Done()
End Try End Try
End Sub End Sub
#End Region #End Region
@@ -804,17 +883,13 @@ Namespace API.Reddit
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}} Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}}
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CreateFileFromUrl(m.URL) Else m.File = Nothing If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CreateFileFromUrl(m.URL) Else m.File = Nothing
If ReplacePreview And m.URL.Contains("preview") Then m.URL = $"https://i.redd.it/{m.File.File}" If ReplacePreview And m.URL.Contains("preview") And Not t = UTypes.Picture Then m.URL = $"https://i.redd.it/{m.File.File}"
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel), Nothing) Else m.Post.Date = Nothing If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel), Nothing) Else m.Post.Date = Nothing
Return m Return m
End Function End Function
Private Function TryFile(ByVal URL As String) As Boolean Private Function TryFile(ByVal URL As String) As Boolean
Try Try
If Not URL.IsEmptyString AndAlso URL.StringContains({".jpg", ".png", ".jpeg"}) Then Return Not URL.IsEmptyString AndAlso Not CreateFileFromUrl(URL).IsEmptyString
Return Not CreateFileFromUrl(URL).IsEmptyString
Else
Return False
End If
Catch ex As Exception Catch ex As Exception
Return False Return False
End Try End Try
@@ -861,7 +936,7 @@ Namespace API.Reddit
Return URL.Contains(SiteRedGifsKey) Return URL.Contains(SiteRedGifsKey)
End Function End Function
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(URL, DestinationFile, Token, IIf(IsSingleObjectDownload, Progress, Nothing)) Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
If Not IsChannel Or Not SaveToCache Then If Not IsChannel Or Not SaveToCache Then

6
SCrawler/API/Redgifs/UserData.vb
View File

@@ -50,7 +50,9 @@ Namespace API.RedGifs
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("gifs") Then If j.Contains("gifs") Then
pTotal = j.Value("pages").FromXML(Of Integer)(0) pTotal = j.Value("pages").FromXML(Of Integer)(0)
ProgressPre.ChangeMax(j("gifs").Count)
For Each g As EContainer In j("gifs") For Each g As EContainer In j("gifs")
ProgressPre.Perform()
postDate = g.Value("createDate") postDate = g.Value("createDate")
Select Case CheckDatesLimit(postDate, UnixDate32Provider) Select Case CheckDatesLimit(postDate, UnixDate32Provider)
Case DateResult.Skip : Continue For Case DateResult.Skip : Continue For
@@ -102,11 +104,13 @@ Namespace API.RedGifs
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer) Dim rList As New List(Of Integer)
Try Try
If _ContentList.Exists(MissingFinder) Then If ContentMissingExists Then
Dim url$, r$ Dim url$, r$
Dim u As UserMedia Dim u As UserMedia
Dim j As EContainer Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
If _ContentList(i).State = UStates.Missing Then If _ContentList(i).State = UStates.Missing Then
ThrowAny(Token) ThrowAny(Token)
u = _ContentList(i) u = _ContentList(i)

8
SCrawler/API/ThisVid/UserData.vb
View File

@@ -129,6 +129,7 @@ Namespace API.ThisVid
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsPublic As Boolean, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsPublic As Boolean, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
ProgressPre.ChangeMax(1)
Dim p$ = IIf(Page = 1, String.Empty, $"{Page}/") Dim p$ = IIf(Page = 1, String.Empty, $"{Page}/")
If IsSavedPosts Then If IsSavedPosts Then
URL = $"https://thisvid.com/my_favourite_videos/{p}" URL = $"https://thisvid.com/my_favourite_videos/{p}"
@@ -136,6 +137,7 @@ Namespace API.ThisVid
URL = $"https://thisvid.com/members/{ID}/{IIf(IsPublic, "public", "private")}_videos/{p}" URL = $"https://thisvid.com/members/{ID}/{IIf(IsPublic, "public", "private")}_videos/{p}"
End If End If
ThrowAny(Token) ThrowAny(Token)
ProgressPre.Perform()
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
Dim cBefore% = _TempMediaList.Count Dim cBefore% = _TempMediaList.Count
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -182,7 +184,9 @@ Namespace API.ThisVid
__continue = True __continue = True
If albums.ListExists Then If albums.ListExists Then
If albums.Count < 20 Then __continue = False If albums.Count < 20 Then __continue = False
ProgressPre.ChangeMax(albums.Count)
For Each a As Album In albums For Each a As Album In albums
ProgressPre.Perform()
If Not a.URL.IsEmptyString Then If Not a.URL.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
r = Responser.GetResponse(a.URL,, rErr) r = Responser.GetResponse(a.URL,, rErr)
@@ -191,7 +195,9 @@ Namespace API.ThisVid
If a.Title.IsEmptyString Then a.Title = albumId If a.Title.IsEmptyString Then a.Title = albumId
images = RegexReplace(r, RegExAlbumImagesList) images = RegexReplace(r, RegExAlbumImagesList)
If images.ListExists Then If images.ListExists Then
ProgressPre.ChangeMax(images.Count)
For Each img In images For Each img In images
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
r = Responser.GetResponse(img,, rErr) r = Responser.GetResponse(img,, rErr)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -242,7 +248,9 @@ Namespace API.ThisVid
Dim cookieFile As SFile = DirectCast(HOST.Source, SiteSettings).CookiesNetscapeFile Dim cookieFile As SFile = DirectCast(HOST.Source, SiteSettings).CookiesNetscapeFile
Dim command$ Dim command$
Dim e As EContainer Dim e As EContainer
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
u = _TempMediaList(i) u = _TempMediaList(i)
If u.Type = UserMedia.Types.VideoPre Then If u.Type = UserMedia.Types.VideoPre Then
ThrowAny(Token) ThrowAny(Token)

68
SCrawler/API/Twitter/UserData.vb
View File

@@ -125,36 +125,40 @@ Namespace API.Twitter
End With End With
End If End If
For Each nn In If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, w) With If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, w)
ThrowAny(Token) ProgressPre.ChangeMax(.Count)
If nn.Count > 0 Then For Each nn In .Self
PostID = nn.Value("id") ProgressPre.Perform()
If ID.IsEmptyString Then ThrowAny(Token)
ID = UID(nn) If nn.Count > 0 Then
If Not ID.IsEmptyString Then UpdateUserInformation() PostID = nn.Value("id")
If ID.IsEmptyString Then
ID = UID(nn)
If Not ID.IsEmptyString Then UpdateUserInformation()
End If
'Date Pattern:
'Sat Jan 01 01:10:15 +0000 2000
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
Select Case CheckDatesLimit(PostDate, Declarations.DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
Else
ExistsDetected = True
Continue For
End If
If Not ParseUserMediaOnly OrElse
(Not nn.Contains("retweeted_status") OrElse (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then _
ObtainMedia(nn, PostID, PostDate)
End If End If
Next
'Date Pattern: End With
'Sat Jan 01 01:10:15 +0000 2000
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
Select Case CheckDatesLimit(PostDate, Declarations.DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
Else
ExistsDetected = True
Continue For
End If
If Not ParseUserMediaOnly OrElse
(Not nn.Contains("retweeted_status") OrElse (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then _
ObtainMedia(nn, PostID, PostDate)
End If
Next
End If End If
End Using End Using
@@ -174,7 +178,9 @@ Namespace API.Twitter
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
Dim jErr As New ErrorsDescriber(EDP.ReturnValue) Dim jErr As New ErrorsDescriber(EDP.ReturnValue)
Dim rPattern As RParams = RParams.DM("(?<=tweet-)(\d+)\Z", 0, EDP.ReturnValue) Dim rPattern As RParams = RParams.DM("(?<=tweet-)(\d+)\Z", 0, EDP.ReturnValue)
ProgressPre.ChangeMax(urls.Count)
For Each url$ In urls For Each url$ In urls
ProgressPre.Perform()
r = Responser.GetResponse(url) r = Responser.GetResponse(url)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, jErr) j = JsonDocument.Parse(r, jErr)
@@ -187,7 +193,9 @@ Namespace API.Twitter
Next Next
If postIds.Count > 0 Then postIds.RemoveAll(Function(pid) pid.IsEmptyString OrElse (_TempPostsList.Contains(pid) Or _DataNames.Contains(pid))) If postIds.Count > 0 Then postIds.RemoveAll(Function(pid) pid.IsEmptyString OrElse (_TempPostsList.Contains(pid) Or _DataNames.Contains(pid)))
If postIds.Count > 0 Then If postIds.Count > 0 Then
ProgressPre.ChangeMax(postIds.Count)
For Each __id$ In postIds For Each __id$ In postIds
ProgressPre.Perform()
_TempPostsList.Add(__id) _TempPostsList.Add(__id)
r = Responser.GetResponse(String.Format(SinglePostUrl, __id),, EDP.ReturnValue) r = Responser.GetResponse(String.Format(SinglePostUrl, __id),, EDP.ReturnValue)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -329,7 +337,9 @@ Namespace API.Twitter
Dim m As UserMedia Dim m As UserMedia
Dim r$, PostDate$ Dim r$, PostDate$
Dim j As EContainer Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
If _ContentList(i).State = UStates.Missing Then If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i) m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Then If Not m.Post.ID.IsEmptyString Then

4
SCrawler/API/XVIDEOS/M3U8.vb
View File

@@ -14,7 +14,7 @@ Namespace API.XVIDEOS
Private Sub New() Private Sub New()
End Sub End Sub
Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal f As SFile, Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal f As SFile,
ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile ByVal Token As CancellationToken, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Using w As New WebClient Using w As New WebClient
@@ -22,7 +22,7 @@ Namespace API.XVIDEOS
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim l As List(Of String) = ListAddList(Nothing, r.StringFormatLines.StringToList(Of String)(vbNewLine).ListWithRemove(Function(v) v.Trim.StartsWith("#")), Dim l As List(Of String) = ListAddList(Nothing, r.StringFormatLines.StringToList(Of String)(vbNewLine).ListWithRemove(Function(v) v.Trim.StartsWith("#")),
New ListAddParams With {.Converter = Function(Input) $"{Appender}/{Input.ToString.Trim}"}) New ListAddParams With {.Converter = Function(Input) $"{Appender}/{Input.ToString.Trim}"})
If l.ListExists Then Return Base.M3U8Base.Download(l, f,, Token, Progress) If l.ListExists Then Return Base.M3U8Base.Download(l, f,, Token, Progress, UsePreProgress)
End If End If
End Using End Using
End If End If

8
SCrawler/API/XVIDEOS/UserData.vb
View File

@@ -91,8 +91,10 @@ Namespace API.XVIDEOS
If .Contains("videos") Then If .Contains("videos") Then
With .Item("videos") With .Item("videos")
If .Count > 0 Then If .Count > 0 Then
ProgressPre.ChangeMax(.Count)
NextPage += 1 NextPage += 1
For Each jj In .Self For Each jj In .Self
ProgressPre.Perform()
p = New UserMedia With { p = New UserMedia With {
.Post = jj.Value("id"), .Post = jj.Value("id"),
.URL = $"https://www.xvideos.com/{jj.Value(n).StringTrimStart("/")}" .URL = $"https://www.xvideos.com/{jj.Value(n).StringTrimStart("/")}"
@@ -123,7 +125,9 @@ Namespace API.XVIDEOS
If Not j Is Nothing Then j.Dispose() If Not j Is Nothing Then j.Dispose()
If _TempMediaList.Count > 0 Then If _TempMediaList.Count > 0 Then
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = 0 To _TempMediaList.Count - 1 For i% = 0 To _TempMediaList.Count - 1
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
_TempMediaList(i) = GetVideoData(_TempMediaList(i)) _TempMediaList(i) = GetVideoData(_TempMediaList(i))
Next Next
@@ -180,7 +184,9 @@ Namespace API.XVIDEOS
Loop While NextPage < 100 And __continue Loop While NextPage < 100 And __continue
If _TempMediaList.Count > 0 Then If _TempMediaList.Count > 0 Then
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = 0 To _TempMediaList.Count - 1 For i% = 0 To _TempMediaList.Count - 1
ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
_TempMediaList(i) = GetVideoData(_TempMediaList(i)) _TempMediaList(i) = GetVideoData(_TempMediaList(i))
Next Next
@@ -244,7 +250,7 @@ Namespace API.XVIDEOS
If Not m.URL.IsEmptyString Then _TempMediaList.Add(m) If Not m.URL.IsEmptyString Then _TempMediaList.Add(m)
End Sub End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing)) Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer

4
SCrawler/API/Xhamster/M3U8.vb
View File

@@ -75,8 +75,8 @@ Namespace API.Xhamster
End Try End Try
End Function End Function
Friend Shared Function Download(ByVal Media As UserMedia, ByVal Responser As Responser, ByVal UHD As Boolean, Friend Shared Function Download(ByVal Media As UserMedia, ByVal Responser As Responser, ByVal UHD As Boolean,
ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile ByVal Token As CancellationToken, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Return M3U8Base.Download(ObtainUrls(Media.URL, Responser, UHD), Media.File, Responser, Token, Progress) Return M3U8Base.Download(ObtainUrls(Media.URL, Responser, UHD), Media.File, Responser, Token, Progress, UsePreProgress)
End Function End Function
End Class End Class
End Namespace End Namespace

11
SCrawler/API/Xhamster/UserData.vb
View File

@@ -112,7 +112,9 @@ Namespace API.Xhamster
With j(listNode) With j(listNode)
If .ListExists Then If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each e As EContainer In .Self For Each e As EContainer In .Self
ProgressPre.Perform()
m = ExtractMedia(e, Type) m = ExtractMedia(e, Type)
If Not m.URL.IsEmptyString Then If Not m.URL.IsEmptyString Then
If m.File.IsEmptyString Then Continue For If m.File.IsEmptyString Then Continue For
@@ -160,7 +162,9 @@ Namespace API.Xhamster
Try Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia, m2 As UserMedia Dim m As UserMedia, m2 As UserMedia
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If _TempMediaList(i).Type = UTypes.VideoPre Then If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i) m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then If Not m.URL_BASE.IsEmptyString Then
@@ -182,7 +186,8 @@ Namespace API.Xhamster
End Sub End Sub
Private Overloads Sub ReparsePhoto(ByVal Token As CancellationToken) Private Overloads Sub ReparsePhoto(ByVal Token As CancellationToken)
If _TempPhotoData.Count > 0 Then If _TempPhotoData.Count > 0 Then
For i% = 0 To _TempPhotoData.Count - 1 : ReparsePhoto(i, 1, Token) : Next ProgressPre.ChangeMax(_TempPhotoData.Count)
For i% = 0 To _TempPhotoData.Count - 1 : ProgressPre.Perform() : ReparsePhoto(i, 1, Token) : Next
_TempPhotoData.Clear() _TempPhotoData.Clear()
End If End If
End Sub End Sub
@@ -235,7 +240,9 @@ Namespace API.Xhamster
Try Try
If ContentMissingExists Then If ContentMissingExists Then
Dim m As UserMedia, m2 As UserMedia Dim m As UserMedia, m2 As UserMedia
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i) m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
@@ -297,7 +304,7 @@ Namespace API.Xhamster
End Sub End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Media.File = DestinationFile Media.File = DestinationFile
Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing)) Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
#End Region #End Region
#Region "Create media" #Region "Create media"

11
SCrawler/API/YouTube/UserData.vb
View File

@@ -111,6 +111,7 @@ Namespace API.YouTube
#Region "Download" #Region "Download"
'Playlist reconfiguration implemented only for channels + music 'Playlist reconfiguration implemented only for channels + music
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim pr As New YTPreProgress(ProgressPre)
Try Try
Dim container As IYouTubeMediaContainer = Nothing Dim container As IYouTubeMediaContainer = Nothing
Dim list As New List(Of IYouTubeMediaContainer) Dim list As New List(Of IYouTubeMediaContainer)
@@ -154,7 +155,7 @@ Namespace API.YouTube
maxDate = Nothing maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist) LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={ID}" url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDatePlaylist) container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDatePlaylist)
applySpecFolder.Invoke(String.Empty, False) applySpecFolder.Invoke(String.Empty, False)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now) If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
ElseIf YTMediaType = YouTubeMediaType.Channel Then ElseIf YTMediaType = YouTubeMediaType.Channel Then
@@ -162,7 +163,7 @@ Namespace API.YouTube
maxDate = Nothing maxDate = Nothing
LastDownloadDateVideos = nDate(LastDownloadDateVideos) LastDownloadDateVideos = nDate(LastDownloadDateVideos)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/{IIf(IsMusic Or IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}" url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/{IIf(IsMusic Or IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDateVideos) container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDateVideos)
applySpecFolder.Invoke(IIf(IsMusic, String.Empty, "Videos"), False) applySpecFolder.Invoke(IIf(IsMusic, String.Empty, "Videos"), False)
If fillList.Invoke(LastDownloadDateVideos) Then LastDownloadDateVideos = If(maxDate, Now) If fillList.Invoke(LastDownloadDateVideos) Then LastDownloadDateVideos = If(maxDate, Now)
End If End If
@@ -170,7 +171,7 @@ Namespace API.YouTube
maxDate = Nothing maxDate = Nothing
LastDownloadDateShorts = nDate(LastDownloadDateShorts) LastDownloadDateShorts = nDate(LastDownloadDateShorts)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/shorts" url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/shorts"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDateShorts) container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDateShorts)
applySpecFolder.Invoke("Shorts", False) applySpecFolder.Invoke("Shorts", False)
If fillList.Invoke(LastDownloadDateShorts) Then LastDownloadDateShorts = If(maxDate, Now) If fillList.Invoke(LastDownloadDateShorts) Then LastDownloadDateShorts = If(maxDate, Now)
End If End If
@@ -178,7 +179,7 @@ Namespace API.YouTube
maxDate = Nothing maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist) LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/playlists" url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/playlists"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDatePlaylist) container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDatePlaylist)
applySpecFolder.Invoke("Playlists", True) applySpecFolder.Invoke("Playlists", True)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now) If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
End If End If
@@ -196,6 +197,8 @@ Namespace API.YouTube
End If End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "data downloading error") ProcessException(ex, Token, "data downloading error")
Finally
pr.Dispose()
End Try End Try
End Sub End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)

38
SCrawler/API/YouTube/YTPreProgress.vb Normal file
View File

@@ -0,0 +1,38 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms.Toolbars
Namespace API.YouTube
Friend Class YTPreProgress : Inherits MyProgress
Private ReadOnly AssocProgress As PreProgress
Friend Sub New(ByRef ExtProgress As PreProgress)
AssocProgress = ExtProgress
End Sub
Public Overrides Property Maximum As Double
Get
Return _Maximum
End Get
Set(ByVal Max As Double)
_Maximum = Max
AssocProgress.ChangeMax(Max, False)
End Set
End Property
Public Overrides Sub Perform(Optional ByVal Value As Double = 1)
AssocProgress.Perform(Value)
End Sub
Public Overrides Sub Done()
AssocProgress.Done()
End Sub
Public Overrides Property Visible(Optional ByVal ProgressBar As Boolean = True, Optional ByVal Label As Boolean = True) As Boolean
Get
Return True
End Get
Set : End Set
End Property
End Class
End Namespace

5
SCrawler/Download/ActiveDownloadingProgress.vb
View File

@@ -63,6 +63,7 @@ Namespace DownloadObjects
.RowCount += 1 .RowCount += 1
JobsList.Add(New DownloadProgress(j)) JobsList.Add(New DownloadProgress(j))
AddHandler JobsList.Last.ProgressMaximumChanged, AddressOf Jobs_ProgressMaximumChanged AddHandler JobsList.Last.ProgressMaximumChanged, AddressOf Jobs_ProgressMaximumChanged
AddHandler JobsList.Last.ProgressMaximum0Changed, AddressOf Jobs_ProgressMaximum0Changed
.Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1) .Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1)
End With End With
Next Next
@@ -90,5 +91,9 @@ Namespace DownloadObjects
If MainProgress.Value > 0 Then MainProgress.Perform() If MainProgress.Value > 0 Then MainProgress.Perform()
End If End If
End Sub End Sub
Private Sub Jobs_ProgressMaximum0Changed()
If JobsList.Count > 0 And Not DisableProgressChange Then _
MainProgress.Maximum0 = JobsList.Sum(Function(j) CLng(DirectCast(j.Job.Progress, MyProgressExt).Maximum0))
End Sub
End Class End Class
End Namespace End Namespace

19
SCrawler/Download/DownloadProgress.vb
View File

@@ -14,6 +14,7 @@ Namespace DownloadObjects
#Region "Events" #Region "Events"
Friend Event DownloadDone As NotificationEventHandler Friend Event DownloadDone As NotificationEventHandler
Friend Event ProgressMaximumChanged() Friend Event ProgressMaximumChanged()
Friend Event ProgressMaximum0Changed()
#End Region #End Region
#Region "Declarations" #Region "Declarations"
#Region "Controls" #Region "Controls"
@@ -114,10 +115,12 @@ Namespace DownloadObjects
End If End If
With Job With Job
.Progress = New MyProgress(PR_MAIN, LBL_INFO) With {.ResetProgressOnMaximumChanges = False} .Progress = New MyProgressExt(PR_MAIN, LBL_INFO) With {.ResetProgressOnMaximumChanges = False}
With .Progress With DirectCast(.Progress, MyProgressExt)
AddHandler .ProgressChanged, AddressOf JobProgress_ProgressChanged AddHandler .ProgressChanged, AddressOf JobProgress_ProgressChanged
AddHandler .MaximumChanged, AddressOf JobProgress_MaximumChanged AddHandler .MaximumChanged, AddressOf JobProgress_MaximumChanged
AddHandler .Maximum0Changed, AddressOf JobProgress_Maximum0Changed
AddHandler .Progress0Changed, AddressOf JobProgress_Progress0Changed
End With End With
End With End With
@@ -183,8 +186,18 @@ Namespace DownloadObjects
Private Sub JobProgress_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Private Sub JobProgress_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
RaiseEvent ProgressMaximumChanged() RaiseEvent ProgressMaximumChanged()
End Sub End Sub
Private Sub JobProgress_Maximum0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs)
RaiseEvent ProgressMaximum0Changed()
End Sub
Private Sub JobProgress_ProgressChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Private Sub JobProgress_ProgressChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If Not Job.Type = Download.SavedPosts Then MainProgress.Perform() If Not Job.Type = Download.SavedPosts Then
MainProgress.Value = DirectCast(Sender, MyProgressExt).Value
MainProgress.Perform(0)
End If
End Sub
Private Sub JobProgress_Progress0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs)
MainProgress.Value0 = DirectCast(Sender, MyProgressExt).Value0
MainProgress.Perform0(0)
End Sub End Sub
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"

11
SCrawler/Editors/UserCreatorForm.Designer.vb generated
View File

@@ -105,10 +105,10 @@ Namespace Editors
'BTT_OTHER_SETTINGS 'BTT_OTHER_SETTINGS
' '
Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(2, 2) Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(1, 1)
Me.BTT_OTHER_SETTINGS.Margin = New System.Windows.Forms.Padding(1) Me.BTT_OTHER_SETTINGS.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS" Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS"
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(101, 24) Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(101, 26)
Me.BTT_OTHER_SETTINGS.TabIndex = 1 Me.BTT_OTHER_SETTINGS.TabIndex = 1
Me.BTT_OTHER_SETTINGS.Text = "Options (F2)" Me.BTT_OTHER_SETTINGS.Text = "Options (F2)"
TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings") TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings")
@@ -177,7 +177,6 @@ Namespace Editors
' '
'TP_SITE 'TP_SITE
' '
Me.TP_SITE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.TP_SITE.ColumnCount = 2 Me.TP_SITE.ColumnCount = 2
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 103.0!)) Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 103.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
@@ -209,10 +208,10 @@ Namespace Editors
Me.CMB_SITE.Columns.Add(ListColumn1) Me.CMB_SITE.Columns.Add(ListColumn1)
Me.CMB_SITE.Columns.Add(ListColumn2) Me.CMB_SITE.Columns.Add(ListColumn2)
Me.CMB_SITE.Dock = System.Windows.Forms.DockStyle.Fill Me.CMB_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_SITE.Location = New System.Drawing.Point(108, 3) Me.CMB_SITE.Location = New System.Drawing.Point(103, 3)
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3) Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(0, 3, 3, 3)
Me.CMB_SITE.Name = "CMB_SITE" Me.CMB_SITE.Name = "CMB_SITE"
Me.CMB_SITE.Size = New System.Drawing.Size(340, 21) Me.CMB_SITE.Size = New System.Drawing.Size(346, 22)
Me.CMB_SITE.TabIndex = 0 Me.CMB_SITE.TabIndex = 0
Me.CMB_SITE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle Me.CMB_SITE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
' '

287
SCrawler/Editors/UsersInfoForm.Designer.vb generated Normal file
View File

@@ -0,0 +1,287 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace Editors
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class UsersInfoForm : 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 SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(UsersInfoForm))
Me.Toolbar_TOP = New System.Windows.Forms.ToolStrip()
Me.BTT_START = New System.Windows.Forms.ToolStripButton()
Me.BTT_CANCEL = New System.Windows.Forms.ToolStripButton()
Me.MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
Me.OPT_DATE = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SIZE = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_AMOUNT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_ASC = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_DESC = New System.Windows.Forms.ToolStripMenuItem()
Me.CH_GROUP_DRIVE = New System.Windows.Forms.ToolStripMenuItem()
Me.CH_GROUP_COL = New System.Windows.Forms.ToolStripMenuItem()
Me.Toolbar_BOTTOM = New System.Windows.Forms.StatusStrip()
Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_STATUS = New System.Windows.Forms.ToolStripStatusLabel()
Me.LIST_DATA = New System.Windows.Forms.ListView()
Me.COL_DEFAULT = CType(New System.Windows.Forms.ColumnHeader(), System.Windows.Forms.ColumnHeader)
Me.CONTEXT_LIST = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.CONTEXT_BTT_FIND = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_BTT_INFO = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_BTT_OPEN_FOLDER = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_BTT_OPEN_SITE = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.Toolbar_TOP.SuspendLayout()
Me.Toolbar_BOTTOM.SuspendLayout()
Me.CONTEXT_LIST.SuspendLayout()
Me.SuspendLayout()
'
'SEP_1
'
SEP_1.Name = "SEP_1"
SEP_1.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(166, 6)
'
'MENU_SEP_1
'
MENU_SEP_1.Name = "MENU_SEP_1"
MENU_SEP_1.Size = New System.Drawing.Size(175, 6)
'
'MENU_SEP_2
'
MENU_SEP_2.Name = "MENU_SEP_2"
MENU_SEP_2.Size = New System.Drawing.Size(175, 6)
'
'Toolbar_TOP
'
Me.Toolbar_TOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.Toolbar_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_START, Me.BTT_CANCEL, SEP_1, Me.MENU_VIEW})
Me.Toolbar_TOP.Location = New System.Drawing.Point(0, 0)
Me.Toolbar_TOP.Name = "Toolbar_TOP"
Me.Toolbar_TOP.ShowItemToolTips = False
Me.Toolbar_TOP.Size = New System.Drawing.Size(284, 25)
Me.Toolbar_TOP.TabIndex = 0
'
'BTT_START
'
Me.BTT_START.AutoToolTip = False
Me.BTT_START.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_START.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_START.Name = "BTT_START"
Me.BTT_START.Size = New System.Drawing.Size(76, 22)
Me.BTT_START.Text = "Calculate"
'
'BTT_CANCEL
'
Me.BTT_CANCEL.AutoToolTip = False
Me.BTT_CANCEL.Enabled = False
Me.BTT_CANCEL.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_CANCEL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CANCEL.Name = "BTT_CANCEL"
Me.BTT_CANCEL.Size = New System.Drawing.Size(63, 22)
Me.BTT_CANCEL.Text = "Cancel"
'
'MENU_VIEW
'
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.OPT_DATE, Me.OPT_SIZE, Me.OPT_AMOUNT, MENU_SEP_1, Me.OPT_ASC, Me.OPT_DESC, MENU_SEP_2, Me.CH_GROUP_DRIVE, Me.CH_GROUP_COL})
Me.MENU_VIEW.Image = CType(resources.GetObject("MENU_VIEW.Image"), System.Drawing.Image)
Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_VIEW.Name = "MENU_VIEW"
Me.MENU_VIEW.Size = New System.Drawing.Size(61, 22)
Me.MENU_VIEW.Text = "View"
'
'OPT_DATE
'
Me.OPT_DATE.CheckOnClick = True
Me.OPT_DATE.Name = "OPT_DATE"
Me.OPT_DATE.Size = New System.Drawing.Size(178, 22)
Me.OPT_DATE.Text = "Sort by date"
'
'OPT_SIZE
'
Me.OPT_SIZE.CheckOnClick = True
Me.OPT_SIZE.Name = "OPT_SIZE"
Me.OPT_SIZE.Size = New System.Drawing.Size(178, 22)
Me.OPT_SIZE.Text = "Sort by size"
'
'OPT_AMOUNT
'
Me.OPT_AMOUNT.CheckOnClick = True
Me.OPT_AMOUNT.Name = "OPT_AMOUNT"
Me.OPT_AMOUNT.Size = New System.Drawing.Size(178, 22)
Me.OPT_AMOUNT.Text = "Sort by amount"
'
'OPT_ASC
'
Me.OPT_ASC.CheckOnClick = True
Me.OPT_ASC.Name = "OPT_ASC"
Me.OPT_ASC.Size = New System.Drawing.Size(178, 22)
Me.OPT_ASC.Text = "Ascending"
'
'OPT_DESC
'
Me.OPT_DESC.CheckOnClick = True
Me.OPT_DESC.Name = "OPT_DESC"
Me.OPT_DESC.Size = New System.Drawing.Size(178, 22)
Me.OPT_DESC.Text = "Descending"
'
'CH_GROUP_DRIVE
'
Me.CH_GROUP_DRIVE.CheckOnClick = True
Me.CH_GROUP_DRIVE.Name = "CH_GROUP_DRIVE"
Me.CH_GROUP_DRIVE.Size = New System.Drawing.Size(178, 22)
Me.CH_GROUP_DRIVE.Text = "Group by drive"
'
'CH_GROUP_COL
'
Me.CH_GROUP_COL.CheckOnClick = True
Me.CH_GROUP_COL.Name = "CH_GROUP_COL"
Me.CH_GROUP_COL.Size = New System.Drawing.Size(178, 22)
Me.CH_GROUP_COL.Text = "Group by collection"
'
'Toolbar_BOTTOM
'
Me.Toolbar_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.PR_MAIN, Me.LBL_STATUS})
Me.Toolbar_BOTTOM.Location = New System.Drawing.Point(0, 239)
Me.Toolbar_BOTTOM.Name = "Toolbar_BOTTOM"
Me.Toolbar_BOTTOM.Size = New System.Drawing.Size(284, 22)
Me.Toolbar_BOTTOM.TabIndex = 1
'
'PR_MAIN
'
Me.PR_MAIN.Name = "PR_MAIN"
Me.PR_MAIN.Size = New System.Drawing.Size(200, 16)
Me.PR_MAIN.Visible = False
'
'LBL_STATUS
'
Me.LBL_STATUS.Name = "LBL_STATUS"
Me.LBL_STATUS.Size = New System.Drawing.Size(0, 17)
'
'LIST_DATA
'
Me.LIST_DATA.Columns.AddRange(New System.Windows.Forms.ColumnHeader() {Me.COL_DEFAULT})
Me.LIST_DATA.ContextMenuStrip = Me.CONTEXT_LIST
Me.LIST_DATA.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_DATA.FullRowSelect = True
Me.LIST_DATA.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
Me.LIST_DATA.HideSelection = False
Me.LIST_DATA.Location = New System.Drawing.Point(0, 25)
Me.LIST_DATA.MultiSelect = False
Me.LIST_DATA.Name = "LIST_DATA"
Me.LIST_DATA.Size = New System.Drawing.Size(284, 214)
Me.LIST_DATA.TabIndex = 2
Me.LIST_DATA.UseCompatibleStateImageBehavior = False
Me.LIST_DATA.View = System.Windows.Forms.View.Details
'
'COL_DEFAULT
'
Me.COL_DEFAULT.Text = "User"
Me.COL_DEFAULT.Width = 280
'
'CONTEXT_LIST
'
Me.CONTEXT_LIST.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.CONTEXT_BTT_FIND, Me.CONTEXT_BTT_INFO, CONTEXT_SEP_1, Me.CONTEXT_BTT_OPEN_FOLDER, Me.CONTEXT_BTT_OPEN_SITE})
Me.CONTEXT_LIST.Name = "CONTEXT_LIST"
Me.CONTEXT_LIST.Size = New System.Drawing.Size(170, 98)
'
'CONTEXT_BTT_FIND
'
Me.CONTEXT_BTT_FIND.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.CONTEXT_BTT_FIND.Name = "CONTEXT_BTT_FIND"
Me.CONTEXT_BTT_FIND.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_FIND.Text = "Find user"
'
'CONTEXT_BTT_INFO
'
Me.CONTEXT_BTT_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.CONTEXT_BTT_INFO.Name = "CONTEXT_BTT_INFO"
Me.CONTEXT_BTT_INFO.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_INFO.Text = "Show information"
'
'CONTEXT_BTT_OPEN_FOLDER
'
Me.CONTEXT_BTT_OPEN_FOLDER.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32
Me.CONTEXT_BTT_OPEN_FOLDER.Name = "CONTEXT_BTT_OPEN_FOLDER"
Me.CONTEXT_BTT_OPEN_FOLDER.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_OPEN_FOLDER.Text = "Open folder"
'
'CONTEXT_BTT_OPEN_SITE
'
Me.CONTEXT_BTT_OPEN_SITE.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
Me.CONTEXT_BTT_OPEN_SITE.Name = "CONTEXT_BTT_OPEN_SITE"
Me.CONTEXT_BTT_OPEN_SITE.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_OPEN_SITE.Text = "Open site"
'
'UsersInfoForm
'
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(Me.LIST_DATA)
Me.Controls.Add(Me.Toolbar_BOTTOM)
Me.Controls.Add(Me.Toolbar_TOP)
Me.Icon = Global.SCrawler.My.Resources.Resources.UsersIcon_32
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(300, 300)
Me.Name = "UsersInfoForm"
Me.Text = "Users info"
Me.Toolbar_TOP.ResumeLayout(False)
Me.Toolbar_TOP.PerformLayout()
Me.Toolbar_BOTTOM.ResumeLayout(False)
Me.Toolbar_BOTTOM.PerformLayout()
Me.CONTEXT_LIST.ResumeLayout(False)
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private WithEvents Toolbar_TOP As ToolStrip
Private WithEvents Toolbar_BOTTOM As StatusStrip
Private WithEvents PR_MAIN As ToolStripProgressBar
Private WithEvents LBL_STATUS As ToolStripStatusLabel
Private WithEvents LIST_DATA As ListView
Private WithEvents BTT_START As ToolStripButton
Private WithEvents BTT_CANCEL As ToolStripButton
Private WithEvents COL_DEFAULT As ColumnHeader
Private WithEvents CONTEXT_LIST As ContextMenuStrip
Private WithEvents CONTEXT_BTT_FIND As ToolStripMenuItem
Private WithEvents CONTEXT_BTT_INFO As ToolStripMenuItem
Private WithEvents CONTEXT_BTT_OPEN_FOLDER As ToolStripMenuItem
Private WithEvents CONTEXT_BTT_OPEN_SITE As ToolStripMenuItem
Private WithEvents MENU_VIEW As ToolStripDropDownButton
Private WithEvents OPT_DATE As ToolStripMenuItem
Private WithEvents OPT_SIZE As ToolStripMenuItem
Private WithEvents OPT_AMOUNT As ToolStripMenuItem
Private WithEvents OPT_ASC As ToolStripMenuItem
Private WithEvents OPT_DESC As ToolStripMenuItem
Private WithEvents CH_GROUP_DRIVE As ToolStripMenuItem
Private WithEvents CH_GROUP_COL As ToolStripMenuItem
End Class
End Namespace

150
SCrawler/Editors/UsersInfoForm.resx Normal file
View File

@@ -0,0 +1,150 @@
<?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="CONTEXT_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="Toolbar_TOP.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="MENU_VIEW.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAABkSURBVDhPY6AKyO86WFDQfeg/iIYKkQZAmkNbnvyXta76
DxViYGFi+Y8PQ5VBAMhmkGYgJs8FAw9GA5EKILFiWUFixfL/IBoqRBoAafYsOvpf0jiTvEAE2QzSLGmU
MeQCkYEBAD3tUdo+/cEPAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="Toolbar_BOTTOM.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>138, 17</value>
</metadata>
<metadata name="CONTEXT_LIST.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>286, 17</value>
</metadata>
</root>

504
SCrawler/Editors/UsersInfoForm.vb Normal file
View File

@@ -0,0 +1,504 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace Editors
Friend Class UsersInfoForm
#Region "Declarations"
Private ReadOnly MyView As FormView
Private ReadOnly MyProgress As MyProgress
Private MyThread As Thread = Nothing
Private TokenSource As CancellationTokenSource = Nothing
Private Token As CancellationToken = Nothing
Private ReadOnly MyUsers As List(Of UserOpt)
Private ReadOnly LetterGroups As Dictionary(Of String, ListViewGroup)
Private ReadOnly MyNumberProvider As ANumbers
Private ReadOnly SizeNumberProvider As ANumbers
Private Enum EComparers As Integer
Size = 0
[Date] = 1
Amount = 2
End Enum
#Region "Comparers declarations"
Private ReadOnly MyComparerDate As New ComparerDate
Private ReadOnly MyComparerSize As New ComparerSize
Private ReadOnly MyComparerAmount As New ComparerAmount
#End Region
#Region "Comparers classes"
Private Class ComparerDate : Implements IComparer(Of UserOpt)
Protected _Order As Integer = -1
Friend Property Order As SortOrder
Get
Return IIf(_Order = -1, SortOrder.Descending, SortOrder.Ascending)
End Get
Set(ByVal _Order As SortOrder)
If _Order = SortOrder.Descending Then Me._Order = -1 Else Me._Order = 1
End Set
End Property
Friend Overridable Function Compare(ByVal x As UserOpt, ByVal y As UserOpt) As Integer Implements IComparer(Of UserOpt).Compare
Dim xd& = If(x.User.LastUpdated, New Date).Ticks
Dim yd& = If(y.User.LastUpdated, New Date).Ticks
Return xd.CompareTo(yd) * _Order
End Function
End Class
Private Class ComparerSize : Inherits ComparerDate
Friend Overrides Function Compare(ByVal x As UserOpt, ByVal y As UserOpt) As Integer
Return x.TotalSize.CompareTo(y.TotalSize) * _Order
End Function
End Class
Private Class ComparerAmount : Inherits ComparerDate
Friend Overrides Function Compare(ByVal x As UserOpt, ByVal y As UserOpt) As Integer
Return x.Files.Count.CompareTo(y.Files.Count) * _Order
End Function
End Class
#End Region
#Region "Classes"
Private Structure FileOpt
Friend File As SFile
Friend Size As Double
Friend Type As UTypes
Friend Sub New(ByVal f As SFile, Optional ByVal CalculateSize As Boolean = False)
File = f
If CalculateSize Then Size = File.Size
Type = UTypes.Undefined
If Not f.Extension.IsEmptyString Then
Select Case f.Extension
Case "jpg", "jped", "png", "webp" : Type = UTypes.Picture
Case "gif" : Type = UTypes.GIF
Case "mp4", "mkv" : Type = UTypes.Video
End Select
End If
End Sub
Public Shared Widening Operator CType(ByVal f As SFile) As FileOpt
Return New FileOpt(f)
End Operator
Public Shared Widening Operator CType(ByVal f As FileOpt) As SFile
Return f.File
End Operator
Public Shared Narrowing Operator CType(ByVal f As FileOpt) As Double
Return f.Size
End Operator
End Structure
Private NotInheritable Class UserOpt : Implements IComparable(Of UserOpt), IDisposable
Friend Property User As UserDataBase
Friend Property UserPath As SFile
Friend Property Letter As String
Friend ReadOnly Property Files As List(Of FileOpt)
Friend Property TotalSize As Double = 0
Friend Property CollectionName As String
Friend Property Name As String
Friend Property Site As String
Friend Property Key As String
Private ReadOnly NumberProvider As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral, .DecimalDigits = 2, .TrimDecimalDigits = True}
Friend Sub New(ByVal User As UserDataBase)
Me.User = User
Files = New List(Of FileOpt)
CollectionName = User.CollectionName
Site = User.Site
Name = User.FriendlyName.IfNullOrEmpty(User.Name)
Key = User.LVIKey
UserPath = User.User.File.CutPath
Letter = UserPath.Segments.FirstOrDefault.StringToUpper.StringTrimEnd(":")
End Sub
Friend Sub GetFiles()
If UserPath.Exists(SFO.Path, False) Then
Dim files As List(Of SFile) = SFile.GetFiles(UserPath,, IO.SearchOption.AllDirectories, EDP.ReturnValue)
If files.ListExists Then
For Each f As SFile In files : Me.Files.Add(New FileOpt(f, True)) : Next
TotalSize = Me.Files.Sum(Function(ff) ff.Size)
End If
End If
End Sub
Friend Function GetLVI(ByVal LetterGroup As ListViewGroup, ByVal CollectionGroup As Boolean) As ListViewItem
Dim lvi As New ListViewItem
Dim s$ = String.Empty
If Not CollectionName.IsEmptyString Then s = $"{IIf(CollectionGroup, " ", String.Empty)}{CollectionName}"
s.StringAppend(Site, ".")
s.StringAppend(Name, ".")
s &= $" [{GetSizeStr(TotalSize)}]"
If Not User.UserExists Then
s &= " DELETED"
ElseIf User.UserSuspended Then
s &= " SUSPENDED"
End If
s &= ": "
Dim infoStr$ = String.Empty
infoStr.StringAppend(GetInfoStr(UTypes.Picture), "; ")
infoStr.StringAppend(GetInfoStr(UTypes.GIF), "; ")
infoStr.StringAppend(GetInfoStr(UTypes.Video), "; ")
infoStr.StringAppend(GetInfoStr(UTypes.Undefined), "; ")
If Not infoStr.IsEmptyString Then infoStr &= "; "
If User.LastUpdated.HasValue Then
infoStr &= $"({User.LastUpdated.Value.ToStringDate(ADateTime.Formats.BaseDate)})"
Else
infoStr &= "(not downloaded yet)"
End If
s &= infoStr
lvi.Text = s
lvi.Name = Key
lvi.Tag = Me
lvi.Group = LetterGroup
Return lvi
End Function
Private Function GetSizeStr(ByVal Value As Double) As String
If Value > 0 Then
Dim sizeText$ = "Mb"
Dim sizeValue# = Value / 1024 / 1024
If sizeValue > 1000 Then sizeValue /= 1024 : sizeText = "Gb"
Return $"{sizeValue.RoundVal(2).NumToString(NumberProvider)}{sizeText}"
Else
Return "0Kb"
End If
End Function
Private Function GetInfoStr(ByVal t As UTypes, Optional ByVal Separator As String = " ") As String
Dim OutStr$ = String.Empty
Dim d As IEnumerable(Of FileOpt) = Files.Where(Function(f) f.Type = t)
If d.ListExists Then
Return $"{t} ({d.Count.NumToString(NumberProvider)}){Separator}[{GetSizeStr(d.Sum(Function(dd) dd.Size))}]"
Else
Return String.Empty
End If
End Function
Friend Function GetInfornation() As String
Dim s$ = String.Empty
If Not CollectionName.IsEmptyString Then s &= $"Collection: {CollectionName}"
s.StringAppendLine(Site)
s.StringAppendLine(Name)
s.StringAppendLine($"Total size: {GetSizeStr(TotalSize)}")
s &= vbNewLine
s.StringAppendLine(GetInfoStr(UTypes.Picture, ": "))
s.StringAppendLine(GetInfoStr(UTypes.GIF, ": "))
s.StringAppendLine(GetInfoStr(UTypes.Video, ": "))
s.StringAppendLine(GetInfoStr(UTypes.Undefined, ": "))
If Not User.UserExists Then
s.StringAppendLine("User DELETED")
ElseIf User.UserSuspended Then
s.StringAppendLine("User SUSPENDED")
End If
s.StringAppendLine("Last download date: ")
If User.LastUpdated.HasValue Then
s &= User.LastUpdated.Value.ToStringDate(ADateTime.Formats.BaseDate)
Else
s &= "not downloaded yet"
End If
Return s
End Function
#Region "IComparable Support"
Private Function CompareTo(ByVal Other As UserOpt) As Integer Implements IComparable(Of UserOpt).CompareTo
Return TotalSize.CompareTo(Other.TotalSize) * -1
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Files.Clear()
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 Region
#End Region
#Region "Initializer"
Friend Sub New()
InitializeComponent()
MyView = New FormView(Me, Settings.Design)
MyProgress = New MyProgress(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS)
MyUsers = New List(Of UserOpt)
LetterGroups = New Dictionary(Of String, ListViewGroup)
MyNumberProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
SizeNumberProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral, .DecimalDigits = 2, .TrimDecimalDigits = True}
End Sub
#End Region
#Region "Form handlers"
Private Sub UsersInfoForm_Load(sender As Object, e As EventArgs) Handles Me.Load
MyView.Import()
MyView.SetFormSize()
OPT_DATE.Tag = CInt(EComparers.Date)
OPT_SIZE.Tag = CInt(EComparers.Size)
OPT_AMOUNT.Tag = CInt(EComparers.Amount)
Select Case Settings.UMetrics_What.Value
Case EComparers.Date : OPT_DATE.Checked = True
Case EComparers.Amount : OPT_AMOUNT.Checked = True
Case Else : OPT_SIZE.Checked = True
End Select
OPT_ASC.Tag = CInt(SortOrder.Ascending)
OPT_DESC.Tag = CInt(SortOrder.Descending)
If Settings.UMetrics_Order.Value = SortOrder.Ascending Then
OPT_ASC.Checked = True
Else
OPT_DESC.Checked = True
End If
CH_GROUP_DRIVE.Checked = Settings.UMetrics_ShowDrives
CH_GROUP_COL.Checked = Settings.UMetrics_ShowCollections
LIST_DATA.ShowGroups = CH_GROUP_DRIVE.Checked
COL_DEFAULT.Width = -2
End Sub
Private Sub UsersInfoForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub UsersInfoForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
Abort()
MyProgress.Dispose()
MyView.Dispose()
End Sub
Private Sub UsersInfoForm_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd
Try : ControlInvokeFast(LIST_DATA, Sub() COL_DEFAULT.Width = -2, EDP.None) : Catch : End Try
End Sub
#End Region
#Region "Calculating"
Private Sub Abort()
Try
If If(MyThread?.IsAlive, False) Then TokenSource.Cancel() : MyThread.Abort()
Catch ex As Exception
End Try
End Sub
Private _CalculationInProgress As Boolean = False
Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click
If Not If(MyThread?.IsAlive, False) Then
_CalculationInProgress = True
MyUsers.ListClearDispose
LetterGroups.Clear()
LIST_DATA.Groups.Clear()
LIST_DATA.Items.Clear()
If Not TokenSource Is Nothing Then TokenSource.Dispose()
TokenSource = New CancellationTokenSource
Token = TokenSource.Token
ChangeControlsEnabled(True)
MyThread = New Thread(New ThreadStart(AddressOf Calculate))
MyThread.SetApartmentState(ApartmentState.MTA)
MyThread.IsBackground = True
MyThread.Start()
Else
MsgBoxE({"The calculating is already underway", "Calculating"}, vbCritical)
End If
End Sub
Private Sub BTT_CANCEL_Click(sender As Object, e As EventArgs) Handles BTT_CANCEL.Click
TokenSource.Cancel()
ControlInvokeFast(Toolbar_TOP, BTT_CANCEL, Sub() BTT_CANCEL.Enabled = False, EDP.None)
End Sub
Private Sub ChangeControlsEnabled(ByVal Working As Boolean)
Try
ControlInvokeFast(Toolbar_TOP, BTT_START, Sub()
BTT_START.Enabled = Not Working
BTT_CANCEL.Enabled = Working
End Sub, EDP.None)
If Not Working Then MainFrameObj.UpdateLogButton()
Catch
End Try
End Sub
Private Sub Calculate()
Try
MyProgress.Visible = True
MyProgress.Reset()
If Settings.Users.Count > 0 Then
With Settings.Users.SelectMany(Function(ByVal u As IUserData) As IEnumerable(Of IUserData)
If u.IsCollection Then
With DirectCast(u, API.UserDataBind)
If .Count > 0 Then Return .Collections Else Return New UserDataBase() {}
End With
Else
Return {u}
End If
End Function)
If .ListExists Then .ToList.ForEach(Sub(u As UserDataBase) MyUsers.Add(New UserOpt(u)))
End With
End If
If MyUsers.Count > 0 Then
MyProgress.Maximum += MyUsers.Count
Dim i% = 0
Dim letters As IEnumerable(Of String) = MyUsers.Select(Function(u) u.Letter).Distinct
LetterGroups.Clear()
If letters.ListExists(2) Then
ControlInvokeFast(LIST_DATA, Sub()
For Each l$ In letters
LetterGroups.Add(l, New ListViewGroup(l, $"Drive {l}"))
LIST_DATA.Groups.Add(LetterGroups.Last.Value)
Next
End Sub, EDP.None)
End If
MyProgress.Information = "Calculating of user metrics"
For Each user As UserOpt In MyUsers
Token.ThrowIfCancellationRequested()
i += 1
MyProgress.Perform()
user.GetFiles()
Next
_CalculationInProgress = False
RefillList()
End If
MyProgress.Done()
MyProgress.InformationTemporary = "All user metrics have been calculated."
Catch oex As OperationCanceledException
MyProgress.Done()
MyProgress.InformationTemporary = "Operation canceled"
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[UsersInfoForm.Calculate]")
MyProgress.Done()
MyProgress.InformationTemporary = "An error occurred while calculating user metrics."
Finally
MyProgress.Visible(, False) = False
ChangeControlsEnabled(False)
_CalculationInProgress = False
End Try
End Sub
Private _RefillInProgress As Boolean = False
Private Sub RefillList()
If Not _CalculationInProgress AndAlso Not _RefillInProgress AndAlso MyUsers.Count > 0 Then
_RefillInProgress = True
ControlInvokeFast(LIST_DATA, Sub() LIST_DATA.Items.Clear(), EDP.None)
If MyUsers.Count > 0 Then
Dim i% = 0
Dim g As Func(Of UserOpt, ListViewGroup) = Function(u) If(LetterGroups.Count > 1, LetterGroups(u.Letter), Nothing)
Dim comparer As IComparer(Of UserOpt)
Select Case True
Case OPT_DATE.Checked : comparer = MyComparerDate
Case OPT_AMOUNT.Checked : comparer = MyComparerAmount
Case Else : comparer = MyComparerSize
End Select
DirectCast(comparer, ComparerDate).Order = IIf(OPT_ASC.Checked, SortOrder.Ascending, SortOrder.Descending)
MyUsers.Sort(comparer)
ControlInvokeFast(LIST_DATA, Sub()
Dim user As UserOpt
Dim gg As Boolean = CH_GROUP_COL.Checked
Dim colUsers As New Dictionary(Of String, List(Of UserOpt))
Dim colUsersNo As New List(Of UserOpt)
Dim lvi As ListViewItem
Dim s#
Dim sn$
For Each user In MyUsers
If gg And Not user.CollectionName.IsEmptyString Then
If colUsers.ContainsKey(user.CollectionName) Then
colUsers(user.CollectionName).Add(user)
Else
colUsers.Add(user.CollectionName, New List(Of UserOpt) From {user})
End If
Else
colUsersNo.Add(user)
End If
Next
If colUsers.Count > 0 Then
For Each kv As KeyValuePair(Of String, List(Of UserOpt)) In colUsers
sn = "Mb"
s = kv.Value.Sum(Function(v) v.TotalSize) / 1024 / 1024
If s > 1000 Then s /= 1024 : sn = "Gb"
lvi = New ListViewItem($"Collection: {kv.Key}: {s.RoundVal(2).NumToString(SizeNumberProvider)}{sn}") With {
.Tag = kv.Value(0),
.Name = Settings.GetUser(kv.Value(0).User, True).Key,
.Group = g(kv.Value(0))
}
LIST_DATA.Items.Add(lvi)
For Each user In kv.Value : LIST_DATA.Items.Add(user.GetLVI(g(user), gg)) : Next
Next
End If
If colUsersNo.Count > 0 Then
For Each user In colUsersNo : LIST_DATA.Items.Add(user.GetLVI(g(user), gg)) : Next
End If
COL_DEFAULT.Width = -2
End Sub, EDP.None)
End If
_RefillInProgress = False
End If
End Sub
#End Region
#Region "View"
Private Sub OPT_SORT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DATE.Click, OPT_SIZE.Click, OPT_AMOUNT.Click
If Not Sender.Checked Then
Sender.Checked = True
Else
Settings.UMetrics_What.Value = Sender.Tag
For Each obj As ToolStripMenuItem In {OPT_DATE, OPT_SIZE, OPT_AMOUNT}
If Not obj Is Sender Then obj.Checked = False
Next
RefillList()
End If
End Sub
Private Sub OPT_ASC_DESC_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_ASC.Click, OPT_DESC.Click
If Not Sender.Checked Then
Sender.Checked = True
Else
Settings.UMetrics_Order.Value = Sender.Tag
For Each obj As ToolStripMenuItem In {OPT_ASC, OPT_DESC}
If Not obj Is Sender Then obj.Checked = False
Next
RefillList()
End If
End Sub
Private Sub CH_GROUP_DRIVE_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles CH_GROUP_DRIVE.Click
LIST_DATA.ShowGroups = Sender.Checked
Settings.UMetrics_ShowDrives.Value = Sender.Checked
End Sub
Private Sub CH_GROUP_COL_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles CH_GROUP_COL.Click
Settings.UMetrics_ShowCollections.Value = Sender.Checked
RefillList()
End Sub
#End Region
#Region "Context handlers"
Private Function GetUserFromList() As UserOpt
Try
If LIST_DATA.SelectedItems.Count > 0 Then
Dim i As ListViewItem = LIST_DATA.SelectedItems(0)
If Not i Is Nothing Then Return i.Tag
End If
Catch ex As Exception
End Try
Return Nothing
End Function
Private Sub CONTEXT_BTT_FIND_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_FIND.Click
MainFrameObj.FocusUser(If(GetUserFromList()?.Key, String.Empty), True)
End Sub
Private Sub CONTEXT_BTT_INFO_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_INFO.Click
Dim info$ = If(GetUserFromList()?.GetInfornation(), String.Empty)
If Not info.IsEmptyString Then MsgBoxE({info, "User information"})
End Sub
Private Sub CONTEXT_BTT_OPEN_FOLDER_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_OPEN_FOLDER.Click
Dim u As UserOpt = GetUserFromList()
If Not u Is Nothing Then u.User.OpenFolder()
End Sub
Private Sub CONTEXT_BTT_OPEN_SITE_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_OPEN_SITE.Click
Dim u As UserOpt = GetUserFromList()
If Not u Is Nothing Then u.User.OpenSite()
End Sub
#End Region
End Class
End Namespace

7
SCrawler/MainFrame.Designer.vb generated
View File

@@ -51,7 +51,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_EDIT_USER = New System.Windows.Forms.ToolStripButton() Me.BTT_EDIT_USER = New System.Windows.Forms.ToolStripButton()
Me.BTT_DELETE_USER = New System.Windows.Forms.ToolStripButton() Me.BTT_DELETE_USER = New System.Windows.Forms.ToolStripButton()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton() Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_SHOW_INFO = New System.Windows.Forms.ToolStripButton() Me.BTT_SHOW_INFO = New PersonalUtilities.Forms.Controls.KeyClick.ToolStripButtonKeyClick()
Me.BTT_FEED = New System.Windows.Forms.ToolStripButton() Me.BTT_FEED = New System.Windows.Forms.ToolStripButton()
Me.BTT_CHANNELS = New System.Windows.Forms.ToolStripButton() Me.BTT_CHANNELS = New System.Windows.Forms.ToolStripButton()
Me.BTT_DOWN_SAVED = New System.Windows.Forms.ToolStripButton() Me.BTT_DOWN_SAVED = New System.Windows.Forms.ToolStripButton()
@@ -327,8 +327,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_INFO.Name = "BTT_SHOW_INFO" Me.BTT_SHOW_INFO.Name = "BTT_SHOW_INFO"
Me.BTT_SHOW_INFO.Size = New System.Drawing.Size(48, 22) Me.BTT_SHOW_INFO.Size = New System.Drawing.Size(48, 22)
Me.BTT_SHOW_INFO.Text = "Info" Me.BTT_SHOW_INFO.Text = "Info"
Me.BTT_SHOW_INFO.ToolTipText = "Left-click: open the 'Info' form (show download summary)." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Right click: open the " & Me.BTT_SHOW_INFO.ToolTipText = resources.GetString("BTT_SHOW_INFO.ToolTipText")
"'Missing' form (show information about missing posts)."
' '
'BTT_FEED 'BTT_FEED
' '
@@ -940,7 +939,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents BTT_CONTEXT_COL_MERGE As ToolStripMenuItem Private WithEvents BTT_CONTEXT_COL_MERGE As ToolStripMenuItem
Private WithEvents LBL_JOBS_COUNT As ToolStripStatusLabel Private WithEvents LBL_JOBS_COUNT As ToolStripStatusLabel
Private WithEvents BTT_DOWN_VIDEO As ToolStripMenuItem Private WithEvents BTT_DOWN_VIDEO As ToolStripMenuItem
Private WithEvents BTT_SHOW_INFO As ToolStripButton Private WithEvents BTT_SHOW_INFO As PersonalUtilities.Forms.Controls.KeyClick.ToolStripButtonKeyClick
Private WithEvents BTT_CHANNELS As ToolStripButton Private WithEvents BTT_CHANNELS As ToolStripButton
Private WithEvents LIST_PROFILES As ListView Private WithEvents LIST_PROFILES As ListView
Private WithEvents MENU_VIEW As ToolStripDropDownButton Private WithEvents MENU_VIEW As ToolStripDropDownButton

5
SCrawler/MainFrame.resx
View File

@@ -183,6 +183,11 @@
<metadata name="Toolbar_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="Toolbar_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>132, 17</value> <value>132, 17</value>
</metadata> </metadata>
<data name="BTT_SHOW_INFO.ToolTipText" xml:space="preserve">
<value>Left-click: open the 'Info' form (show download summary).
Right click: open the 'Missing' form (show information about missing posts).
Ctrl+Shift+Click: open the "User metrics' form (show information about the user's metrics (such as size, number of files, etc.)).</value>
</data>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" /> <assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="MENU_VIEW.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="MENU_VIEW.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>

58
SCrawler/MainFrame.vb
View File

@@ -27,6 +27,7 @@ Public Class MainFrame
Private MyMissingPosts As MissingPostsForm Private MyMissingPosts As MissingPostsForm
Private MyFeed As DownloadFeedForm Private MyFeed As DownloadFeedForm
Private MySearch As UserSearchForm Private MySearch As UserSearchForm
Private MyUserMetrics As UsersInfoForm = Nothing
Private _UFinit As Boolean = True Private _UFinit As Boolean = True
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -57,7 +58,7 @@ Public Class MainFrame
YouTube.MyCache = Settings.Cache YouTube.MyCache = Settings.Cache
YouTube.MyYouTubeSettings = New YouTube.YTSettings_Internal YouTube.MyYouTubeSettings = New YouTube.YTSettings_Internal
UpdateYouTubeSettings() UpdateYouTubeSettings()
MainProgress = New Toolbars.MyProgress(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS, "Downloading profiles' data") With { MainProgress = New MyProgressExt(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS, "Downloading profiles' data") With {
.ResetProgressOnMaximumChanges = False, .Visible = False} .ResetProgressOnMaximumChanges = False, .Visible = False}
Downloader = New TDownloader Downloader = New TDownloader
InfoForm = New DownloadedInfoForm InfoForm = New DownloadedInfoForm
@@ -158,6 +159,7 @@ Public Class MainFrame
VideoDownloader.DisposeIfReady() VideoDownloader.DisposeIfReady()
MySavedPosts.DisposeIfReady() MySavedPosts.DisposeIfReady()
MySearch.DisposeIfReady() MySearch.DisposeIfReady()
MyUserMetrics.DisposeIfReady()
MyView.Dispose(Settings.Design) MyView.Dispose(Settings.Design)
Settings.Dispose() Settings.Dispose()
Else Else
@@ -401,12 +403,17 @@ CloseResume:
End Sub End Sub
#End Region #End Region
#Region "Info, Feed, Channels, Saved posts" #Region "Info, Feed, Channels, Saved posts"
Private Sub BTT_SHOW_INFO_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_SHOW_INFO.MouseDown Private Sub BTT_SHOW_INFO_KeyClick(ByVal Sender As Object, ByVal e As Controls.KeyClick.KeyClickEventArgs) Handles BTT_SHOW_INFO.KeyClick
If e.Button = MouseButtons.Right Then If e.MouseButton = MouseButtons.Right Then
If MyMissingPosts Is Nothing Then MyMissingPosts = New MissingPostsForm If MyMissingPosts Is Nothing Then MyMissingPosts = New MissingPostsForm
If MyMissingPosts.Visible Then MyMissingPosts.BringToFront() Else MyMissingPosts.Show() If MyMissingPosts.Visible Then MyMissingPosts.BringToFront() Else MyMissingPosts.Show()
ElseIf e.Button = MouseButtons.Left Then ElseIf e.MouseButton = MouseButtons.Left Then
InfoForm.FormShow() If e.Control And e.Shift Then
If MyUserMetrics Is Nothing Then MyUserMetrics = New UsersInfoForm
MyUserMetrics.FormShowS
Else
InfoForm.FormShow()
End If
End If End If
End Sub End Sub
Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click
@@ -1206,26 +1213,31 @@ CloseResume:
FocusUser(Key, True) FocusUser(Key, True)
End Sub End Sub
Friend Overloads Sub FocusUser(ByVal Key As String, Optional ByVal ActivateMe As Boolean = False) Friend Overloads Sub FocusUser(ByVal Key As String, Optional ByVal ActivateMe As Boolean = False)
Dim a As Action = Sub() If Not Key.IsEmptyString Then
Dim i% = LIST_PROFILES.Items.IndexOfKey(Key) Dim a As Action = Sub()
If i < 0 Then Dim i% = LIST_PROFILES.Items.IndexOfKey(Key)
Dim u As IUserData = Settings.GetUser(Key, True) If i < 0 Then
If Not u Is Nothing Then Dim u As IUserData = Settings.GetUser(Key, True)
UserListUpdate(u, True) If Not u Is Nothing Then
i = LIST_PROFILES.Items.IndexOfKey(u.Key) i = LIST_PROFILES.Items.IndexOfKey(u.Key)
If i < 0 Then
UserListUpdate(u, True)
i = LIST_PROFILES.Items.IndexOfKey(u.Key)
End If
End If
End If End If
End If If i >= 0 Then
If i >= 0 Then LIST_PROFILES.Select()
LIST_PROFILES.Select() LIST_PROFILES.SelectedIndices.Clear()
LIST_PROFILES.SelectedIndices.Clear() With LIST_PROFILES.Items(i) : .Selected = True : .Focused = True : End With
With LIST_PROFILES.Items(i) : .Selected = True : .Focused = True : End With LIST_PROFILES.EnsureVisible(i)
LIST_PROFILES.EnsureVisible(i) If ActivateMe Then
If ActivateMe Then If Visible Then BringToFront() Else Visible = True
If Visible Then BringToFront() Else Visible = True End If
End If End If
End If End Sub
End Sub If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke
If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke End If
End Sub End Sub
#End Region #End Region
#Region "Toolbar bottom" #Region "Toolbar bottom"

2
SCrawler/MainMod.vb
View File

@@ -90,7 +90,7 @@ Friend Module MainMod
End Sub End Sub
End Class End Class
#End Region #End Region
Friend Property MainProgress As MyProgress Friend Property MainProgress As MyProgressExt
Friend Function GetLviGroupName(ByVal Host As SettingsHost, ByVal IsCollection As Boolean) As ListViewGroup() Friend Function GetLviGroupName(ByVal Host As SettingsHost, ByVal IsCollection As Boolean) As ListViewGroup()
Dim l As New List(Of ListViewGroup) Dim l As New List(Of ListViewGroup)
Dim t$ Dim t$

4
SCrawler/My Project/AssemblyInfo.vb
View File

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

176
SCrawler/MyProgressExt.vb Normal file
View File

@@ -0,0 +1,176 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms.Toolbars
Friend Class PreProgress : Implements IDisposable
Private ReadOnly Progress As MyProgressExt = Nothing
Private ReadOnly ProgressExists As Boolean = False
Private ReadOnly Property Ready As Boolean
Get
Return ProgressExists And Not disposedValue
End Get
End Property
Friend Sub New(ByVal PR As MyProgress)
If Not PR Is Nothing AndAlso TypeOf PR Is MyProgressExt Then
Progress = PR
ProgressExists = True
End If
End Sub
Private _Maximum As Integer = 0
Friend Sub ChangeMax(ByVal Value As Integer, Optional ByVal Add As Boolean = True)
If Ready Then
If Add Then
_Maximum += Value
If Value > 0 Then Progress.Maximum0 += Value
Else
_Maximum = Value
Progress.Maximum0 = Value
End If
End If
End Sub
Private CumulVal As Integer = 0
Friend Sub Perform(Optional ByVal Value As Integer = 1)
If Ready Then
CumulVal += Value
Progress.Perform0(Value)
End If
End Sub
Friend Sub Reset()
_Maximum = 0
CumulVal = 0
End Sub
Friend Sub Done()
If Ready Then
Dim v# = _Maximum - CumulVal
If v > 0 Then
With Progress
If v + .Value0 > .Maximum0 Then v = .Maximum0 - .Value0
If v < 0 Then v = 0
.Perform0(v)
Reset()
End With
End If
End If
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Done()
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
Friend Class MyProgressExt : Inherits MyProgress
Private ReadOnly _Progress0ChangedEventHandlers As List(Of EventHandler(Of ProgressEventArgs))
Friend Custom Event Progress0Changed As EventHandler(Of ProgressEventArgs)
AddHandler(ByVal h As EventHandler(Of ProgressEventArgs))
If Not _Progress0ChangedEventHandlers.Contains(h) Then _Progress0ChangedEventHandlers.Add(h)
End AddHandler
RemoveHandler(ByVal h As EventHandler(Of ProgressEventArgs))
_Progress0ChangedEventHandlers.Remove(h)
End RemoveHandler
RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If _Progress0ChangedEventHandlers.Count > 0 Then
Try
For i% = 0 To _Progress0ChangedEventHandlers.Count - 1
Try : _Progress0ChangedEventHandlers(i).Invoke(Sender, e) : Catch : End Try
Next
Catch
End Try
End If
End RaiseEvent
End Event
Private ReadOnly _Maximum0ChangedEventHandlers As List(Of EventHandler(Of ProgressEventArgs))
Friend Custom Event Maximum0Changed As EventHandler(Of ProgressEventArgs)
AddHandler(ByVal h As EventHandler(Of ProgressEventArgs))
If Not _Maximum0ChangedEventHandlers.Contains(h) Then _Maximum0ChangedEventHandlers.Add(h)
End AddHandler
RemoveHandler(ByVal h As EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers.Remove(h)
End RemoveHandler
RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If _Maximum0ChangedEventHandlers.Count > 0 Then
Try
For i% = 0 To _Maximum0ChangedEventHandlers.Count - 1
Try : _Maximum0ChangedEventHandlers(i).Invoke(Sender, e) : Catch : End Try
Next
Catch
End Try
End If
End RaiseEvent
End Event
Friend Sub New()
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Friend Sub New(ByRef StatusStrip As StatusStrip, ByRef ProgressBar As ToolStripProgressBar, ByRef Label As ToolStripStatusLabel,
Optional ByVal Information As String = Nothing)
MyBase.New(StatusStrip, ProgressBar, Label, Information)
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Friend Sub New(ByRef ProgressBar As ProgressBar, ByRef Label As Label, Optional ByVal Information As String = Nothing)
MyBase.New(ProgressBar, Label, Information)
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Private _Maximum0 As Double = 0
Friend Property Maximum0 As Double
Get
Return _Maximum0
End Get
Set(ByVal v As Double)
Dim b As Boolean = Not _Maximum0 = v
_Maximum0 = v
If ResetProgressOnMaximumChanges Then Value0 = 0
If b Then RaiseEvent Maximum0Changed(Me, Nothing)
End Set
End Property
Friend Property Value0 As Double = 0
Friend Sub Perform0(Optional ByVal Value As Double = 1)
Value0 += Value
If Perform(0, 10, False, False) Then RaiseEvent Progress0Changed(Me, Nothing)
End Sub
Public Overloads Overrides Sub Perform(Optional ByVal Value As Double = 1)
If Perform(Value, PerformMod, True, True) Then OnProgressChanged()
End Sub
Public Overloads Function Perform(ByVal Value As Double, ByVal pm As Integer, ByVal SetText As Boolean, ByVal InvokeProgressChangeHandler As Boolean) As Boolean
Me.Value += Value
If Me.Value < 0 Then Me.Value = 0
Dim v# = Me.Value + Value0
Dim m# = Maximum + Maximum0
If pm = 0 OrElse (v Mod pm) = 0 OrElse v = m Then PerformImpl(GetPercentage(v, m), SetText, InvokeProgressChangeHandler) : Return True
Return False
End Function
Public Overrides Sub Done()
Value0 = Maximum0
MyBase.Done()
End Sub
Public Overrides Sub Reset()
MyBase.Reset()
Value0 = 0
Maximum0 = 0
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then
_Progress0ChangedEventHandlers.Clear()
_Maximum0ChangedEventHandlers.Clear()
End If
MyBase.Dispose(disposing)
End Sub
End Class

8
SCrawler/PluginsEnvironment/Hosts/UserDataHost.vb
View File

@@ -27,6 +27,8 @@ Namespace Plugin.Hosts
UseInternalDownloader = Not ExternalPlugin.GetType.GetCustomAttribute(Of Attributes.UseInternalDownloader)() Is Nothing UseInternalDownloader = Not ExternalPlugin.GetType.GetCustomAttribute(Of Attributes.UseInternalDownloader)() Is Nothing
AddHandler ExternalPlugin.ProgressChanged, AddressOf ExternalPlugin_ProgressChanged AddHandler ExternalPlugin.ProgressChanged, AddressOf ExternalPlugin_ProgressChanged
AddHandler ExternalPlugin.ProgressMaximumChanged, AddressOf ExternalPlugin_ProgressMaximumChanged AddHandler ExternalPlugin.ProgressMaximumChanged, AddressOf ExternalPlugin_ProgressMaximumChanged
AddHandler ExternalPlugin.ProgressPreChanged, AddressOf ExternalPlugin_Progress0Changed
AddHandler ExternalPlugin.ProgressPreMaximumChanged, AddressOf ExternalPlugin_Progress0MaximumChanged
End Sub End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then If Loading Then
@@ -111,6 +113,12 @@ Namespace Plugin.Hosts
Private Sub ExternalPlugin_ProgressMaximumChanged(ByVal Value As Integer, ByVal Add As Boolean) Private Sub ExternalPlugin_ProgressMaximumChanged(ByVal Value As Integer, ByVal Add As Boolean)
Progress.Maximum = Value + If(Add, Progress.Maximum, 0) Progress.Maximum = Value + If(Add, Progress.Maximum, 0)
End Sub End Sub
Private Sub ExternalPlugin_Progress0Changed(ByVal Value As Integer)
ProgressPre.Perform(Value)
End Sub
Private Sub ExternalPlugin_Progress0MaximumChanged(ByVal Value As Integer, ByVal Add As Boolean)
ProgressPre.ChangeMax(Value, Add)
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing And Not disposedValue Then If disposing And Not disposedValue Then
With ExternalPlugin With ExternalPlugin

11
SCrawler/SCrawler.vbproj
View File

@@ -224,6 +224,7 @@
<Compile Include="API\YouTube\SiteSettings.vb" /> <Compile Include="API\YouTube\SiteSettings.vb" />
<Compile Include="API\YouTube\UserData.vb" /> <Compile Include="API\YouTube\UserData.vb" />
<Compile Include="API\YouTube\UserExchangeOptions.vb" /> <Compile Include="API\YouTube\UserExchangeOptions.vb" />
<Compile Include="API\YouTube\YTPreProgress.vb" />
<Compile Include="API\YouTube\YTSettings_Internal.vb" /> <Compile Include="API\YouTube\YTSettings_Internal.vb" />
<Compile Include="Download\ActiveDownloadingProgress.Designer.vb"> <Compile Include="Download\ActiveDownloadingProgress.Designer.vb">
<DependentUpon>ActiveDownloadingProgress.vb</DependentUpon> <DependentUpon>ActiveDownloadingProgress.vb</DependentUpon>
@@ -309,6 +310,12 @@
<Compile Include="Editors\ColorPicker.vb"> <Compile Include="Editors\ColorPicker.vb">
<SubType>UserControl</SubType> <SubType>UserControl</SubType>
</Compile> </Compile>
<Compile Include="Editors\UsersInfoForm.Designer.vb">
<DependentUpon>UsersInfoForm.vb</DependentUpon>
</Compile>
<Compile Include="Editors\UsersInfoForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="GlobalSuppressions.vb" /> <Compile Include="GlobalSuppressions.vb" />
<Compile Include="MainFrameObjects.vb" /> <Compile Include="MainFrameObjects.vb" />
<Compile Include="My Project\Resources.Designer.vb"> <Compile Include="My Project\Resources.Designer.vb">
@@ -316,6 +323,7 @@
<DesignTime>True</DesignTime> <DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon> <DependentUpon>Resources.resx</DependentUpon>
</Compile> </Compile>
<Compile Include="MyProgressExt.vb" />
<Compile Include="PluginsEnvironment\Attributes\Attributes.vb" /> <Compile Include="PluginsEnvironment\Attributes\Attributes.vb" />
<Compile Include="PluginsEnvironment\Hosts\DownloadableMediaHost.vb" /> <Compile Include="PluginsEnvironment\Hosts\DownloadableMediaHost.vb" />
<Compile Include="PluginsEnvironment\Hosts\UserDataHost.vb" /> <Compile Include="PluginsEnvironment\Hosts\UserDataHost.vb" />
@@ -523,6 +531,9 @@
<EmbeddedResource Include="Editors\UserCreatorForm.resx"> <EmbeddedResource Include="Editors\UserCreatorForm.resx">
<DependentUpon>UserCreatorForm.vb</DependentUpon> <DependentUpon>UserCreatorForm.vb</DependentUpon>
</EmbeddedResource> </EmbeddedResource>
<EmbeddedResource Include="Editors\UsersInfoForm.resx">
<DependentUpon>UsersInfoForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="MainFrame.resx"> <EmbeddedResource Include="MainFrame.resx">
<DependentUpon>MainFrame.vb</DependentUpon> <DependentUpon>MainFrame.vb</DependentUpon>
</EmbeddedResource> </EmbeddedResource>

18
SCrawler/SettingsCLS.vb
View File

@@ -140,6 +140,12 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
SearchInDescription = New XMLValue(Of Boolean)("SearchInDescription", False, MyXML, n) SearchInDescription = New XMLValue(Of Boolean)("SearchInDescription", False, MyXML, n)
SearchInLabel = New XMLValue(Of Boolean)("SearchInLabel", False, MyXML, n) SearchInLabel = New XMLValue(Of Boolean)("SearchInLabel", False, MyXML, n)
n = {"Metrics"}
UMetrics_What = New XMLValue(Of Integer)("What", -1, MyXML, n)
UMetrics_Order = New XMLValue(Of Integer)("Order", SortOrder.Descending, MyXML, n)
UMetrics_ShowDrives = New XMLValue(Of Boolean)("ShowDrives", True, MyXML, n)
UMetrics_ShowCollections = New XMLValue(Of Boolean)("ShowCollections", True, MyXML, n)
n = {"Defaults"} n = {"Defaults"}
DefaultTemporary = New XMLValue(Of Boolean)("Temporary", False, MyXML, n) DefaultTemporary = New XMLValue(Of Boolean)("Temporary", False, MyXML, n)
DefaultDownloadImages = New XMLValue(Of Boolean)("DownloadImages", True, MyXML, n) DefaultDownloadImages = New XMLValue(Of Boolean)("DownloadImages", True, MyXML, n)
@@ -310,7 +316,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End Using End Using
Dim NeedUpdate As Boolean = False Dim NeedUpdate As Boolean = False
Dim i%, indx% ', c% Dim i%, indx%
Dim UsersListInitialCount% = UsersList.Count Dim UsersListInitialCount% = UsersList.Count
Dim iUser As UserInfo Dim iUser As UserInfo
Dim userFileExists As Boolean, pluginFound As Boolean Dim userFileExists As Boolean, pluginFound As Boolean
@@ -349,9 +355,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End If End If
'Check paths 'Check paths
'c = IIf((Not .IncludedInCollection Or (.Merged Or .IsVirtual)) And Not .Plugin = PathPlugin.PluginKey, 1, 2) userFileExists = .File.Exists
'URGENT: changed user file validation
userFileExists = .File.Exists ' SFile.GetPath(.File.CutPath(c - 1).Path).Exists(SFO.Path, False)
If Not pluginFound Or Not userFileExists Then If Not pluginFound Or Not userFileExists Then
If Not .IsProtected Then If Not .IsProtected Then
If userFileExists Then If userFileExists Then
@@ -705,6 +709,12 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property STDownloader_RemoveYTVideosOnClear As XMLValue(Of Boolean) Friend ReadOnly Property STDownloader_RemoveYTVideosOnClear As XMLValue(Of Boolean)
Friend ReadOnly Property STDownloader_LoadYTVideos As XMLValue(Of Boolean) Friend ReadOnly Property STDownloader_LoadYTVideos As XMLValue(Of Boolean)
#End Region #End Region
#Region "User metrics"
Friend ReadOnly Property UMetrics_What As XMLValue(Of Integer)
Friend ReadOnly Property UMetrics_Order As XMLValue(Of Integer)
Friend ReadOnly Property UMetrics_ShowDrives As XMLValue(Of Boolean)
Friend ReadOnly Property UMetrics_ShowCollections As XMLValue(Of Boolean)
#End Region
#Region "User data" #Region "User data"
Friend ReadOnly Property FromChannelDownloadTop As XMLValue(Of Integer) Friend ReadOnly Property FromChannelDownloadTop As XMLValue(Of Integer)
Friend ReadOnly Property FromChannelDownloadTopUse As XMLValue(Of Boolean) Friend ReadOnly Property FromChannelDownloadTopUse As XMLValue(Of Boolean)