Compare commits
2 Commits
2022.10.18
...
2022.11.16
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
bdc7321331 | ||
|
|
7d169acebc |
1
.gitignore
vendored
@@ -34,6 +34,7 @@ bld/
|
||||
[Ll]og/
|
||||
[Ll]ogs/
|
||||
ffmpeg/
|
||||
cURL/
|
||||
Info/
|
||||
Hidden/
|
||||
|
||||
|
||||
53
Changelog.md
@@ -1,3 +1,56 @@
|
||||
# 2022.11.16.0
|
||||
|
||||
*2022-11-16*
|
||||
|
||||
**ATTENTION! This version makes changes to the base SCrawler user configuration file. Since you started using this version, you still can downgrade. BUT! Once you add a virtual collection or a virtual user to a collection, you won't be able to downgrade without losing data.**
|
||||
|
||||
- Added
|
||||
- **PornHub**
|
||||
- **XHamster**
|
||||
- An ability to download saved XVIDEOS posts
|
||||
- Download indicator. While downloading, the rainbow tray icon changed to a blue arrow.
|
||||
- Collections: the ability to edit a collection using a form
|
||||
- Collections: the ability to create a **`virtual collection`** and add a **`virtual user`** to a real collection
|
||||
- Collections: an easier way to added users to a collection
|
||||
- Collections: an easier way to create collections
|
||||
- Added icons for channels form context menu buttons
|
||||
- More convenient change of user labels from the context menu of the user list
|
||||
- Notifications: complete transition from default notifications to ToastNotifications
|
||||
- Notifications: when you click on the notification that some of the channels are downloaded, the channels form opens
|
||||
- Notifications: when you click on the notification that all users are downloaded, the main window form opens
|
||||
- Notifications: when you click on the notification that the saved posts are downloaded, the saved posts form opens
|
||||
- Import users
|
||||
- Minor improvements
|
||||
- Plugins
|
||||
- Added
|
||||
- `TaskGroup` attribute
|
||||
- `IUserMedia` interface
|
||||
- Changed
|
||||
- `GetUserUrl` and `GetUserPostUrl` functions: `String UserName` and `String UserID` changed to ` IPluginContentProvider User`
|
||||
- Fixed
|
||||
- Collections editor: new added collections are still not added to the top of the collections list
|
||||
- Users search form doesn't remember last size
|
||||
- Minor bugs
|
||||
|
||||
# 2022.10.23.0
|
||||
|
||||
*2022-10-23*
|
||||
|
||||
- Added
|
||||
- RedGifs token Auto-Renewal
|
||||
- Download groups: ability to select sites
|
||||
- Download groups: ability to exclude labels and sites
|
||||
- AutoDownloader: ability to exclude labels and sites in ```All```, ```Default``` and ```Specified``` modes
|
||||
- The ```Download All``` button turns blue when pause is enabled
|
||||
- Updated Twitter status codes
|
||||
- Minor improvements
|
||||
- Fixed
|
||||
- Updated Twitter status codes
|
||||
- AutoDownloader: incorrect next run date in scheduler task information
|
||||
- AutoDownloader: minor bugs
|
||||
- (Issue #69) **RedGifs data is not downloading**. Requires token.
|
||||
- Minor bugs
|
||||
|
||||
# 2022.10.18.0
|
||||
|
||||
*2022-10-18*
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
Your support is very valuable to me. Any support is greatly appreciated. Your support encourages me to make new features, update the program, add new sites, etc.
|
||||
|
||||
You can support the program by:
|
||||
- **Bitcoin**: bitcoin:BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
|
||||
- **Bitcoin**: BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
|
||||
- :heavy_dollar_sign: make a donation on this site: https://ko-fi.com/andyprogram
|
||||
- :repeat: make a post about my program on your profile (Reddit, Twitter, Instagram and any other social networks)
|
||||
- :speech_balloon: tell your friends about the program
|
||||
|
||||
|
Before Width: | Height: | Size: 7.4 KiB After Width: | Height: | Size: 9.2 KiB |
|
Before Width: | Height: | Size: 7.7 KiB After Width: | Height: | Size: 14 KiB |
|
Before Width: | Height: | Size: 16 KiB After Width: | Height: | Size: 18 KiB |
BIN
ProgramScreenshots/SettingsSitePornHub.png
Normal file
|
After Width: | Height: | Size: 16 KiB |
|
Before Width: | Height: | Size: 14 KiB After Width: | Height: | Size: 14 KiB |
BIN
ProgramScreenshots/SettingsSiteXHamster.png
Normal file
|
After Width: | Height: | Size: 14 KiB |
|
Before Width: | Height: | Size: 14 KiB After Width: | Height: | Size: 15 KiB |
@@ -68,7 +68,7 @@ https://github.com/RipMeApp/ripme
|
||||
| **Free options** | The program is completely free | The program is completely free, but site limits are not declared |
|
||||
| Operating Systems | Windows 10+ | Windows, MacOS, Linux |
|
||||
| Select want content type to download | Yes | Yes |
|
||||
| Suported sites | 6 internal and any site using plugins | 86+ sites (declared) |
|
||||
| Suported sites | 9 internal and any site using plugins | 86+ sites (declared) |
|
||||
| Other sites support | **Yes** | No |
|
||||
| Still supported | **Yes** | **No (last release date May 4, 2021)** |
|
||||
|
||||
|
||||
19
README.md
@@ -6,7 +6,7 @@
|
||||
[](https://github.com/AAndyProgram/SCrawler/wiki)
|
||||
[](HowToSupport.md)
|
||||
|
||||
A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram, TikTok, RedGifs, XVIDEOS, LPSG).
|
||||
A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram, TikTok, RedGifs, PornHub, XHamster, XVIDEOS, LPSG).
|
||||
|
||||
**If you like SCrawler, please like the program on [this site]( https://alternativeto.net/software/scrawler/about/)**
|
||||
|
||||
@@ -14,20 +14,23 @@ Do you like this program? Consider adding to my coffee fund by making a donation
|
||||
|
||||
[](https://ko-fi.com/andyprogram)
|
||||
|
||||
**Bitcoin**: bitcoin:BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
|
||||
**Bitcoin**: BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
|
||||
|
||||

|
||||

|
||||
|
||||
# What can program do:
|
||||
- Download pictures and videos from users' profiles and subreddits:
|
||||
- Reddit images, galleries of images, videos (downloading Reddit hosted video is going through ffmpeg (**ffmpeg only works with the x64 program**));
|
||||
- Reddit images, galleries of images, videos (downloading Reddit hosted video is going through ffmpeg (**ffmpeg only works with the x64 program**)), saved posts;
|
||||
- Redgifs videos (https://www.redgifs.com/);
|
||||
- Twitter images and videos;
|
||||
- Instagram images and videos, tagged posts, stories;
|
||||
- Twitter images and videos, saved (bookmarked) posts;
|
||||
- Instagram images and videos, tagged posts, stories, saved posts;
|
||||
- TikTok videos ([limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits));
|
||||
- Imgur images, galleries and videos;
|
||||
- Gfycat videos;
|
||||
- PornHub images, videos, save (liked) posts;
|
||||
- XHamster images, videos, saved posts;
|
||||
- XVIDEOS videos;
|
||||
- [Other](#supported-sites) supported sites
|
||||
- Parse [channel and view data](https://github.com/AAndyProgram/SCrawler/wiki/Channels)
|
||||
- Download [saved Reddit, Twitter and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
|
||||
@@ -57,7 +60,9 @@ Do you like this program? Consider adding to my coffee fund by making a donation
|
||||
- Imgur
|
||||
- Gfycat
|
||||
- LPSG
|
||||
- XVIDEOS
|
||||
- **PornHub**
|
||||
- **XHamster**
|
||||
- **XVIDEOS**
|
||||
- [Other sites](Plugins.md)
|
||||
|
||||
**[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
|
||||
@@ -105,6 +110,8 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
|
||||
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
|
||||
- [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
|
||||
- [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs)
|
||||
- [PornHub](https://github.com/AAndyProgram/SCrawler/wiki/Settings#pornhub)
|
||||
- [XHamster](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xhamster)
|
||||
- [XVIDEOS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xvideos)
|
||||
- [LPSG](https://github.com/AAndyProgram/SCrawler/wiki/Settings#lpsg)
|
||||
|
||||
|
||||
@@ -53,6 +53,9 @@ Namespace Plugin.Attributes
|
||||
ElementName = XMLElementName
|
||||
End Sub
|
||||
End Class
|
||||
''' <summary>Attribute to disable some properties for host use</summary>
|
||||
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DoNotUse : Inherits Attribute
|
||||
End Class
|
||||
''' <summary>Special property updater</summary>
|
||||
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute
|
||||
Public ReadOnly Name As String
|
||||
@@ -129,13 +132,26 @@ Namespace Plugin.Attributes
|
||||
''' Predefined task counter.<br/>
|
||||
''' <see cref="TaskCounter"/> will take precedence if it is defined.
|
||||
''' </param>
|
||||
Public Sub New(Optional ByVal JobsCount As Integer = -1)
|
||||
TasksCount = JobsCount
|
||||
Public Sub New(Optional ByVal TasksCount As Integer = -1)
|
||||
Me.TasksCount = TasksCount
|
||||
End Sub
|
||||
End Class
|
||||
''' <summary>A property attribute that specifies how many users should be downloaded at the same time in one thread</summary>
|
||||
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class TaskCounter : Inherits Attribute
|
||||
End Class
|
||||
''' <remarks>
|
||||
''' This attribute cannot be combined with <see cref="SeparatedTasks"/>.
|
||||
''' If set to <see cref="SeparatedTasks"/>, this attribute will be ignored
|
||||
''' </remarks>
|
||||
''' <inheritdoc cref="SeparatedTasks"/>
|
||||
<AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class TaskGroup : Inherits Attribute
|
||||
Public ReadOnly Name As String
|
||||
''' <summary>Initialize a new TaskGroup attribute.</summary>
|
||||
''' <param name="Name">Group name</param>
|
||||
Public Sub New(ByVal Name As String)
|
||||
Me.Name = Name
|
||||
End Sub
|
||||
End Class
|
||||
''' <summary>This attribute indicates that the plugin has a SavedPosts environment</summary>
|
||||
<AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class SavedPosts : Inherits Attribute
|
||||
End Class
|
||||
|
||||
@@ -17,9 +17,9 @@ Namespace Plugin
|
||||
Property ID As String
|
||||
Property ParseUserMediaOnly As Boolean
|
||||
Property UserDescription As String
|
||||
Property ExistingContentList As List(Of PluginUserMedia)
|
||||
Property ExistingContentList As List(Of IUserMedia)
|
||||
Property TempPostsList As List(Of String)
|
||||
Property TempMediaList As List(Of PluginUserMedia)
|
||||
Property TempMediaList As List(Of IUserMedia)
|
||||
Property UserExists As Boolean
|
||||
Property UserSuspended As Boolean
|
||||
Property IsSavedPosts As Boolean
|
||||
|
||||
@@ -18,12 +18,12 @@ Namespace Plugin
|
||||
ReadOnly Property Image As Image
|
||||
ReadOnly Property Site As String
|
||||
Property Logger As ILogProvider
|
||||
Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String
|
||||
Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
|
||||
Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
|
||||
Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
|
||||
Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
|
||||
Function GetInstance(ByVal What As Download) As IPluginContentProvider
|
||||
Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
|
||||
Function GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) As String
|
||||
#Region "XML Support"
|
||||
Sub Load(ByVal XMLValues As IEnumerable(Of KeyValuePair(Of String, String)))
|
||||
#End Region
|
||||
|
||||
@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
|
||||
' by using the '*' as shown below:
|
||||
' <Assembly: AssemblyVersion("1.0.*")>
|
||||
|
||||
<Assembly: AssemblyVersion("2022.10.18.0")>
|
||||
<Assembly: AssemblyFileVersion("2022.10.18.0")>
|
||||
<Assembly: AssemblyVersion("2022.11.16.0")>
|
||||
<Assembly: AssemblyFileVersion("2022.11.16.0")>
|
||||
<Assembly: NeutralResourcesLanguage("en")>
|
||||
|
||||
@@ -7,25 +7,44 @@
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Namespace Plugin
|
||||
Public Structure PluginUserMedia
|
||||
Enum Types As Integer
|
||||
Undefined = 0
|
||||
[Picture] = 1
|
||||
[Video] = 2
|
||||
[Text] = 3
|
||||
VideoPre = 10
|
||||
GIF = 50
|
||||
m3u8 = 100
|
||||
End Enum
|
||||
Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : Missing = 4 : End Enum
|
||||
Public ContentType As Integer
|
||||
Public URL As String
|
||||
Public MD5 As String
|
||||
Public File As String
|
||||
Public DownloadState As Integer
|
||||
Public PostID As String
|
||||
Public PostDate As Date?
|
||||
Public SpecialFolder As String
|
||||
Public Attempts As Integer
|
||||
Public Enum UserMediaTypes As Integer
|
||||
Undefined = 0
|
||||
[Picture] = 1
|
||||
[Video] = 2
|
||||
[Text] = 3
|
||||
VideoPre = 10
|
||||
GIF = 50
|
||||
m3u8 = 100
|
||||
End Enum
|
||||
Public Enum UserMediaStates As Integer
|
||||
Unknown = 0
|
||||
Tried = 1
|
||||
Downloaded = 2
|
||||
Skipped = 3
|
||||
Missing = 4
|
||||
End Enum
|
||||
Public Structure PluginUserMedia : Implements IUserMedia
|
||||
Public Property ContentType As Integer Implements IUserMedia.ContentType
|
||||
Public Property URL As String Implements IUserMedia.URL
|
||||
Public Property URL_BASE As String Implements IUserMedia.URL_BASE
|
||||
Public Property MD5 As String Implements IUserMedia.MD5
|
||||
Public Property File As String Implements IUserMedia.File
|
||||
Public Property DownloadState As Integer Implements IUserMedia.DownloadState
|
||||
Public Property PostID As String Implements IUserMedia.PostID
|
||||
Public Property PostDate As Date? Implements IUserMedia.PostDate
|
||||
Public Property SpecialFolder As String Implements IUserMedia.SpecialFolder
|
||||
Public Property Attempts As Integer Implements IUserMedia.Attempts
|
||||
End Structure
|
||||
Public Interface IUserMedia
|
||||
Property ContentType As Integer
|
||||
Property URL As String
|
||||
Property URL_BASE As String
|
||||
Property MD5 As String
|
||||
Property File As String
|
||||
Property DownloadState As Integer
|
||||
Property PostID As String
|
||||
Property PostDate As Date?
|
||||
Property SpecialFolder As String
|
||||
Property Attempts As Integer
|
||||
End Interface
|
||||
End Namespace
|
||||
64
SCrawler/API/Base/M3U8Base.vb
Normal file
@@ -0,0 +1,64 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace API.Base
|
||||
Namespace M3U8Declarations
|
||||
Friend Module M3U8Defaults
|
||||
Friend ReadOnly TsFilesRegEx As RParams = RParams.DM(".+?\.ts[^\r\n]*", 0, RegexReturn.List)
|
||||
End Module
|
||||
End Namespace
|
||||
Friend NotInheritable Class M3U8Base
|
||||
Private Sub New()
|
||||
End Sub
|
||||
Friend Shared Function CreateUrl(ByVal Appender As String, ByVal File As String) As String
|
||||
File = File.StringTrimStart("/")
|
||||
If File.StartsWith("http") Then
|
||||
Return File
|
||||
Else
|
||||
If File.StartsWith("hls/") And Appender.Contains("hls/") Then _
|
||||
Appender = LinkFormatterSecure(Appender.Replace("https://", String.Empty).Split("/").First)
|
||||
Return $"{Appender.StringTrimEnd("/")}/{File}"
|
||||
End If
|
||||
End Function
|
||||
Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Response = Nothing) As SFile
|
||||
Dim CachePath As SFile = Nothing
|
||||
Try
|
||||
If URLs.ListExists Then
|
||||
Dim ConcatFile As SFile = DestinationFile
|
||||
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
|
||||
ConcatFile.Extension = "mp4"
|
||||
CachePath = $"{DestinationFile.PathWithSeparator}_Cache\{SFile.GetDirectories($"{DestinationFile.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\"
|
||||
If CachePath.Exists(SFO.Path) Then
|
||||
Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General})
|
||||
ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ReturnValue)
|
||||
Dim i%
|
||||
Dim eFiles As New List(Of SFile)
|
||||
Dim dFile As SFile = CachePath
|
||||
dFile.Extension = "ts"
|
||||
Using w As New DownloadObjects.WebClient2(Responser)
|
||||
For i = 0 To URLs.Count - 1
|
||||
dFile.Name = $"ConPart_{i}"
|
||||
w.DownloadFile(URLs(i), dFile)
|
||||
eFiles.Add(dFile)
|
||||
Next
|
||||
End Using
|
||||
DestinationFile = FFMPEG.ConcatenateFiles(eFiles, Settings.FfmpegFile, ConcatFile, p, EDP.ThrowException)
|
||||
eFiles.Clear()
|
||||
Return DestinationFile
|
||||
End If
|
||||
End If
|
||||
Return Nothing
|
||||
Finally
|
||||
CachePath.Delete(SFO.Path, SFODelete.None, EDP.None)
|
||||
End Try
|
||||
End Function
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -7,8 +7,8 @@
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Threading
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Imports SCrawler.Plugin.Hosts
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Imports PDownload = SCrawler.Plugin.ISiteSettings.Download
|
||||
Namespace API.Base
|
||||
Friend NotInheritable Class ProfileSaved
|
||||
@@ -52,6 +52,7 @@ Namespace API.Base
|
||||
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Base.ProfileSaved.Download({HOST.Key})]")
|
||||
Finally
|
||||
HOST.DownloadDone(PDownload.SavedPosts)
|
||||
MainFrameObj.UpdateLogButton()
|
||||
End Try
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
@@ -7,7 +7,8 @@
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Cookies
|
||||
Imports SCrawler.Plugin
|
||||
Imports Download = SCrawler.Plugin.ISiteSettings.Download
|
||||
Namespace API.Base
|
||||
@@ -40,6 +41,7 @@ Namespace API.Base
|
||||
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
|
||||
.SaveSettings()
|
||||
End If
|
||||
If .CookiesDomain.IsEmptyString Then .CookiesDomain = CookiesDomain
|
||||
End With
|
||||
End Sub
|
||||
#Region "XML"
|
||||
@@ -74,15 +76,18 @@ Namespace API.Base
|
||||
#Region "User info"
|
||||
Protected UrlPatternUser As String = String.Empty
|
||||
Protected UrlPatternChannel As String = String.Empty
|
||||
Friend Overridable Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String Implements ISiteSettings.GetUserUrl
|
||||
Friend Overridable Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String Implements ISiteSettings.GetUserUrl
|
||||
If Channel Then
|
||||
If Not UrlPatternChannel.IsEmptyString Then Return String.Format(UrlPatternChannel, UserName)
|
||||
If Not UrlPatternChannel.IsEmptyString Then Return String.Format(UrlPatternChannel, User.Name)
|
||||
Else
|
||||
If Not UrlPatternUser.IsEmptyString Then Return String.Format(UrlPatternUser, UserName)
|
||||
If Not UrlPatternUser.IsEmptyString Then Return String.Format(UrlPatternUser, User.Name)
|
||||
End If
|
||||
Return String.Empty
|
||||
End Function
|
||||
Friend Overridable Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Implements ISiteSettings.GetUserPostUrl
|
||||
Private Function ISiteSettings_GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) As String Implements ISiteSettings.GetUserPostUrl
|
||||
Return GetUserPostUrl(User, Media)
|
||||
End Function
|
||||
Friend Overridable Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
|
||||
Return String.Empty
|
||||
End Function
|
||||
Protected UserRegex As RParams = Nothing
|
||||
@@ -94,7 +99,7 @@ Namespace API.Base
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[API.Base.SiteSettingsBase.IsMyUser({UserURL})]")
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[API.Base.SiteSettingsBase.IsMyUser({UserURL})]", New ExchangeOptions)
|
||||
End Try
|
||||
End Function
|
||||
Protected ImageVideoContains As String = String.Empty
|
||||
|
||||
@@ -6,12 +6,13 @@
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports SCrawler.Plugin
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.XML.Base
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Namespace API.Base
|
||||
Friend Module Structures
|
||||
Friend Structure UserMedia : Implements IEquatable(Of UserMedia), IEContainerProvider
|
||||
Friend Structure UserMedia : Implements IUserMedia, IEquatable(Of UserMedia), IEContainerProvider
|
||||
#Region "XML Names"
|
||||
Friend Const Name_MediaNode As String = "MediaData"
|
||||
Private Const Name_MediaType As String = "Type"
|
||||
@@ -48,6 +49,89 @@ Namespace API.Base
|
||||
''' SomeFolder\SomeFolder2
|
||||
''' </summary>
|
||||
Friend SpecialFolder As String
|
||||
Friend [Object] As Object
|
||||
#Region "Interface Support"
|
||||
Private Property IUserMedia_Type As Integer Implements IUserMedia.ContentType
|
||||
Get
|
||||
Return Type
|
||||
End Get
|
||||
Set(ByVal Type As Integer)
|
||||
Me.Type = Type
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_URL_BASE As String Implements IUserMedia.URL_BASE
|
||||
Get
|
||||
Return URL_BASE
|
||||
End Get
|
||||
Set(ByVal URL_BASE As String)
|
||||
Me.URL_BASE = URL_BASE
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_URL As String Implements IUserMedia.URL
|
||||
Get
|
||||
Return URL
|
||||
End Get
|
||||
Set(ByVal URL As String)
|
||||
Me.URL = URL
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_MD5 As String Implements IUserMedia.MD5
|
||||
Get
|
||||
Return MD5
|
||||
End Get
|
||||
Set(ByVal MD5 As String)
|
||||
Me.MD5 = MD5
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_File As String Implements IUserMedia.File
|
||||
Get
|
||||
Return File
|
||||
End Get
|
||||
Set(ByVal File As String)
|
||||
Me.File = File
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_State As Integer Implements IUserMedia.DownloadState
|
||||
Get
|
||||
Return State
|
||||
End Get
|
||||
Set(ByVal State As Integer)
|
||||
Me.State = State
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_PostID As String Implements IUserMedia.PostID
|
||||
Get
|
||||
Return Post.ID
|
||||
End Get
|
||||
Set(ByVal PostID As String)
|
||||
Post.ID = PostID
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
|
||||
Get
|
||||
Return Post.Date
|
||||
End Get
|
||||
Set(ByVal PostDate As Date?)
|
||||
Post.Date = PostDate
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_SpecialFolder As String Implements IUserMedia.SpecialFolder
|
||||
Get
|
||||
Return SpecialFolder
|
||||
End Get
|
||||
Set(ByVal SpecialFolder As String)
|
||||
Me.SpecialFolder = SpecialFolder
|
||||
End Set
|
||||
End Property
|
||||
Private Property IUserMedia_Attempts As Integer Implements IUserMedia.Attempts
|
||||
Get
|
||||
Return Attempts
|
||||
End Get
|
||||
Set(ByVal Attempts As Integer)
|
||||
Me.Attempts = Attempts
|
||||
End Set
|
||||
End Property
|
||||
#End Region
|
||||
Friend Sub New(ByVal URL As String)
|
||||
Me.URL = URL
|
||||
URL_BASE = URL
|
||||
@@ -58,10 +142,10 @@ Namespace API.Base
|
||||
Me.New(URL)
|
||||
Me.Type = Type
|
||||
End Sub
|
||||
Friend Sub New(ByVal m As Plugin.PluginUserMedia)
|
||||
Friend Sub New(ByVal m As Plugin.IUserMedia)
|
||||
[Type] = m.ContentType
|
||||
URL = m.URL
|
||||
URL_BASE = URL
|
||||
URL_BASE = m.URL_BASE
|
||||
MD5 = m.MD5
|
||||
File = m.File
|
||||
Post = New UserPost With {.ID = m.PostID, .[Date] = m.PostDate}
|
||||
@@ -117,19 +201,6 @@ Namespace API.Base
|
||||
Public Overrides Function ToString() As String
|
||||
Return URL
|
||||
End Function
|
||||
Friend Function PluginUserMedia() As Plugin.PluginUserMedia
|
||||
Return New Plugin.PluginUserMedia With {
|
||||
.ContentType = Type,
|
||||
.DownloadState = State,
|
||||
.File = File,
|
||||
.MD5 = MD5,
|
||||
.URL = URL,
|
||||
.SpecialFolder = SpecialFolder,
|
||||
.PostID = Post.ID,
|
||||
.PostDate = Post.Date,
|
||||
.Attempts = Attempts
|
||||
}
|
||||
End Function
|
||||
Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals
|
||||
Return URL = Other.URL
|
||||
End Function
|
||||
@@ -154,17 +225,31 @@ Namespace API.Base
|
||||
''' <summary>Post ID</summary>
|
||||
Friend ID As String
|
||||
Friend [Date] As Date?
|
||||
#Region "Channel compatible fields"
|
||||
Friend UserID As String
|
||||
Friend CachedFile As SFile
|
||||
#Region "Initializers"
|
||||
Public Sub New(ByVal ID As String)
|
||||
Me.ID = ID
|
||||
End Sub
|
||||
Public Sub New(ByVal [Date] As Date?)
|
||||
Me.Date = [Date]
|
||||
End Sub
|
||||
Public Sub New(ByVal ID As String, ByVal [Date] As Date?)
|
||||
Me.ID = ID
|
||||
Me.Date = [Date]
|
||||
End Sub
|
||||
Public Shared Widening Operator CType(ByVal ID As String) As UserPost
|
||||
Return New UserPost(ID)
|
||||
End Operator
|
||||
Public Shared Widening Operator CType(ByVal Post As UserPost) As String
|
||||
Return Post.ID
|
||||
End Operator
|
||||
#End Region
|
||||
Friend Function GetImage(ByVal s As Size, ByVal e As ErrorsDescriber, ByVal NullArg As Image) As Image
|
||||
If Not CachedFile.IsEmptyString Then
|
||||
Return If(PersonalUtilities.Tools.ImageRenderer.GetImage(SFile.GetBytes(CachedFile), s, e), NullArg.Clone)
|
||||
Else
|
||||
Return NullArg.Clone
|
||||
End If
|
||||
#Region "ToString"
|
||||
Public Overrides Function ToString() As String
|
||||
Return ID
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IEquatable, IComparable Support"
|
||||
Friend Overloads Function Equals(ByVal Other As UserPost) As Boolean Implements IEquatable(Of UserPost).Equals
|
||||
Return ID = Other.ID
|
||||
|
||||
@@ -10,7 +10,7 @@ Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports System.IO
|
||||
Imports System.Net
|
||||
Imports System.Threading
|
||||
@@ -94,9 +94,16 @@ Namespace API.Base
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "XML Declarations"
|
||||
Private Const Name_Site As String = "Site"
|
||||
Private Const Name_IsChannel As String = "IsChannel"
|
||||
Private Const Name_UserName As String = "UserName"
|
||||
Private Const Name_Site As String = UserInfo.Name_Site
|
||||
Private Const Name_Plugin As String = UserInfo.Name_Plugin
|
||||
Private Const Name_IsChannel As String = UserInfo.Name_IsChannel
|
||||
Friend Const Name_UserName As String = "UserName"
|
||||
Private Const Name_Model_User As String = UserInfo.Name_Model_User
|
||||
Private Const Name_Model_Collection As String = UserInfo.Name_Model_Collection
|
||||
Private Const Name_Merged As String = UserInfo.Name_Merged
|
||||
Private Const Name_SpecialPath As String = UserInfo.Name_SpecialPath
|
||||
Private Const Name_SpecialCollectionPath As String = UserInfo.Name_SpecialCollectionPath
|
||||
|
||||
Private Const Name_UserExists As String = "UserExists"
|
||||
Private Const Name_UserSuspended As String = "UserSuspended"
|
||||
Private Const Name_FriendlyName As String = "FriendlyName"
|
||||
@@ -108,8 +115,8 @@ Namespace API.Base
|
||||
Private Const Name_CreatedByChannel As String = "CreatedByChannel"
|
||||
|
||||
Private Const Name_SeparateVideoFolder As String = "SeparateVideoFolder"
|
||||
Private Const Name_CollectionName As String = "Collection"
|
||||
Private Const Name_LabelsName As String = "Labels"
|
||||
Private Const Name_CollectionName As String = UserInfo.Name_Collection
|
||||
Friend Const Name_LabelsName As String = "Labels"
|
||||
|
||||
Private Const Name_ReadyForDownload As String = "ReadyForDownload"
|
||||
Private Const Name_DownloadImages As String = "DownloadImages"
|
||||
@@ -122,7 +129,7 @@ Namespace API.Base
|
||||
Private Const Name_ScriptUse As String = "ScriptUse"
|
||||
Private Const Name_ScriptData As String = "ScriptData"
|
||||
|
||||
Private Const Name_DataMerging As String = "DataMerging"
|
||||
<Obsolete("Use 'Name_Merged'", False)> Friend Const Name_DataMerging As String = "DataMerging"
|
||||
#End Region
|
||||
#Region "Declarations"
|
||||
#Region "Host, Site, Progress, Self"
|
||||
@@ -156,6 +163,21 @@ Namespace API.Base
|
||||
End Property
|
||||
Friend Overridable Property ID As String = String.Empty Implements IContentProvider.ID, IPluginContentProvider.ID
|
||||
Friend Overridable Property FriendlyName As String = String.Empty Implements IContentProvider.FriendlyName
|
||||
Friend ReadOnly Property UserModel As UsageModel Implements IUserData.UserModel
|
||||
Get
|
||||
Return User.UserModel
|
||||
End Get
|
||||
End Property
|
||||
Friend Overridable ReadOnly Property CollectionModel As UsageModel Implements IUserData.CollectionModel
|
||||
Get
|
||||
Return User.CollectionModel
|
||||
End Get
|
||||
End Property
|
||||
Friend Overridable ReadOnly Property IsVirtual As Boolean Implements IUserData.IsVirtual
|
||||
Get
|
||||
Return UserModel = UsageModel.Virtual
|
||||
End Get
|
||||
End Property
|
||||
#End Region
|
||||
#Region "Description"
|
||||
Friend Property UserDescription As String = String.Empty Implements IContentProvider.Description, IPluginContentProvider.UserDescription
|
||||
@@ -231,7 +253,7 @@ Namespace API.Base
|
||||
Protected Function GetNullPicture(ByVal MaxHeigh As XML.Base.XMLValue(Of Integer)) As Bitmap
|
||||
Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value)
|
||||
End Function
|
||||
Protected Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True, Optional ByVal GetToast As Boolean = False) As T
|
||||
Friend Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True, Optional ByVal GetToast As Boolean = False) As T
|
||||
Dim rsfile As Boolean = GetType(T) Is GetType(SFile)
|
||||
Dim f As SFile = Nothing
|
||||
Dim p As UserImage = Nothing
|
||||
@@ -335,7 +357,7 @@ BlockNullPicture:
|
||||
Friend Overridable Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
|
||||
Dim u As UserInfo = User
|
||||
u.CollectionName = NewName
|
||||
u.IncludedInCollection = Not NewName.IsEmptyString
|
||||
u.UpdateUserFile()
|
||||
User = u
|
||||
If UpdateSettings Then Settings.UpdateUsersList(User)
|
||||
End Sub
|
||||
@@ -455,7 +477,10 @@ BlockNullPicture:
|
||||
End Property
|
||||
Friend Overridable Function GetUserInformation() As String
|
||||
Dim OutStr$ = $"User: {Name} (site: {Site}"
|
||||
If IncludedInCollection Then OutStr &= $"; collection: {CollectionName}"
|
||||
If IncludedInCollection Then
|
||||
OutStr &= $"; collection: {CollectionName}"
|
||||
If CollectionModel = UsageModel.Default And UserModel = UsageModel.Virtual Then OutStr &= "; virtual"
|
||||
End If
|
||||
OutStr &= ")"
|
||||
OutStr.StringAppendLine($"Labels: {Labels.ListToString}")
|
||||
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
|
||||
@@ -494,9 +519,9 @@ BlockNullPicture:
|
||||
Private Property IPluginContentProvider_Thrower As IThrower Implements IPluginContentProvider.Thrower
|
||||
Private Property IPluginContentProvider_LogProvider As ILogProvider Implements IPluginContentProvider.LogProvider
|
||||
Friend Property ExternalPlugin As IPluginContentProvider
|
||||
Private Property IPluginContentProvider_ExistingContentList As List(Of PluginUserMedia) Implements IPluginContentProvider.ExistingContentList
|
||||
Private Property IPluginContentProvider_ExistingContentList As List(Of IUserMedia) Implements IPluginContentProvider.ExistingContentList
|
||||
Private Property IPluginContentProvider_TempPostsList As List(Of String) Implements IPluginContentProvider.TempPostsList
|
||||
Private Property IPluginContentProvider_TempMediaList As List(Of PluginUserMedia) Implements IPluginContentProvider.TempMediaList
|
||||
Private Property IPluginContentProvider_TempMediaList As List(Of IUserMedia) Implements IPluginContentProvider.TempMediaList
|
||||
Private Property IPluginContentProvider_SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder
|
||||
Private Property IPluginContentProvider_DataPath As String Implements IPluginContentProvider.DataPath
|
||||
Private Sub IPluginContentProvider_XmlFieldsSet(ByVal Fields As List(Of KeyValuePair(Of String, String))) Implements IPluginContentProvider.XmlFieldsSet
|
||||
@@ -620,7 +645,7 @@ BlockNullPicture:
|
||||
With DirectCast(u, UserDataBase)
|
||||
If Not .User.Plugin.IsEmptyString Then
|
||||
uName = .User.Name
|
||||
Return Settings(.User.Plugin).GetUserPostUrl(.ID, PostData.Post.ID)
|
||||
Return Settings(.User.Plugin).GetUserPostUrl(.Self, PostData)
|
||||
End If
|
||||
End With
|
||||
End If
|
||||
@@ -657,7 +682,13 @@ BlockNullPicture:
|
||||
LastUpdated = AConvert(Of Date)(x.Value(Name_LastUpdated), ADateTime.Formats.BaseDateTime, Nothing)
|
||||
ScriptUse = x.Value(Name_ScriptUse).FromXML(Of Boolean)(False)
|
||||
ScriptData = x.Value(Name_ScriptData)
|
||||
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False)
|
||||
#Disable Warning BC40000
|
||||
If x.Contains(Name_DataMerging) Then
|
||||
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False)
|
||||
Else
|
||||
DataMerging = x.Value(Name_Merged).FromXML(Of Boolean)(False)
|
||||
End If
|
||||
#Enable Warning
|
||||
ChangeCollectionName(x.Value(Name_CollectionName), False)
|
||||
Labels.ListAddList(x.Value(Name_LabelsName).StringToList(Of String, List(Of String))("|", EDP.ReturnValue), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
LoadUserInformation_OptionalFields(x, True)
|
||||
@@ -675,7 +706,13 @@ BlockNullPicture:
|
||||
MyFile.Exists(SFO.Path)
|
||||
Using x As New XmlFile With {.Name = "User"}
|
||||
x.Add(Name_Site, Site)
|
||||
x.Add(Name_Plugin, HOST.Key)
|
||||
x.Add(Name_UserName, User.Name)
|
||||
x.Add(Name_IsChannel, IsChannel.BoolToInteger)
|
||||
x.Add(Name_Model_User, CInt(UserModel))
|
||||
x.Add(Name_Model_Collection, CInt(CollectionModel))
|
||||
x.Add(Name_SpecialPath, User.SpecialPath)
|
||||
x.Add(Name_SpecialCollectionPath, User.SpecialCollectionPath)
|
||||
x.Add(Name_UserExists, UserExists.BoolToInteger)
|
||||
x.Add(Name_UserSuspended, UserSuspended.BoolToInteger)
|
||||
x.Add(Name_UserID, ID)
|
||||
@@ -700,7 +737,7 @@ BlockNullPicture:
|
||||
x.Add(Name_ScriptData, ScriptData)
|
||||
x.Add(Name_CollectionName, CollectionName)
|
||||
x.Add(Name_LabelsName, Labels.ListToString("|", EDP.ReturnValue))
|
||||
x.Add(Name_DataMerging, DataMerging.BoolToInteger)
|
||||
x.Add(Name_Merged, DataMerging.BoolToInteger)
|
||||
|
||||
LoadUserInformation_OptionalFields(x, False)
|
||||
|
||||
@@ -748,7 +785,7 @@ BlockNullPicture:
|
||||
#Region "Open site, folder"
|
||||
Friend Overridable Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Implements IContentProvider.OpenSite
|
||||
Try
|
||||
Dim URL$ = HOST.Source.GetUserUrl(Name, IsChannel)
|
||||
Dim URL$ = HOST.Source.GetUserUrl(Me, IsChannel)
|
||||
If Not URL.IsEmptyString Then Process.Start(URL)
|
||||
Catch ex As Exception
|
||||
If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowAllMsg)
|
||||
@@ -817,6 +854,9 @@ BlockNullPicture:
|
||||
If Not Responser Is Nothing Then Responser.Dispose()
|
||||
Responser = New Response
|
||||
If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
|
||||
'TODO: UserDataBase remove [Responser.DecodersError]
|
||||
Responser.DecodersError = New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue) With {
|
||||
.DeclaredMessage = New MMessage($"SymbolsConverter error: [{ToStringForLog()}]", ToStringForLog())}
|
||||
|
||||
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(Of Image)(False) Is Nothing
|
||||
Dim sEnvir() As Boolean = {UserExists, UserSuspended}
|
||||
@@ -828,6 +868,7 @@ BlockNullPicture:
|
||||
DownloadedVideos(False) = 0
|
||||
_TempMediaList.Clear()
|
||||
_TempPostsList.Clear()
|
||||
LatestData.Clear()
|
||||
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
|
||||
|
||||
LoadContentInformation()
|
||||
@@ -859,7 +900,7 @@ BlockNullPicture:
|
||||
DownloadContent(Token)
|
||||
ThrowIfDisposed()
|
||||
|
||||
LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
|
||||
If IncludeInTheFeed Then LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
|
||||
Dim mcb& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
|
||||
_ContentList.ListAddList(_ContentNew.Where(Function(c) _downContent(c) Or MissingFinder(c)), LNC)
|
||||
Dim mca& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
|
||||
@@ -884,7 +925,7 @@ BlockNullPicture:
|
||||
ThrowIfDisposed()
|
||||
If UpPic Or EnvirChanged.Invoke Then OnUserUpdated()
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
MyMainLOG = $"{Site} - {Name}: downloading canceled"
|
||||
MyMainLOG = $"{ToStringForLog()}: downloading canceled"
|
||||
Canceled = True
|
||||
Catch dex As ObjectDisposedException When Disposed
|
||||
Canceled = True
|
||||
@@ -923,11 +964,7 @@ BlockNullPicture:
|
||||
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
|
||||
End Sub
|
||||
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
Private NotInheritable Class OptionalWebClient : Implements IDisposable
|
||||
Private ReadOnly WC As WebClient
|
||||
Private ReadOnly RC As Response
|
||||
Private ReadOnly RCERROR As New ErrorsDescriber(EDP.ThrowException)
|
||||
Private ReadOnly UseResponserClient As Boolean
|
||||
Private NotInheritable Class OptionalWebClient : Inherits DownloadObjects.WebClient2
|
||||
Friend Sub New(ByRef Source As UserDataBase)
|
||||
UseResponserClient = Source.UseResponserClient
|
||||
If UseResponserClient Then
|
||||
@@ -936,28 +973,6 @@ BlockNullPicture:
|
||||
WC = New WebClient
|
||||
End If
|
||||
End Sub
|
||||
Friend Sub DownloadFile(ByVal URL As String, ByVal File As String)
|
||||
If UseResponserClient Then
|
||||
RC.DownloadFile(URL, File, RCERROR)
|
||||
Else
|
||||
WC.DownloadFile(URL, File)
|
||||
End If
|
||||
End Sub
|
||||
#Region "IDisposable Support"
|
||||
Private disposedValue As Boolean = False
|
||||
Protected Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue And disposing And Not WC Is Nothing Then WC.Dispose()
|
||||
disposedValue = True
|
||||
End Sub
|
||||
Protected Overrides Sub Finalize()
|
||||
Dispose(False)
|
||||
MyBase.Finalize()
|
||||
End Sub
|
||||
Friend Sub Dispose() Implements IDisposable.Dispose
|
||||
Dispose(True)
|
||||
GC.SuppressFinalize(Me)
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
|
||||
Try
|
||||
@@ -976,7 +991,7 @@ BlockNullPicture:
|
||||
Dim v As UserMedia
|
||||
|
||||
Using w As New OptionalWebClient(Me)
|
||||
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
|
||||
If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
|
||||
Progress.Maximum += _ContentNew.Count
|
||||
For i = 0 To _ContentNew.Count - 1
|
||||
ThrowAny(Token)
|
||||
@@ -1065,9 +1080,12 @@ BlockNullPicture:
|
||||
Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
|
||||
Return Nothing
|
||||
End Function
|
||||
Protected Const EXCEPTION_OPERATION_CANCELED As Integer = -1
|
||||
''' <param name="RDE">Request DownloadingException</param>
|
||||
''' <returns>0 - exit</returns>
|
||||
Protected Function ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String, Optional ByVal RDE As Boolean = True, Optional ByVal EObj As Object = Nothing) As Integer
|
||||
Protected Function ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String,
|
||||
Optional ByVal RDE As Boolean = True, Optional ByVal EObj As Object = Nothing,
|
||||
Optional ByVal ThrowEx As Boolean = True) As Integer
|
||||
If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or
|
||||
(TypeOf ex Is ObjectDisposedException And Disposed)) Then
|
||||
If RDE Then
|
||||
@@ -1075,6 +1093,9 @@ BlockNullPicture:
|
||||
If v = 0 Then LogError(ex, Message) : HasError = True
|
||||
Return v
|
||||
End If
|
||||
Else
|
||||
'URGENT: UserDataBase.ProcessException [Throw ex]
|
||||
If ThrowEx Then Throw ex Else Return EXCEPTION_OPERATION_CANCELED
|
||||
End If
|
||||
Return 0
|
||||
End Function
|
||||
@@ -1121,7 +1142,7 @@ BlockNullPicture:
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Delete, Move, Merge, Copy"
|
||||
Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False) As Integer Implements IUserData.Delete
|
||||
Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer Implements IUserData.Delete
|
||||
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
|
||||
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
|
||||
If Not IncludedInCollection Then MainFrameObj.ImageHandler(Me, False)
|
||||
@@ -1135,44 +1156,51 @@ BlockNullPicture:
|
||||
Return 0
|
||||
End If
|
||||
End Function
|
||||
Friend Overridable Function MoveFiles(ByVal __CollectionName As String) As Boolean Implements IUserData.MoveFiles
|
||||
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean Implements IUserData.MoveFiles
|
||||
Dim UserBefore As UserInfo = User
|
||||
Dim Removed As Boolean = True
|
||||
Dim _TurnBack As Boolean = False
|
||||
Try
|
||||
Dim f As SFile
|
||||
Dim v As Boolean = IsVirtual
|
||||
If IncludedInCollection Then
|
||||
Settings.Users.Add(Me)
|
||||
Removed = False
|
||||
User.CollectionName = String.Empty
|
||||
User.IncludedInCollection = False
|
||||
User.SpecialCollectionPath = String.Empty
|
||||
User.UserModel = UsageModel.Default
|
||||
User.CollectionModel = UsageModel.Default
|
||||
Else
|
||||
Settings.Users.Remove(Me)
|
||||
Removed = True
|
||||
User.CollectionName = __CollectionName
|
||||
User.IncludedInCollection = True
|
||||
User.SpecialPath = Nothing
|
||||
User.SpecialCollectionPath = __SpecialCollectionPath
|
||||
If Not IsVirtual Then User.SpecialPath = Nothing
|
||||
End If
|
||||
_TurnBack = True
|
||||
User.UpdateUserFile()
|
||||
f = User.File.CutPath(, EDP.ThrowException)
|
||||
If f.Exists(SFO.Path, False) Then
|
||||
If If(SFile.GetFiles(f,, SearchOption.AllDirectories), New List(Of SFile)).Count > 0 AndAlso
|
||||
MsgBoxE({$"Destination directory [{f.Path}] already exists and contains files!" & vbCr &
|
||||
"By continuing, this directory and all files will be deleted",
|
||||
"Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then
|
||||
MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation)
|
||||
User = UserBefore
|
||||
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
|
||||
_TurnBack = False
|
||||
Return False
|
||||
|
||||
If Not v Then
|
||||
f = User.File.CutPath(, EDP.ThrowException)
|
||||
If f.Exists(SFO.Path, False) Then
|
||||
If If(SFile.GetFiles(f,, SearchOption.AllDirectories), New List(Of SFile)).Count > 0 AndAlso
|
||||
MsgBoxE({$"Destination directory [{f.Path}] already exists and contains files!" & vbCr &
|
||||
"By continuing, this directory and all files will be deleted",
|
||||
"Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then
|
||||
MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation)
|
||||
User = UserBefore
|
||||
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
|
||||
_TurnBack = False
|
||||
Return False
|
||||
End If
|
||||
f.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException)
|
||||
End If
|
||||
f.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException)
|
||||
f.CutPath.Exists(SFO.Path)
|
||||
Directory.Move(UserBefore.File.CutPath(, EDP.ThrowException).Path, f.Path)
|
||||
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
|
||||
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
|
||||
End If
|
||||
f.CutPath.Exists(SFO.Path)
|
||||
Directory.Move(UserBefore.File.CutPath(, EDP.ThrowException).Path, f.Path)
|
||||
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
|
||||
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
|
||||
|
||||
Settings.UsersList.Remove(UserBefore)
|
||||
Settings.UpdateUsersList(User)
|
||||
UpdateUserInformation()
|
||||
@@ -1408,6 +1436,7 @@ BlockNullPicture:
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
#Region "Base interfaces"
|
||||
Friend Interface IContentProvider
|
||||
ReadOnly Property Site As String
|
||||
Property Name As String
|
||||
@@ -1430,6 +1459,9 @@ BlockNullPicture:
|
||||
ReadOnly Property IsCollection As Boolean
|
||||
Property CollectionName As String
|
||||
ReadOnly Property IncludedInCollection As Boolean
|
||||
ReadOnly Property UserModel As UsageModel
|
||||
ReadOnly Property CollectionModel As UsageModel
|
||||
ReadOnly Property IsVirtual As Boolean
|
||||
ReadOnly Property Labels As List(Of String)
|
||||
#End Region
|
||||
ReadOnly Property IsChannel As Boolean
|
||||
@@ -1461,8 +1493,8 @@ BlockNullPicture:
|
||||
''' 2 - Collection removed<br/>
|
||||
''' 3 - Collection split
|
||||
''' </summary>
|
||||
Function Delete(Optional ByVal Multiple As Boolean = False) As Integer
|
||||
Function MoveFiles(ByVal CollectionName As String) As Boolean
|
||||
Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
|
||||
Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile) As Boolean
|
||||
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
|
||||
Sub OpenFolder()
|
||||
ReadOnly Property Self As IUserData
|
||||
@@ -1485,4 +1517,5 @@ BlockNullPicture:
|
||||
Property SkipExistsUsers As Boolean
|
||||
Property SaveToCache As Boolean
|
||||
End Interface
|
||||
#End Region
|
||||
End Namespace
|
||||
86
SCrawler/API/BaseObjects/DomainEnvir.vb
Normal file
@@ -0,0 +1,86 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Forms
|
||||
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
|
||||
Namespace API.BaseObjects
|
||||
Friend Interface IDomainContainer
|
||||
ReadOnly Property Icon As Icon
|
||||
ReadOnly Property Site As String
|
||||
ReadOnly Property Domains As List(Of String)
|
||||
ReadOnly Property DomainsTemp As List(Of String)
|
||||
ReadOnly Property DomainsDefault As String
|
||||
ReadOnly Property DomainsSettingProp As Plugin.PropertyValue
|
||||
Property DomainsChanged As Boolean
|
||||
Property Initialized As Boolean
|
||||
Property DomainsUpdateInProgress As Boolean
|
||||
Property DomainsUpdatedBySite As Boolean
|
||||
Sub UpdateDomains()
|
||||
End Interface
|
||||
Friend NotInheritable Class DomainContainer
|
||||
Private Sub New()
|
||||
End Sub
|
||||
Friend Shared Sub EndInit(ByVal s As IDomainContainer)
|
||||
If ACheck(s.DomainsSettingProp.Value) Then s.Domains.ListAddList(CStr(s.DomainsSettingProp.Value).Split("|"), LAP.NotContainsOnly)
|
||||
End Sub
|
||||
Friend Overloads Shared Sub UpdateDomains(ByVal s As IDomainContainer)
|
||||
UpdateDomains(s, Nothing, True)
|
||||
End Sub
|
||||
Friend Overloads Shared Sub UpdateDomains(ByVal s As IDomainContainer, ByVal NewDomains As IEnumerable(Of String), ByVal Internal As Boolean)
|
||||
With s
|
||||
If Not .Initialized Or (.DomainsUpdatedBySite And Not Internal) Then Exit Sub
|
||||
If Not .DomainsUpdateInProgress Then
|
||||
.DomainsUpdateInProgress = True
|
||||
.Domains.ListAddList(.DomainsDefault.Split("|"), LAP.NotContainsOnly)
|
||||
.Domains.ListAddList(NewDomains, LAP.NotContainsOnly)
|
||||
.DomainsSettingProp.Value = .Domains.ListToString("|")
|
||||
If Not Internal Then .DomainsUpdatedBySite = True
|
||||
.DomainsUpdateInProgress = False
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
Friend Shared Sub Update(ByVal s As IDomainContainer)
|
||||
With s
|
||||
If .DomainsChanged Then
|
||||
.Domains.Clear()
|
||||
.Domains.ListAddList(.DomainsTemp, LAP.NotContainsOnly)
|
||||
.UpdateDomains()
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
Friend Shared Sub EndEdit(ByVal s As IDomainContainer)
|
||||
s.DomainsTemp.ListAddList(s.Domains, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
|
||||
s.DomainsChanged = False
|
||||
End Sub
|
||||
Friend Shared Sub OpenSettingsForm(ByVal s As IDomainContainer)
|
||||
Dim __add As EventHandler(Of SimpleListFormEventArgs) = Sub(sender, e) e.ValueNew = InputBoxE($"Enter a new domain using the pattern [{s.Site}.com]:", "New domain").IfNullOrEmptyE(Nothing)
|
||||
Dim __delete As EventHandler(Of SimpleListFormEventArgs) = Sub(sender, e)
|
||||
Dim n$ = AConvert(Of String)(e.ValueCurrent, AModes.Var, String.Empty)
|
||||
e.Result = MsgBoxE({$"Are you sure you want to delete the [{n}] domain?",
|
||||
"Removing domains"}, vbYesNo) = vbYes
|
||||
End Sub
|
||||
Using f As New SimpleListForm(Of String)(If(s.DomainsChanged, s.DomainsTemp, s.Domains), Settings.Design) With {
|
||||
.Buttons = {ADB.Add, ADB.Delete},
|
||||
.Mode = SimpleListFormModes.Remaining,
|
||||
.FormText = s.Site,
|
||||
.Icon = s.Icon,
|
||||
.LocationOnly = True,
|
||||
.Size = New Size(400, 330),
|
||||
.DesignXMLNode = s.Site
|
||||
}
|
||||
AddHandler f.AddClick, __add
|
||||
AddHandler f.DeleteClick, __delete
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then
|
||||
s.DomainsChanged = True
|
||||
s.DomainsTemp.ListAddList(f.DataResult, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
|
||||
End If
|
||||
End Using
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -11,7 +11,7 @@ Imports SCrawler.API.Base
|
||||
Imports SCrawler.API.Imgur.Declarations
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Namespace API.Imgur
|
||||
Namespace Declarations
|
||||
Friend Module Imgur_Declarations
|
||||
|
||||
@@ -89,7 +89,7 @@ Namespace API.Instagram
|
||||
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=False), ControlNumber(4)>
|
||||
Friend Property IG_WWW_CLAIM As PropertyValue
|
||||
Private Const SavedPostsUserName_Text As String = "Saved posts user"
|
||||
<PropertyOption(ControlText:=SavedPostsUserName_Text, IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
|
||||
<PropertyOption(ControlText:=SavedPostsUserName_Text, ControlToolTip:="Personal profile username", IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
|
||||
Friend ReadOnly Property SavedPostsUserName As PropertyValue
|
||||
Friend Overrides Function BaseAuthExists() As Boolean
|
||||
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
|
||||
@@ -106,8 +106,8 @@ Namespace API.Instagram
|
||||
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
|
||||
End Select
|
||||
If Not f.IsEmptyString Then
|
||||
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
|
||||
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
|
||||
Responser.HeadersRemove(f)
|
||||
If Not CStr(Value).IsEmptyString Then Responser.HeadersAdd(f, CStr(Value))
|
||||
Responser.SaveSettings()
|
||||
End If
|
||||
End If
|
||||
@@ -202,11 +202,9 @@ Namespace API.Instagram
|
||||
|
||||
With Responser
|
||||
If .Headers.Count > 0 Then
|
||||
With .Headers
|
||||
If .ContainsKey(Header_CSRF_TOKEN) Then token = .Item(Header_CSRF_TOKEN)
|
||||
If .ContainsKey(Header_IG_APP_ID) Then app_id = .Item(Header_IG_APP_ID)
|
||||
If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM)
|
||||
End With
|
||||
token = .HeadersValue(Header_CSRF_TOKEN)
|
||||
app_id = .HeadersValue(Header_IG_APP_ID)
|
||||
www_claim = .HeadersValue(Header_IG_WWW_CLAIM)
|
||||
End If
|
||||
If Not .Cookies Is Nothing Then
|
||||
.Cookies.ChangedAllowInternalDrop = False
|
||||
@@ -263,10 +261,10 @@ Namespace API.Instagram
|
||||
With Source
|
||||
Hash = AConvert(Of String)(.Hash.Value, String.Empty)
|
||||
Hash2 = AConvert(Of String)(.HashSavedPosts.Value, String.Empty)
|
||||
With .Responser.Headers
|
||||
If .ContainsKey(Header_CSRF_TOKEN) Then Token = .Item(Header_CSRF_TOKEN)
|
||||
If .ContainsKey(Header_IG_APP_ID) Then AppID = .Item(Header_IG_APP_ID)
|
||||
If .ContainsKey(Header_IG_WWW_CLAIM) Then WwwClaim = .Item(Header_IG_WWW_CLAIM)
|
||||
With .Responser
|
||||
Token = .HeadersValue(Header_CSRF_TOKEN)
|
||||
AppID = .HeadersValue(Header_IG_APP_ID)
|
||||
WwwClaim = .HeadersValue(Header_IG_WWW_CLAIM)
|
||||
End With
|
||||
End With
|
||||
End Sub
|
||||
|
||||
@@ -11,8 +11,8 @@ Imports System.Threading
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.Messaging
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports SCrawler.API.Base
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Namespace API.Instagram
|
||||
@@ -510,6 +510,7 @@ Namespace API.Instagram
|
||||
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
|
||||
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
|
||||
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
|
||||
If Not DateObj.IsEmptyString Then Return DateObj
|
||||
If elem.Contains("taken_at") Then
|
||||
Return elem.Value("taken_at")
|
||||
ElseIf elem.Contains("imported_taken_at") Then
|
||||
@@ -518,7 +519,7 @@ Namespace API.Instagram
|
||||
Dim ev$ = elem.Value("device_timestamp")
|
||||
If Not ev.IsEmptyString Then
|
||||
If ev.Length > 10 Then
|
||||
Return elem.Value("device_timestamp").Substring(0, 10)
|
||||
Return ev.Substring(0, 10)
|
||||
Else
|
||||
Return ev
|
||||
End If
|
||||
@@ -702,7 +703,7 @@ Namespace API.Instagram
|
||||
UserExists = False
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
|
||||
HasError = True
|
||||
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
|
||||
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
|
||||
DisableSection(s)
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
|
||||
Return 3
|
||||
|
||||
@@ -10,6 +10,7 @@ Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Imports Converters = PersonalUtilities.Functions.SymbolsConverter.Converters
|
||||
Namespace API.LPSG
|
||||
@@ -27,7 +28,7 @@ Namespace API.LPSG
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
Responser.Error = EDP.ThrowException
|
||||
Responser.DeclaredError = EDP.ThrowException
|
||||
|
||||
Dim NextPage$
|
||||
Dim r$
|
||||
@@ -87,7 +88,7 @@ Namespace API.LPSG
|
||||
End If
|
||||
End Sub
|
||||
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
With Responser : .UseWebClient = True : .UseWebClientCookies = True : .ResetError() : End With
|
||||
With Responser : .Mode = Response.Modes.WebClient : .ResetStatus() : End With
|
||||
UseResponserClient = True
|
||||
DownloadContentDefault(Token)
|
||||
End Sub
|
||||
|
||||
44
SCrawler/API/PornHub/Declarations.vb
Normal file
@@ -0,0 +1,44 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Namespace API.PornHub
|
||||
Friend Module Declarations
|
||||
#Region "Converters"
|
||||
Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue)
|
||||
Friend ReadOnly HtmlConverter As Func(Of String, String) = Function(Input) SymbolsConverter.HTML.Decode(Input, EDP.ReturnValue)
|
||||
#End Region
|
||||
#Region "Declarations video"
|
||||
Friend ReadOnly RegexVideo_FlashVarsBlock As RParams = RParams.DM("(?<=flashvars_\['[nN]ext[vV]ideo'\];[\r\n]*?)(.+?)(?=;flashvars_\d+?)", 0, EDP.ReturnValue)
|
||||
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)
|
||||
Friend ReadOnly RegexVideo_FlashVars_Compiler As RParams = RParams.DM("(?<=\*/)([\w\d\S]{10,})", 0, RegexReturn.List)
|
||||
Friend ReadOnly RegexVideo_Video_All As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""",
|
||||
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
|
||||
Friend ReadOnly RegexVideo_Video_Wrong As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?(?=\<div class=""videoUploaderBlock)",
|
||||
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
|
||||
Private ReadOnly RegexVideo_Video_Wrong_Option As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?", 0, RegexReturn.ListByMatch)
|
||||
Friend ReadOnly RegexVideo_Video_Wrong_Fields As RField() = {New RField(New RFieldOption(1, RegexVideo_Video_Wrong_Option)), New RField(New RFieldOption(2, RegexVideo_Video_Wrong_Option))}
|
||||
Friend ReadOnly RegexVideo_Video_VideoKey As RParams = RParams.DMS("viewkey=([\w\d]+)", 1, EDP.ReturnValue)
|
||||
#End Region
|
||||
#Region "Declarations M3U8"
|
||||
Friend ReadOnly Regex_M3U8_FirstFileRegEx As RParams = RParams.DM(".+?m3u8.*", 0)
|
||||
Friend ReadOnly Regex_M3U8_FileUrl As RParams = RParams.DMS("((https://([^/]+)/.+?)([^/]+?m3u8))(.*)", 2, EDP.ReturnValue)
|
||||
#End Region
|
||||
#Region "Declarations GIF"
|
||||
Friend ReadOnly Regex_Gif_Array As RParams = RParams.DM("\<li id=""(gif\d+)"" class=""gifLi.gifVideoBlock""\>", 0, RegexReturn.List, EDP.ReturnValue)
|
||||
Friend ReadOnly Regex_Gif_UrlName As RParams = RParams.DMS("""name"":.*?""([^""]*)""[^\}]+?""contentUrl"":.*?""([^""]+)""", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
|
||||
#End Region
|
||||
#Region "Declarations photo"
|
||||
Friend ReadOnly Regex_Photo_ModelHub_PhotoBlocks As RParams = RParams.DM("var PHOTOS_ARRAY_(\d+) = \{[\r\n\s]*?(urls:.*?\[[^]]*\])", 0, RegexReturn.List, EDP.ReturnValue)
|
||||
Friend ReadOnly Regex_Photo_PornHub_PhotoBlocks As RParams = RParams.DM("photoAlbumListContainer[\r\n\s\S]+?title=""([^""]+)""[\r\n\s\S]+?a href=""(/album/\d+)""", 0, RegexReturn.List)
|
||||
Friend ReadOnly Regex_Photo_PornHub_AlbumPhotoArr As RParams = RParams.DMS("\<a href=""(/photo/\d+)""", 1, RegexReturn.List, EDP.ReturnValue,
|
||||
CType(Function(Input$) If(Input.IsEmptyString, String.Empty, $"https://www.pornhub.com{Input.Trim}"), Func(Of String, String)))
|
||||
Friend ReadOnly Regex_Photo_PornHub_SinglePhoto As RParams = RParams.DMS("(?<!thumbImage.+?)<img src=""(https://[^""]+\d+[^""]+)""", 1, EDP.ReturnValue)
|
||||
#End Region
|
||||
End Module
|
||||
End Namespace
|
||||
42
SCrawler/API/PornHub/M3U8.vb
Normal file
@@ -0,0 +1,42 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.API.Base.M3U8Declarations
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace API.PornHub
|
||||
Friend NotInheritable Class M3U8
|
||||
Private Sub New()
|
||||
End Sub
|
||||
Private Shared Function GetUrlsList(ByVal URL As String, ByVal Responser As Response) As List(Of String)
|
||||
Dim appender$ = RegexReplace(URL, Regex_M3U8_FileUrl)
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim file$ = RegexReplace(r, Regex_M3U8_FirstFileRegEx)
|
||||
If Not file.IsEmptyString Then
|
||||
Dim NewUrl$ = M3U8Base.CreateUrl(appender, file)
|
||||
If Not NewUrl.IsEmptyString Then
|
||||
r = Responser.GetResponse(NewUrl)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim l As List(Of String) = RegexReplace(r, TsFilesRegEx)
|
||||
If l.ListExists Then
|
||||
For i% = 0 To l.Count - 1 : l(i) = M3U8Base.CreateUrl(appender, l(i)) : Next
|
||||
Return l
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Return Nothing
|
||||
End Function
|
||||
Friend Shared Function Download(ByVal URL As String, ByVal Responser As Response, ByVal Destination As SFile) As SFile
|
||||
Return M3U8Base.Download(GetUrlsList(URL, Responser), Destination, Responser)
|
||||
End Function
|
||||
End Class
|
||||
End Namespace
|
||||
118
SCrawler/API/PornHub/OptionsForm.Designer.vb
generated
Normal file
@@ -0,0 +1,118 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Namespace API.PornHub
|
||||
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
|
||||
Partial Friend Class OptionsForm : Inherits System.Windows.Forms.Form
|
||||
<System.Diagnostics.DebuggerNonUserCode()>
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
Try
|
||||
If disposing AndAlso components IsNot Nothing Then
|
||||
components.Dispose()
|
||||
End If
|
||||
Finally
|
||||
MyBase.Dispose(disposing)
|
||||
End Try
|
||||
End Sub
|
||||
Private components As System.ComponentModel.IContainer
|
||||
<System.Diagnostics.DebuggerStepThrough()>
|
||||
Private Sub InitializeComponent()
|
||||
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
|
||||
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
|
||||
Me.CH_DOWN_GIFS = New System.Windows.Forms.CheckBox()
|
||||
Me.CH_DOWN_PHOTO_MODELHUB = New System.Windows.Forms.CheckBox()
|
||||
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
|
||||
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
|
||||
CONTAINER_MAIN.ContentPanel.SuspendLayout()
|
||||
CONTAINER_MAIN.SuspendLayout()
|
||||
TP_MAIN.SuspendLayout()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'CONTAINER_MAIN
|
||||
'
|
||||
'
|
||||
'CONTAINER_MAIN.ContentPanel
|
||||
'
|
||||
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(278, 52)
|
||||
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
CONTAINER_MAIN.LeftToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
|
||||
CONTAINER_MAIN.RightToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(278, 77)
|
||||
CONTAINER_MAIN.TabIndex = 0
|
||||
CONTAINER_MAIN.TopToolStripPanelVisible = False
|
||||
'
|
||||
'TP_MAIN
|
||||
'
|
||||
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
TP_MAIN.ColumnCount = 1
|
||||
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_MAIN.Controls.Add(Me.CH_DOWN_GIFS, 0, 0)
|
||||
TP_MAIN.Controls.Add(Me.CH_DOWN_PHOTO_MODELHUB, 0, 1)
|
||||
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
TP_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
TP_MAIN.Name = "TP_MAIN"
|
||||
TP_MAIN.RowCount = 3
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_MAIN.Size = New System.Drawing.Size(278, 52)
|
||||
TP_MAIN.TabIndex = 0
|
||||
'
|
||||
'CH_DOWN_GIFS
|
||||
'
|
||||
Me.CH_DOWN_GIFS.AutoSize = True
|
||||
Me.CH_DOWN_GIFS.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_DOWN_GIFS.Location = New System.Drawing.Point(4, 4)
|
||||
Me.CH_DOWN_GIFS.Name = "CH_DOWN_GIFS"
|
||||
Me.CH_DOWN_GIFS.Size = New System.Drawing.Size(270, 19)
|
||||
Me.CH_DOWN_GIFS.TabIndex = 0
|
||||
Me.CH_DOWN_GIFS.Text = "Download gifs"
|
||||
Me.CH_DOWN_GIFS.UseVisualStyleBackColor = True
|
||||
'
|
||||
'CH_DOWN_PHOTO_MODELHUB
|
||||
'
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.AutoSize = True
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.Location = New System.Drawing.Point(4, 30)
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.Name = "CH_DOWN_PHOTO_MODELHUB"
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.Size = New System.Drawing.Size(270, 19)
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.TabIndex = 1
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.Text = "Download photo only from ModelHub"
|
||||
Me.CH_DOWN_PHOTO_MODELHUB.UseVisualStyleBackColor = True
|
||||
'
|
||||
'OptionsForm
|
||||
'
|
||||
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(278, 77)
|
||||
Me.Controls.Add(CONTAINER_MAIN)
|
||||
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
|
||||
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
|
||||
Me.KeyPreview = True
|
||||
Me.MaximizeBox = False
|
||||
Me.MaximumSize = New System.Drawing.Size(294, 116)
|
||||
Me.MinimizeBox = False
|
||||
Me.MinimumSize = New System.Drawing.Size(294, 116)
|
||||
Me.Name = "OptionsForm"
|
||||
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
|
||||
Me.Text = "Options"
|
||||
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
|
||||
CONTAINER_MAIN.ResumeLayout(False)
|
||||
CONTAINER_MAIN.PerformLayout()
|
||||
TP_MAIN.ResumeLayout(False)
|
||||
TP_MAIN.PerformLayout()
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
Private WithEvents CH_DOWN_GIFS As CheckBox
|
||||
Private WithEvents CH_DOWN_PHOTO_MODELHUB As CheckBox
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -120,4 +120,7 @@
|
||||
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
</root>
|
||||
34
SCrawler/API/PornHub/OptionsForm.vb
Normal file
@@ -0,0 +1,34 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Forms
|
||||
Namespace API.PornHub
|
||||
Friend Class OptionsForm
|
||||
Private WithEvents MyDefs As DefaultFormOptions
|
||||
Private ReadOnly MyExchangeOptions As UserExchangeOptions
|
||||
Friend Sub New(ByRef ExchangeOptions As UserExchangeOptions)
|
||||
InitializeComponent()
|
||||
MyExchangeOptions = ExchangeOptions
|
||||
MyDefs = New DefaultFormOptions(Me, Settings.Design)
|
||||
End Sub
|
||||
Private Sub MyForm_Load(sender As Object, e As EventArgs) Handles Me.Load
|
||||
With MyDefs
|
||||
.MyViewInitialize(True)
|
||||
.AddOkCancelToolbar()
|
||||
CH_DOWN_GIFS.Checked = MyExchangeOptions.DownloadGifs
|
||||
CH_DOWN_PHOTO_MODELHUB.Checked = MyExchangeOptions.DownloadPhotoOnlyFromModelHub
|
||||
.EndLoaderOperations()
|
||||
End With
|
||||
End Sub
|
||||
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
|
||||
MyExchangeOptions.DownloadGifs = CH_DOWN_GIFS.Checked
|
||||
MyExchangeOptions.DownloadPhotoOnlyFromModelHub = CH_DOWN_PHOTO_MODELHUB.Checked
|
||||
MyDefs.CloseForm()
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
123
SCrawler/API/PornHub/SiteSettings.vb
Normal file
@@ -0,0 +1,123 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.Plugin
|
||||
Imports SCrawler.Plugin.Attributes
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace API.PornHub
|
||||
<Manifest("AndyProgram_PornHub"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
|
||||
Friend Class SiteSettings : Inherits SiteSettingsBase
|
||||
#Region "Declarations"
|
||||
Friend Overrides ReadOnly Property Icon As Icon
|
||||
Get
|
||||
Return My.Resources.SiteResources.PornHubIcon_16
|
||||
End Get
|
||||
End Property
|
||||
Friend Overrides ReadOnly Property Image As Image
|
||||
Get
|
||||
Return My.Resources.SiteResources.PornHubPic_16
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly Property CurlPathExists As Boolean
|
||||
<PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML>
|
||||
Friend ReadOnly Property DownloadGifs As PropertyValue
|
||||
<PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML>
|
||||
Friend ReadOnly Property DownloadGifsAsMp4 As PropertyValue
|
||||
<PropertyOption(ControlText:="Photo ModelHub only",
|
||||
ControlToolTip:="Download photo only from ModelHub. Prornstar photos hosted on PornHub itself will not be downloaded." & vbCr &
|
||||
"Attention! Downloading photos hosted on PornHub is a very heavy job."), PXML>
|
||||
Friend ReadOnly Property DownloadPhotoOnlyFromModelHub As PropertyValue
|
||||
<PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
|
||||
Friend ReadOnly Property SavedPostsUserName As PropertyValue
|
||||
#End Region
|
||||
#Region "Initializer"
|
||||
Friend Sub New()
|
||||
MyBase.New("PornHub", "pornhub.com")
|
||||
Responser.CurlPath = $"cURL\curl.exe"
|
||||
CurlPathExists = Responser.CurlPath.Exists
|
||||
Responser.DeclaredError = EDP.ThrowException
|
||||
|
||||
DownloadGifsAsMp4 = New PropertyValue(True)
|
||||
DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer))
|
||||
DownloadPhotoOnlyFromModelHub = New PropertyValue(True)
|
||||
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
|
||||
|
||||
UrlPatternUser = "https://www.pornhub.com/{0}/{1}"
|
||||
UserRegex = RParams.DMS("pornhub.com/([^/]+)/([^/]+).*?", 0, RegexReturn.ListByMatch)
|
||||
ImageVideoContains = "pornhub"
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "GetInstance, GetSpecialData"
|
||||
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
|
||||
If What = ISiteSettings.Download.SavedPosts Then
|
||||
Return New UserData With {
|
||||
.IsSavedPosts = True,
|
||||
.VideoPageModel = UserData.VideoPageModels.Favorite,
|
||||
.PersonType = UserData.PersonTypeUser,
|
||||
.User = New UserInfo With {.Name = $"{UserData.PersonTypeUser}_{CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}"}
|
||||
}
|
||||
Else
|
||||
Return New UserData
|
||||
End If
|
||||
End Function
|
||||
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
|
||||
If Available(ISiteSettings.Download.Main, True) Then
|
||||
Using resp As Response = Responser.Copy
|
||||
Dim spf$ = String.Empty
|
||||
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
|
||||
Dim m As UserMedia = UserData.GetVideoInfo(URL, resp, f)
|
||||
If m.State = UserMedia.States.Downloaded Then
|
||||
m.SpecialFolder = f
|
||||
Return {m}
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
Return Nothing
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Downloading"
|
||||
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
|
||||
Return Settings.UseM3U8 And CurlPathExists And (Not What = ISiteSettings.Download.SavedPosts OrElse ACheck(SavedPostsUserName.Value))
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IsMyUser"
|
||||
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
|
||||
Try
|
||||
If Not UserURL.IsEmptyString Then
|
||||
Dim alist As List(Of String) = RegexReplace(UserURL.ToLower, UserRegex)
|
||||
If alist.ListExists(3) Then Return New ExchangeOptions(Site, $"{alist(1)}_{alist(2)}")
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[API.PornHub.SiteSettings.IsMyUser({UserURL})]", New ExchangeOptions)
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "GetUserUrl, GetUserPostUrl"
|
||||
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
|
||||
With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, .PersonType, .NameTrue) : End With
|
||||
End Function
|
||||
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
|
||||
'TODELETE: remove comment
|
||||
Return Media.URL_BASE '$"https://www.pornhub.com/view_video.php?viewkey={Media.Post.ID}"
|
||||
End Function
|
||||
#End Region
|
||||
#Region "User options"
|
||||
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
|
||||
Dim e As UserExchangeOptions = Nothing
|
||||
If Not Options Is Nothing AndAlso TypeOf Options Is UserExchangeOptions Then e = Options
|
||||
If e Is Nothing Then e = New UserExchangeOptions(Me)
|
||||
If OpenForm Then
|
||||
Using f As New OptionsForm(e) : f.ShowDialog() : End Using
|
||||
End If
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
End Namespace
|
||||
656
SCrawler/API/PornHub/UserData.vb
Normal file
@@ -0,0 +1,656 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Namespace API.PornHub
|
||||
Friend Class UserData : Inherits UserDataBase
|
||||
Private Const UrlPattern As String = "https://www.pornhub.com/{0}"
|
||||
#Region "Declarations"
|
||||
#Region "XML names"
|
||||
Private Const Name_PersonType As String = "PersonType"
|
||||
Private Const Name_NameTrue As String = "NameTrue"
|
||||
Private Const Name_VideoPageModel As String = "VideoPageModel"
|
||||
Private Const Name_PhotoPageModel As String = "PhotoPageModel"
|
||||
Private Const Name_DownloadGifs As String = "DownloadGifs"
|
||||
Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub"
|
||||
#End Region
|
||||
#Region "Structures"
|
||||
Private Structure FlashVar : Implements IRegExCreator
|
||||
Friend Name As String
|
||||
Friend Value As String
|
||||
Public Shared Widening Operator CType(ByVal Name As String) As FlashVar
|
||||
Return New FlashVar With {.Name = Name}
|
||||
End Operator
|
||||
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
|
||||
If ParamsArray.ListExists(2) Then
|
||||
Name = ParamsArray(0)
|
||||
Value = ParamsArray(1)
|
||||
If Not Value.IsEmptyString Then Value = Value.Replace(""" + """, String.Empty).Replace("""", String.Empty).StringTrim
|
||||
End If
|
||||
Return Me
|
||||
End Function
|
||||
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
|
||||
Return CType(Obj, FlashVar).Name = Name
|
||||
End Function
|
||||
End Structure
|
||||
Private Structure UserVideo : Implements IRegExCreator
|
||||
Friend URL As String
|
||||
Friend ID As String
|
||||
Friend Title As String
|
||||
Friend Function ToUserMedia() As UserMedia
|
||||
Return New UserMedia(URL, UTypes.VideoPre) With {
|
||||
.File = If(Title.IsEmptyString, .File, New SFile($"{Title}.mp4")),
|
||||
.Post = ID
|
||||
}
|
||||
End Function
|
||||
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
|
||||
If ParamsArray.ListExists Then
|
||||
URL = ParamsArray(0)
|
||||
ID = RegexReplace(URL, RegexVideo_Video_VideoKey)
|
||||
URL = String.Format(UrlPattern, URL.TrimStart("/"))
|
||||
Title = HtmlConverter(ParamsArray(1)).StringRemoveWinForbiddenSymbols.StringTrim
|
||||
End If
|
||||
Return Me
|
||||
End Function
|
||||
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
|
||||
Return DirectCast(Obj, UserVideo).URL = URL
|
||||
End Function
|
||||
End Structure
|
||||
Private Structure PhotoBlock : Implements IRegExCreator
|
||||
Friend AlbumID As String
|
||||
Friend Data As String
|
||||
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
|
||||
If ParamsArray.ListExists(2) Then
|
||||
AlbumID = ParamsArray(0)
|
||||
Data = ParamsArray(1).StringTrim
|
||||
End If
|
||||
Return Me
|
||||
End Function
|
||||
End Structure
|
||||
#End Region
|
||||
#Region "Enums"
|
||||
Friend Enum VideoPageModels As Integer
|
||||
[Default] = 0
|
||||
ConcatPage = 1
|
||||
Favorite = 2
|
||||
Undefined = -1
|
||||
End Enum
|
||||
Private Enum PhotoPageModels As Integer
|
||||
Undefined = 0
|
||||
PornHubPage = 1
|
||||
ModelHubPage = 2
|
||||
End Enum
|
||||
#End Region
|
||||
#Region "Constants"
|
||||
Private Const PersonTypeModel As String = "model"
|
||||
Friend Const PersonTypeUser As String = "users"
|
||||
#End Region
|
||||
#Region "Person"
|
||||
Friend Property PersonType As String
|
||||
Friend Property NameTrue As String
|
||||
Private _FriendlyName As String = String.Empty
|
||||
Friend Overrides Property FriendlyName As String
|
||||
Get
|
||||
If _FriendlyName.IsEmptyString Then Return NameTrue Else Return _FriendlyName
|
||||
End Get
|
||||
Set(ByVal n As String)
|
||||
_FriendlyName = n
|
||||
End Set
|
||||
End Property
|
||||
#End Region
|
||||
#Region "Advanced fields"
|
||||
Friend Property VideoPageModel As VideoPageModels = VideoPageModels.Undefined
|
||||
Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined
|
||||
Friend Property DownloadGifs As Boolean
|
||||
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
|
||||
#End Region
|
||||
#Region "ExchangeOptions"
|
||||
Friend Overrides Function ExchangeOptionsGet() As Object
|
||||
Return New UserExchangeOptions(Me)
|
||||
End Function
|
||||
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
|
||||
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
|
||||
With DirectCast(Obj, UserExchangeOptions)
|
||||
DownloadGifs = .DownloadGifs
|
||||
DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub
|
||||
End With
|
||||
End If
|
||||
End Sub
|
||||
#End Region
|
||||
Private ReadOnly Property MySettings As SiteSettings
|
||||
Get
|
||||
Return DirectCast(HOST.Source, SiteSettings)
|
||||
End Get
|
||||
End Property
|
||||
#End Region
|
||||
#Region "Initializer, loader"
|
||||
Friend Sub New()
|
||||
UseInternalM3U8Function = True
|
||||
End Sub
|
||||
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
|
||||
With Container
|
||||
Dim SetNames As Action = Sub()
|
||||
If Not Name.IsEmptyString And NameTrue.IsEmptyString Then
|
||||
Dim n$() = Name.Split("_")
|
||||
If n.ListExists(2) Then
|
||||
NameTrue = Name.Replace($"{n(0)}_", String.Empty)
|
||||
PersonType = n(0)
|
||||
If (PersonType = PersonTypeModel Or PersonType = PersonTypeUser) And
|
||||
VideoPageModel = VideoPageModels.Undefined Then VideoPageModel = VideoPageModels.Default
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
If Loading Then
|
||||
PersonType = .Value(Name_PersonType)
|
||||
NameTrue = .Value(Name_NameTrue)
|
||||
VideoPageModel = .Value(Name_VideoPageModel).FromXML(Of Integer)(VideoPageModels.Undefined)
|
||||
PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined)
|
||||
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
|
||||
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
|
||||
SetNames.Invoke()
|
||||
Else
|
||||
SetNames.Invoke()
|
||||
.Add(Name_PersonType, PersonType)
|
||||
.Add(Name_NameTrue, NameTrue)
|
||||
.Add(Name_VideoPageModel, CInt(VideoPageModel))
|
||||
.Add(Name_PhotoPageModel, CInt(PhotoPageModel))
|
||||
.Add(Name_DownloadGifs, DownloadGifs.BoolToInteger)
|
||||
.Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger)
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Downloading"
|
||||
#Region "Download override"
|
||||
Private Const DataDownloaded As Integer = -10
|
||||
Private Const DataDownloaded_NotFound As Integer = -20
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
Try
|
||||
Responser.ResetStatus()
|
||||
If PersonType = PersonTypeUser Then Responser.Mode = Response.Modes.Curl
|
||||
|
||||
If IsSavedPosts Then VideoPageModel = VideoPageModels.Favorite
|
||||
|
||||
Dim page% = 1
|
||||
Dim __continue As Boolean = True
|
||||
Dim __videoDone As Boolean = False
|
||||
Dim d%
|
||||
If DownloadVideos Then
|
||||
If PersonType = PersonTypeUser Then Responser.Mode = Response.Modes.Curl : Responser.Method = "POST"
|
||||
If VideoPageModel = VideoPageModels.Undefined Then
|
||||
__continue = False
|
||||
d = DownloadUserVideos(page, Token)
|
||||
Select Case d
|
||||
Case DataDownloaded : __continue = True : page += 1
|
||||
Case 1 : VideoPageModel = VideoPageModels.ConcatPage
|
||||
Case EXCEPTION_OPERATION_CANCELED : ThrowAny(Token)
|
||||
Case DataDownloaded_NotFound : __videoDone = True
|
||||
End Select
|
||||
If Not __continue And Not __videoDone Then
|
||||
d = DownloadUserVideos(page, Token)
|
||||
Select Case d
|
||||
Case DataDownloaded : __continue = True : page += 1
|
||||
Case 1 : VideoPageModel = VideoPageModels.Undefined
|
||||
Case EXCEPTION_OPERATION_CANCELED : ThrowAny(Token)
|
||||
Case DataDownloaded_NotFound : __videoDone = True
|
||||
End Select
|
||||
End If
|
||||
End If
|
||||
If __continue And Not __videoDone Then
|
||||
Do While DownloadUserVideos(page, Token) = DataDownloaded And page < 100 : page += 1 : Loop
|
||||
End If
|
||||
End If
|
||||
|
||||
Responser.Method = "GET"
|
||||
If DownloadGifs And Not IsSavedPosts Then DownloadUserGifs(Token)
|
||||
If DownloadImages Then DownloadUserPhotos(Token)
|
||||
Finally
|
||||
Responser.Mode = Response.Modes.Default
|
||||
Responser.Method = "GET"
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download video"
|
||||
Private ReadOnly Property VideoPageType As String
|
||||
Get
|
||||
Select Case VideoPageModel
|
||||
Case VideoPageModels.Default : Return "/videos/upload"
|
||||
Case VideoPageModels.Favorite : Return "/videos/favorites/"
|
||||
Case Else : Return String.Empty
|
||||
End Select
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly Property VideoPageAppender As String
|
||||
Get
|
||||
Return If(PersonType = PersonTypeUser, "ajax?o=newest&page=", String.Empty)
|
||||
End Get
|
||||
End Property
|
||||
Private Overloads Function DownloadUserVideos(ByVal Page As Integer, ByVal Token As CancellationToken) As Integer
|
||||
Const VideoUrlPattern$ = "https://www.pornhub.com/{0}/{1}{2}{3}"
|
||||
Const HtmlPageNotFoundVideo$ = "<span>Error Page Not Found</span>"
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
Dim p$
|
||||
If PersonType = PersonTypeUser Then
|
||||
p = Page
|
||||
Else
|
||||
p = IIf(Page = 1, String.Empty, $"?page={Page}")
|
||||
End If
|
||||
|
||||
URL = $"{String.Format(VideoUrlPattern, PersonType, NameTrue, VideoPageType, VideoPageAppender)}{p}"
|
||||
ThrowAny(Token)
|
||||
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
If PersonType = PersonTypeUser And r.Contains(HtmlPageNotFoundVideo) Then Return DataDownloaded_NotFound
|
||||
Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexVideo_Video_All}, {1, 2})
|
||||
Dim lw As List(Of UserVideo) = Nothing
|
||||
If Not PersonType = PersonTypeUser Then RegexFields(Of UserVideo)(r, {RegexVideo_Video_Wrong}, RegexVideo_Video_Wrong_Fields)
|
||||
If l.ListExists Then
|
||||
If lw.ListExists Then l.ListWithRemove(lw)
|
||||
If l.Count > 0 Then
|
||||
Dim lBefore% = l.Count
|
||||
l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean
|
||||
If Not _TempPostsList.Contains(uv.ID) Then
|
||||
_TempPostsList.Add(uv.ID)
|
||||
Return False
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
End Function)
|
||||
If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia))
|
||||
If l.Count = lBefore And l.Count > 0 Then Return DataDownloaded
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Return DataDownloaded_NotFound
|
||||
Catch regex_ex As RegexFieldsTextBecameNullException
|
||||
If PersonType = PersonTypeUser Or IsSavedPosts Then
|
||||
Return DataDownloaded_NotFound
|
||||
Else
|
||||
Return ProcessException(regex_ex, Token, $"videos downloading error [{URL}]")
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Return ProcessException(ex, Token, $"videos downloading error [{URL}]")
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Download GIF"
|
||||
Private Sub DownloadUserGifs(ByVal Token As CancellationToken)
|
||||
Dim URL$ = $"https://www.pornhub.com/{PersonType}/{NameTrue}/gifs"
|
||||
Try
|
||||
ThrowAny(Token)
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim n$
|
||||
Dim m As UserMedia = Nothing
|
||||
Dim l As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {Regex_Gif_Array}, {1})
|
||||
Dim l2 As List(Of String) = Nothing
|
||||
Dim l3 As List(Of String) = Nothing
|
||||
If l.ListExists Then l2 = l.Select(Function(ll) $"gif/{ll.Arr(0).Replace("gif", String.Empty)}").ToList
|
||||
If l2.ListExists Then
|
||||
For Each gif$ In l2
|
||||
If Not _TempPostsList.Contains(gif) Then
|
||||
_TempPostsList.Add(gif)
|
||||
URL = $"https://www.pornhub.com/{gif}"
|
||||
m = New UserMedia(URL, UTypes.Video) With {.Post = gif, .SpecialFolder = "GIFs\"}
|
||||
ThrowAny(Token)
|
||||
Try
|
||||
r = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
If l3.ListExists Then l3.Clear() : l3 = Nothing
|
||||
l3 = RegexReplace(r, Regex_Gif_UrlName)
|
||||
If l3.ListExists(3) Then
|
||||
m.URL = l3(2)
|
||||
m.File = m.URL
|
||||
n = HtmlConverter(l3(1)).StringRemoveWinForbiddenSymbols.StringTrim
|
||||
If MySettings.DownloadGifsAsMp4.Value Then m.File.Extension = "mp4"
|
||||
If Not n.IsEmptyString Then m.File.Name = n
|
||||
End If
|
||||
End If
|
||||
Catch gif_down_ex As Exception
|
||||
m.State = UserMedia.States.Missing
|
||||
End Try
|
||||
_TempMediaList.ListAddValue(m)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
If l.ListExists Then l.Clear()
|
||||
If l2.ListExists Then l2.Clear()
|
||||
If l3.ListExists Then l3.Clear()
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, $"gifs downloading error [{URL}]")
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download photo"
|
||||
Private Const PhotoUrlPattern_ModelHub As String = "https://www.modelhub.com/{0}/photos"
|
||||
Private Const PhotoUrlPattern_PornHub As String = "https://www.pornhub.com/{0}/{1}/photos"
|
||||
Private Sub DownloadUserPhotos(ByVal Token As CancellationToken)
|
||||
Try
|
||||
If IsSavedPosts Then
|
||||
DownloadUserPhotos_SavedPosts(Token)
|
||||
ElseIf PersonType = PersonTypeModel Then
|
||||
If PhotoPageModel = PhotoPageModels.Undefined Then
|
||||
If DownloadUserPhotos_ModelHub(Token) Then PhotoPageModel = PhotoPageModels.ModelHubPage
|
||||
ThrowAny(Token)
|
||||
If PhotoPageModel = PhotoPageModels.Undefined AndAlso DownloadPhotoOnlyFromModelHub AndAlso
|
||||
DownloadUserPhotos_PornHub(Token) Then PhotoPageModel = PhotoPageModels.PornHubPage
|
||||
Else
|
||||
Select Case PhotoPageModel
|
||||
Case PhotoPageModels.ModelHubPage : DownloadUserPhotos_ModelHub(Token)
|
||||
Case PhotoPageModels.PornHubPage : If DownloadPhotoOnlyFromModelHub Then DownloadUserPhotos_PornHub(Token)
|
||||
End Select
|
||||
End If
|
||||
ElseIf Not DownloadPhotoOnlyFromModelHub Then
|
||||
DownloadUserPhotos_PornHub(Token)
|
||||
End If
|
||||
ThrowAny(Token)
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, $"photos downloading error")
|
||||
End Try
|
||||
End Sub
|
||||
Private Function DownloadUserPhotos_ModelHub(ByVal Token As CancellationToken) As Boolean
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
Dim jErr As New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue)
|
||||
Dim albumName$
|
||||
If PersonType = PersonTypeModel Then
|
||||
URL = String.Format(PhotoUrlPattern_ModelHub, NameTrue)
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2})
|
||||
If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString)
|
||||
If l.ListExists Then
|
||||
Dim albumRegex As RParams = RParams.DMS("", 1, EDP.ReturnValue)
|
||||
For Each block As PhotoBlock In l
|
||||
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
|
||||
albumRegex.Pattern = "<li id=""" & block.AlbumID & """ class=""modelBox"">[\r\n\s]*?<div class=""modelPhoto"">[\r\n\s]*?\<[^\>]*?alt=""([^""]*)"""
|
||||
albumName = StringTrim(RegexReplace(r, albumRegex))
|
||||
If albumName.IsEmptyString Then albumName = block.AlbumID
|
||||
Using j As EContainer = JsonDocument.Parse("{" & block.Data & "}", jErr)
|
||||
If Not j Is Nothing Then
|
||||
If If(j("urls")?.Count, 0) > 0 Then
|
||||
_TempMediaList.ListAddList(j("urls").Select(Function(jj) _
|
||||
New UserMedia(jj.ItemF({0}).XmlIfNothingValue, UTypes.Picture) With {
|
||||
.SpecialFolder = $"Albums\{albumName}\"}), LNC)
|
||||
End If
|
||||
End If
|
||||
End Using
|
||||
Next
|
||||
l.Clear()
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
ThrowAny(Token)
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
Private Overloads Function DownloadUserPhotos_PornHub(ByVal Token As CancellationToken) As Boolean
|
||||
Try
|
||||
Dim albumName$
|
||||
Dim page%
|
||||
Dim r$ = Responser.GetResponse(String.Format(PhotoUrlPattern_PornHub, PersonType, NameTrue))
|
||||
If Not r.IsEmptyString Then
|
||||
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1})
|
||||
If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString)
|
||||
If l.ListExists Then
|
||||
For Each block As PhotoBlock In l
|
||||
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
|
||||
albumName = block.Data
|
||||
If albumName.IsEmptyString Then
|
||||
albumName = block.AlbumID.Split("/").LastOrDefault.StringTrim
|
||||
Else
|
||||
albumName = HtmlConverter(albumName).StringRemoveWinForbiddenSymbols.StringTrim
|
||||
End If
|
||||
page = 1
|
||||
Do While DownloadUserPhotos_PornHub(page, block.AlbumID, albumName, Token) : page += 1 : Loop
|
||||
Next
|
||||
l.Clear()
|
||||
End If
|
||||
End If
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
ThrowAny(Token)
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
Private Overloads Function DownloadUserPhotos_PornHub(ByVal Page As Integer, ByVal AlbumID As String, ByVal AlbumName As String,
|
||||
ByVal Token As CancellationToken) As Boolean
|
||||
Try
|
||||
Dim r$ = Responser.GetResponse($"https://www.pornhub.com{AlbumID}{IIf(Page = 1, String.Empty, $"?page={Page}")}")
|
||||
If Not r.IsEmptyString Then
|
||||
Dim l As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
|
||||
If l.ListExists Then l.RemoveAll(Function(_url) _url.IsEmptyString)
|
||||
If l.ListExists Then
|
||||
For Each url$ In l
|
||||
ThrowAny(Token)
|
||||
Try
|
||||
r = Responser.GetResponse(url)
|
||||
If Not r.IsEmptyString Then
|
||||
url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto)
|
||||
If Not url.IsEmptyString Then _
|
||||
_TempMediaList.ListAddValue(New UserMedia(url, UTypes.Picture) With {.SpecialFolder = $"Albums\{AlbumName}\"}, LNC)
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
Next
|
||||
l.Clear()
|
||||
Return True
|
||||
End If
|
||||
End If
|
||||
Return False
|
||||
Catch ex As Exception
|
||||
ThrowAny(Token)
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
Private Function DownloadUserPhotos_SavedPosts(ByVal Token As CancellationToken) As Boolean
|
||||
Const HtmlPageNotFoundPhoto$ = "Page Not Found"
|
||||
Dim URL$ = $"https://www.pornhub.com/{PersonType}/{NameTrue}/photos/favorites"
|
||||
Try
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
If r.Contains(HtmlPageNotFoundPhoto) Then Return False
|
||||
Dim urls As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
|
||||
If urls.ListExists Then
|
||||
Dim NewUrl$
|
||||
Dim m As UserMedia
|
||||
Dim l2 As List(Of UserMedia) = urls.Select(Function(__url) New UserMedia(__url, UTypes.Picture) With {
|
||||
.Post = __url.Split("/").LastOrDefault}).ToList
|
||||
urls.Clear()
|
||||
If l2.ListExists Then l2.RemoveAll(Function(media) media.URL.IsEmptyString)
|
||||
If l2.ListExists Then
|
||||
Dim lBefore% = l2.Count
|
||||
If _TempPostsList.Count > 0 Then l2.RemoveAll(Function(media) _TempPostsList.Contains(media.Post.ID))
|
||||
If l2.Count > 0 Then
|
||||
For i% = 0 To l2.Count - 1
|
||||
m = l2(i)
|
||||
ThrowAny(Token)
|
||||
Try
|
||||
r = Responser.GetResponse(m.URL)
|
||||
If Not r.IsEmptyString Then
|
||||
NewUrl = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto)
|
||||
If Not NewUrl.IsEmptyString Then
|
||||
m.URL = NewUrl
|
||||
m.File = NewUrl
|
||||
_TempPostsList.ListAddValue(m.Post.ID, LNC)
|
||||
Else
|
||||
Throw New Exception
|
||||
End If
|
||||
End If
|
||||
Catch
|
||||
m.State = UserMedia.States.Missing
|
||||
End Try
|
||||
_TempMediaList.ListAddValue(m, LNC)
|
||||
Next
|
||||
End If
|
||||
Return l2.Count = lBefore
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Return False
|
||||
Catch ex As Exception
|
||||
Return ProcessException(ex, Token, $"photos downloading error [{URL}]")
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#End Region
|
||||
#Region "ReparseVideo"
|
||||
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
|
||||
Const ERR_NEW_URL$ = "ERR_NEW_URL"
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
|
||||
Dim m As UserMedia
|
||||
Dim r$, NewUrl$
|
||||
For i% = _TempMediaList.Count - 1 To 0 Step -1
|
||||
If _TempMediaList(i).Type = UTypes.VideoPre Then
|
||||
m = _TempMediaList(i)
|
||||
ThrowAny(Token)
|
||||
Try
|
||||
URL = m.URL
|
||||
r = Responser.Curl(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
NewUrl = CreateVideoURL(r)
|
||||
If NewUrl.IsEmptyString Then
|
||||
Throw New Exception With {.HelpLink = ERR_NEW_URL}
|
||||
Else
|
||||
m.URL = NewUrl
|
||||
m.Type = UTypes.m3u8
|
||||
_TempMediaList(i) = m
|
||||
End If
|
||||
Else
|
||||
_TempMediaList.RemoveAt(i)
|
||||
End If
|
||||
Catch mid_ex As Exception
|
||||
If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then
|
||||
m.State = UserMedia.States.Missing
|
||||
_TempMediaList(i) = m
|
||||
Else
|
||||
_TempMediaList.RemoveAt(i)
|
||||
End If
|
||||
End Try
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, "video reparsing error", False)
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "ReparseMissing"
|
||||
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
|
||||
Dim rList As New List(Of Integer)
|
||||
Try
|
||||
If ContentMissingExists Then
|
||||
Dim m As UserMedia
|
||||
Dim r$
|
||||
Dim eCurl As New ErrorsDescriber(EDP.ReturnValue)
|
||||
For i% = 0 To _ContentList.Count - 1
|
||||
m = _ContentList(i)
|
||||
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
|
||||
ThrowAny(Token)
|
||||
r = Responser.Curl(m.URL_BASE, eCurl)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim NewUrl$ = CreateVideoURL(r)
|
||||
If Not NewUrl.IsEmptyString Then
|
||||
m.URL = NewUrl
|
||||
_TempMediaList.ListAddValue(m, LNC)
|
||||
rList.Add(i)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, "missing data downloading error")
|
||||
Finally
|
||||
If rList.Count > 0 Then
|
||||
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
|
||||
rList.Clear()
|
||||
End If
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download content"
|
||||
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
DownloadContentDefault(Token)
|
||||
End Sub
|
||||
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
|
||||
Return M3U8.Download(URL, Responser, DestinationFile)
|
||||
End Function
|
||||
#End Region
|
||||
#Region "CreateVideoURL"
|
||||
Private Shared Function CreateVideoURL(ByVal r As String) As String
|
||||
Try
|
||||
Dim OutStr$ = String.Empty
|
||||
If Not r.IsEmptyString Then
|
||||
Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock)
|
||||
If Not _VarBlock.IsEmptyString Then
|
||||
Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
|
||||
Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
|
||||
If vars.ListExists And compiler.ListExists Then
|
||||
Dim v$
|
||||
Dim i%
|
||||
For Each var$ In compiler
|
||||
i = vars.IndexOf(var)
|
||||
If i >= 0 Then
|
||||
v = vars(i).Value
|
||||
If Not v.IsEmptyString Then OutStr &= v
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Return OutStr
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Standalone downloader"
|
||||
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Response, ByVal Destination As SFile) As UserMedia
|
||||
Try
|
||||
Dim r$ = Responser.Curl(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim NewUrl$ = CreateVideoURL(r)
|
||||
If Not NewUrl.IsEmptyString Then
|
||||
Dim f As SFile = M3U8.Download(NewUrl, Responser, Destination)
|
||||
If Not f.IsEmptyString Then Return New UserMedia With {.State = UserMedia.States.Downloaded}
|
||||
End If
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"PornHub standalone download error: [{URL}]", New UserMedia)
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Exceptions"
|
||||
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String,
|
||||
Optional ByVal FromPE As Boolean = False, Optional ByVal EObj As Object = Nothing) As Integer
|
||||
If Responser.Status = Net.WebExceptionStatus.ConnectionClosed Then
|
||||
Return 1
|
||||
ElseIf Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
|
||||
Return 2
|
||||
Else
|
||||
Return 0
|
||||
End If
|
||||
End Function
|
||||
#End Region
|
||||
End Class
|
||||
End Namespace
|
||||
23
SCrawler/API/PornHub/UserExchangeOptions.vb
Normal file
@@ -0,0 +1,23 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Namespace API.PornHub
|
||||
Friend Class UserExchangeOptions
|
||||
Friend Property DownloadGifs As Boolean
|
||||
Friend Property DownloadPhotoOnlyFromModelHub As Boolean
|
||||
Friend Sub New(ByVal u As UserData)
|
||||
DownloadGifs = u.DownloadGifs
|
||||
DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
|
||||
End Sub
|
||||
Friend Sub New(ByVal s As SiteSettings)
|
||||
Dim v As CheckState = CInt(s.DownloadGifs.Value)
|
||||
DownloadGifs = Not v = CheckState.Unchecked
|
||||
DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -236,8 +236,19 @@ Namespace API.Reddit
|
||||
Return If(Name.IsEmptyString, ID, Name)
|
||||
End Function
|
||||
Friend Sub Delete()
|
||||
File.Delete(, SFODelete.DeleteToRecycleBin)
|
||||
FilePosts.Delete(, SFODelete.DeleteToRecycleBin)
|
||||
Dim f As SFile = ChannelsCollection.ChannelsDeletedPath
|
||||
With File
|
||||
f.Name = .Name
|
||||
f.Extension = .Extension
|
||||
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
|
||||
.Delete(, SFODelete.DeleteToRecycleBin)
|
||||
End With
|
||||
With FilePosts
|
||||
f.Name = .Name
|
||||
f.Extension = .Extension
|
||||
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
|
||||
.Delete(, SFODelete.DeleteToRecycleBin)
|
||||
End With
|
||||
End Sub
|
||||
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
|
||||
Optional ByVal p As MyProgress = Nothing)
|
||||
|
||||
@@ -17,6 +17,11 @@ Namespace API.Reddit
|
||||
Return $"{SettingsFolderName}\Channels\"
|
||||
End Get
|
||||
End Property
|
||||
Friend Shared ReadOnly Property ChannelsDeletedPath As SFile
|
||||
Get
|
||||
Return $"{SettingsFolderName}\ChannelsDeleted\"
|
||||
End Get
|
||||
End Property
|
||||
Friend Shared ReadOnly Property ChannelsPathCache As SFile
|
||||
Get
|
||||
Return $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\"
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Net
|
||||
Imports SCrawler.API.Reddit.M3U8_Declarations
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Namespace API.Reddit
|
||||
Namespace M3U8_Declarations
|
||||
|
||||
@@ -25,7 +25,7 @@ Namespace API.Reddit
|
||||
Return My.Resources.SiteResources.RedditPic_512
|
||||
End Get
|
||||
End Property
|
||||
<PropertyOption(ControlText:="Saved posts user"), PXML("SavedPostsUserName")>
|
||||
<PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
|
||||
Friend ReadOnly Property SavedPostsUserName As PropertyValue
|
||||
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML>
|
||||
Friend ReadOnly Property UseM3U8 As PropertyValue
|
||||
@@ -40,6 +40,7 @@ Namespace API.Reddit
|
||||
UrlPatternUser = "https://www.reddit.com/user/{0}/"
|
||||
UrlPatternChannel = "https://www.reddit.com/r/{0}/"
|
||||
ImageVideoContains = "reddit.com"
|
||||
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
|
||||
End Sub
|
||||
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
|
||||
Select Case What
|
||||
@@ -55,19 +56,9 @@ Namespace API.Reddit
|
||||
End Select
|
||||
Return Nothing
|
||||
End Function
|
||||
Private ReadOnly RedditRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/user/([^/]+)", 1)
|
||||
Private ReadOnly RedditRegEx2 As RParams = RParams.DMS(".?u/([^/]+)", 1)
|
||||
Private ReadOnly RedditChannelRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/r/([^/]+)", 1)
|
||||
Private ReadOnly RedditChannelRegEx2 As RParams = RParams.DMS(".?r/([^/]+)", 1)
|
||||
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
|
||||
Dim s$
|
||||
Dim c% = 0
|
||||
For Each r As RParams In {RedditRegEx1, RedditRegEx2, RedditChannelRegEx1, RedditChannelRegEx2}
|
||||
s = RegexReplace(UserURL, r)
|
||||
If Not s.IsEmptyString Then Return New ExchangeOptions(Site, s, c > 1)
|
||||
c += 1
|
||||
Next
|
||||
Return Nothing
|
||||
Dim l As List(Of String) = RegexReplace(UserURL, UserRegex)
|
||||
If l.ListExists(3) Then Return New ExchangeOptions(Site, l(2), l(1) = "r") Else Return Nothing
|
||||
End Function
|
||||
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
|
||||
Try
|
||||
@@ -79,18 +70,27 @@ Namespace API.Reddit
|
||||
If Silent Then
|
||||
Return False
|
||||
Else
|
||||
Return MsgBoxE({"Over the past hour, Reddit has received an average of " &
|
||||
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
|
||||
dl.ListToString(vbCr) & vbCr & vbCr &
|
||||
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes
|
||||
If MsgBoxE({"Over the past hour, Reddit has received an average of " &
|
||||
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
|
||||
dl.ListToString(vbCr) & vbCr & vbCr &
|
||||
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
|
||||
UpdateRedGifsToken()
|
||||
Return True
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
UpdateRedGifsToken()
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
|
||||
End Try
|
||||
End Function
|
||||
Private Sub UpdateRedGifsToken()
|
||||
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
|
||||
End Sub
|
||||
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
|
||||
Dim spf$ = String.Empty
|
||||
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
|
||||
@@ -103,8 +103,8 @@ Namespace API.Reddit
|
||||
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
|
||||
End If
|
||||
End Sub
|
||||
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
|
||||
Return $"https://www.reddit.com/comments/{PostID.Split("_").LastOrDefault}/"
|
||||
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
|
||||
Return $"https://www.reddit.com/comments/{Media.Post.ID.Split("_").LastOrDefault}/"
|
||||
End Function
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -14,8 +14,8 @@ Imports SCrawler.Plugin.Hosts
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.ImageRenderer
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports UStates = SCrawler.API.Base.UserMedia.States
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Imports CView = SCrawler.API.Reddit.IRedditView.View
|
||||
@@ -152,6 +152,8 @@ Namespace API.Reddit
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
_TotalPostsDownloaded = 0
|
||||
If IsSavedPosts Then
|
||||
'TODO: Reddit saved posts: remove Unicode converter?
|
||||
Responser.DecodersError = EDP.ReturnValue
|
||||
DownloadDataChannel(String.Empty, Token)
|
||||
ElseIf IsChannel Then
|
||||
If ChannelInfo Is Nothing Then
|
||||
@@ -793,7 +795,7 @@ Namespace API.Reddit
|
||||
End Function
|
||||
Dim m$
|
||||
Using w As New WebClient
|
||||
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
|
||||
If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
|
||||
Progress.Maximum += _ContentNew.Count
|
||||
For i = 0 To _ContentNew.Count - 1
|
||||
ThrowAny(Token)
|
||||
@@ -850,7 +852,7 @@ Namespace API.Reddit
|
||||
End If
|
||||
If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then
|
||||
Select Case v.Type
|
||||
Case UTypes.Picture : DownloadedPictures(False) += 1
|
||||
Case UTypes.Picture, UTypes.GIF : DownloadedPictures(False) += 1
|
||||
Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1
|
||||
End Select
|
||||
If Not IsChannel Or Not SaveToCache Then
|
||||
@@ -897,19 +899,20 @@ Namespace API.Reddit
|
||||
End Sub
|
||||
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
|
||||
Optional ByVal EObj As Object = Nothing) As Integer
|
||||
If Responser.StatusCode = HttpStatusCode.NotFound Then
|
||||
UserExists = False
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then
|
||||
UserSuspended = True
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or
|
||||
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
|
||||
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.GatewayTimeout Then
|
||||
Return 1
|
||||
Else
|
||||
If Not FromPE Then LogError(ex, Message) : HasError = True
|
||||
Return 0
|
||||
End If
|
||||
With Responser
|
||||
If .StatusCode = HttpStatusCode.NotFound Then
|
||||
UserExists = False
|
||||
ElseIf .StatusCode = HttpStatusCode.Forbidden Then
|
||||
UserSuspended = True
|
||||
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then
|
||||
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
|
||||
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
|
||||
Return 1
|
||||
Else
|
||||
If Not FromPE Then LogError(ex, Message) : HasError = True
|
||||
Return 0
|
||||
End If
|
||||
End With
|
||||
Return 1
|
||||
End Function
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
|
||||
@@ -14,6 +14,6 @@ Namespace API.RedGifs
|
||||
Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v, n, e))
|
||||
Friend ReadOnly WatchIDRegex As RParams = RParams.DMS(".+?watch/([^\?&""/]+)", 1, EDP.ReturnValue)
|
||||
Friend ReadOnly ThumbsIDRegex As RParams = RParams.DMS("([^/\?&""]+?)(-\w+?|)\.(mp4|jpg)", 1, EDP.ReturnValue,
|
||||
Function(v) If(CStr(v).IsEmptyString, String.Empty, CStr(v).ToLower.Trim))
|
||||
CType(Function(Input$) Input.StringToLower.StringTrim, Func(Of String, String)))
|
||||
End Module
|
||||
End Namespace
|
||||
@@ -9,13 +9,17 @@
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.Plugin
|
||||
Imports SCrawler.Plugin.Attributes
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Cookies
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Imports UStates = SCrawler.API.Base.UserMedia.States
|
||||
Namespace API.RedGifs
|
||||
<Manifest(RedGifsSiteKey)>
|
||||
Friend Class SiteSettings : Inherits SiteSettingsBase
|
||||
#Region "Declarations"
|
||||
Friend Overrides ReadOnly Property Icon As Icon
|
||||
Get
|
||||
Return My.Resources.SiteResources.RedGifsIcon_32
|
||||
@@ -28,29 +32,95 @@ Namespace API.RedGifs
|
||||
End Property
|
||||
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
|
||||
Friend Property Token As PropertyValue
|
||||
<PXML> Friend Property TokenLastDateUpdated As PropertyValue
|
||||
<DoNotUse> Friend ReadOnly Property NoCredentialsResponser As Response
|
||||
Private Const TokenName As String = "authorization"
|
||||
#End Region
|
||||
#Region "Initializer"
|
||||
Friend Sub New()
|
||||
MyBase.New(RedGifsSite, "redgifs.com")
|
||||
Dim t$ = String.Empty
|
||||
With Responser
|
||||
Dim b As Boolean = Not .UseWebClient Or Not .UseWebClientCookies Or Not .UseWebClientAdditionalHeaders
|
||||
.UseWebClient = True
|
||||
.UseWebClientCookies = True
|
||||
.UseWebClientAdditionalHeaders = True
|
||||
If .Headers.Count > 0 AndAlso .Headers.ContainsKey(TokenName) Then t = .Headers(TokenName)
|
||||
Dim b As Boolean = Not .Mode = Response.Modes.WebClient
|
||||
.Mode = Response.Modes.WebClient
|
||||
t = .HeadersValue(TokenName)
|
||||
If b Then .SaveSettings()
|
||||
End With
|
||||
NoCredentialsResponser = New Response($"{SettingsFolderName}\Responser_{RedGifsSite}_NC.xml") With {
|
||||
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey,
|
||||
.CookiesDomain = "redgifs.com"
|
||||
}
|
||||
With NoCredentialsResponser
|
||||
If .File.Exists Then
|
||||
.LoadSettings()
|
||||
Else
|
||||
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
|
||||
.SaveSettings()
|
||||
End If
|
||||
End With
|
||||
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
|
||||
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
|
||||
UrlPatternUser = "https://www.redgifs.com/users/{0}/"
|
||||
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
|
||||
ImageVideoContains = "redgifs"
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Response updater"
|
||||
Private Sub UpdateResponse(ByVal Value As String)
|
||||
With Responser.Headers
|
||||
If .Count = 0 OrElse Not .ContainsKey(TokenName) Then .Add(TokenName, Value) Else .Item(TokenName) = Value
|
||||
Responser.SaveSettings()
|
||||
End With
|
||||
Responser.HeadersAdd(TokenName, Value)
|
||||
Responser.SaveSettings()
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Token updaters"
|
||||
Friend Function UpdateTokenIfRequired() As Boolean
|
||||
Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing)
|
||||
If Not d.HasValue OrElse d.Value < Now.AddDays(-1) Then
|
||||
Return UpdateToken()
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
End Function
|
||||
<PropertyUpdater(NameOf(Token))>
|
||||
Friend Function UpdateToken() As Boolean
|
||||
Try
|
||||
Dim r$
|
||||
Dim NewToken$ = String.Empty
|
||||
Using resp As New Response : r = resp.GetResponse("https://api.redgifs.com/v2/auth/temporary",, EDP.ThrowException) : End Using
|
||||
If Not r.IsEmptyString Then
|
||||
Dim j As EContainer = JsonDocument.Parse(r)
|
||||
If Not j Is Nothing Then
|
||||
NewToken = j.Value("token")
|
||||
j.Dispose()
|
||||
End If
|
||||
End If
|
||||
If Not NewToken.IsEmptyString Then
|
||||
Token.Value = $"Bearer {NewToken}"
|
||||
TokenLastDateUpdated.Value = Now
|
||||
Return True
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.RedGifs.SiteSettings.UpdateToken]", False)
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Update settings"
|
||||
Private _LastTokenValue As String = String.Empty
|
||||
Friend Overrides Sub BeginEdit()
|
||||
_LastTokenValue = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
|
||||
MyBase.BeginEdit()
|
||||
End Sub
|
||||
Friend Overrides Sub Update()
|
||||
Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
|
||||
If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now
|
||||
MyBase.Update()
|
||||
End Sub
|
||||
Friend Overrides Sub EndEdit()
|
||||
_LastTokenValue = String.Empty
|
||||
MyBase.EndEdit()
|
||||
End Sub
|
||||
#End Region
|
||||
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
|
||||
Return New UserData
|
||||
End Function
|
||||
@@ -80,11 +150,11 @@ Namespace API.RedGifs
|
||||
End If
|
||||
Return Nothing
|
||||
End Function
|
||||
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
|
||||
Return $"https://www.redgifs.com/watch/{PostID}"
|
||||
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
|
||||
Return $"https://www.redgifs.com/watch/{Media.Post.ID}"
|
||||
End Function
|
||||
Friend Overrides Function BaseAuthExists() As Boolean
|
||||
Return If(Responser.Cookies?.Count, 0) > 0 AndAlso ACheck(Token.Value)
|
||||
Return UpdateTokenIfRequired() AndAlso ACheck(Token.Value)
|
||||
End Function
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -11,8 +11,8 @@ Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Imports UStates = SCrawler.API.Base.UserMedia.States
|
||||
Namespace API.RedGifs
|
||||
@@ -20,6 +20,11 @@ Namespace API.RedGifs
|
||||
Friend Const DataGone As HttpStatusCode = HttpStatusCode.Gone
|
||||
Private Const PostDataUrl As String = "https://api.redgifs.com/v2/gifs/{0}?views=yes&users=yes"
|
||||
#Region "Base declarations"
|
||||
Private ReadOnly Property MySettings As SiteSettings
|
||||
Get
|
||||
Return DirectCast(HOST.Source, SiteSettings)
|
||||
End Get
|
||||
End Property
|
||||
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
|
||||
End Sub
|
||||
#End Region
|
||||
@@ -29,15 +34,21 @@ Namespace API.RedGifs
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download functions"
|
||||
Private NoCredentialsResponser As Response
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
ReparseMissing(Token)
|
||||
DownloadData(1, Token)
|
||||
Try
|
||||
NoCredentialsResponser = MySettings.NoCredentialsResponser.Copy
|
||||
DownloadData(1, Token)
|
||||
Finally
|
||||
NoCredentialsResponser.Dispose()
|
||||
End Try
|
||||
End Sub
|
||||
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent&page={Page}"
|
||||
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException)
|
||||
Dim _page As Func(Of String) = Function() If(Page = 1, String.Empty, $"&page={Page}")
|
||||
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent{_page.Invoke}"
|
||||
Dim r$ = NoCredentialsResponser.GetResponse(URL,, EDP.ThrowException)
|
||||
Dim postDate$, postID$
|
||||
Dim pTotal% = 0
|
||||
If Not r.IsEmptyString Then
|
||||
@@ -51,7 +62,7 @@ Namespace API.RedGifs
|
||||
Case DateResult.Exit : Exit Sub
|
||||
End Select
|
||||
postID = g.Value("id")
|
||||
If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit For
|
||||
If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit Sub
|
||||
ObtainMedia(g, postID, postDate)
|
||||
Next
|
||||
End If
|
||||
@@ -59,7 +70,7 @@ Namespace API.RedGifs
|
||||
End If
|
||||
If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token)
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, $"data downloading error [{URL}]")
|
||||
ProcessException(ex, Token, $"data downloading error [{URL}]",, True)
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
@@ -129,7 +140,7 @@ Namespace API.RedGifs
|
||||
End If
|
||||
Catch dex As ObjectDisposedException When Disposed
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, $"missing data downloading error")
|
||||
ProcessException(ex, Token, $"missing data downloading error",, False)
|
||||
Finally
|
||||
If Not Disposed And rList.Count > 0 Then
|
||||
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
|
||||
@@ -168,7 +179,7 @@ Namespace API.RedGifs
|
||||
If Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then
|
||||
If Responser Is Nothing Then Responser = Host.Responser.Copy
|
||||
URL = String.Format(PostDataUrl, Obj.ToLower)
|
||||
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException)
|
||||
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
|
||||
If Not r.IsEmptyString Then
|
||||
Using j As EContainer = JsonDocument.Parse(r)
|
||||
If Not j Is Nothing Then
|
||||
@@ -192,9 +203,19 @@ Namespace API.RedGifs
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
If Not Responser Is Nothing AndAlso Responser.Client.StatusCode = DataGone Then _
|
||||
Return New UserMedia With {.State = DataGone}
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.RedGifs.UserData.GetDataFromUrlId({URL})]", New UserMedia)
|
||||
If Not Responser Is Nothing AndAlso (Responser.Client.StatusCode = DataGone Or Responser.Client.StatusCode = HttpStatusCode.NotFound) Then
|
||||
Return New UserMedia With {.State = DataGone}
|
||||
Else
|
||||
Dim m As New UserMedia With {.State = UStates.Missing}
|
||||
Dim _errText$ = "API.RedGifs.UserData.GetDataFromUrlId({0})"
|
||||
If Responser.Client.StatusCode = HttpStatusCode.Unauthorized Then
|
||||
_errText = $"RedGifs credentials have expired [{CInt(Responser.Client.StatusCode)}]: {_errText}"
|
||||
MyMainLOG = String.Format(_errText, URL)
|
||||
Return m
|
||||
Else
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, String.Format(_errText, URL), m)
|
||||
End If
|
||||
End If
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
@@ -218,8 +239,22 @@ Namespace API.RedGifs
|
||||
#Region "Exception"
|
||||
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
|
||||
Optional ByVal EObj As Object = Nothing) As Integer
|
||||
If Responser.StatusCode = HttpStatusCode.NotFound Then
|
||||
Dim IsNoCredentialsResponser As Boolean = AConvert(Of Boolean)(EObj, False)
|
||||
Dim s As WebExceptionStatus = -1
|
||||
Dim sc As HttpStatusCode = -1
|
||||
If IsNoCredentialsResponser Then
|
||||
If Not NoCredentialsResponser Is Nothing Then
|
||||
s = NoCredentialsResponser.Status
|
||||
sc = NoCredentialsResponser.StatusCode
|
||||
End If
|
||||
Else
|
||||
s = Responser.Client.Status
|
||||
sc = Responser.Client.StatusCode
|
||||
End If
|
||||
If sc = HttpStatusCode.NotFound Or s = DataGone Then
|
||||
UserExists = False
|
||||
ElseIf sc = HttpStatusCode.Unauthorized Then
|
||||
MyMainLOG = $"RedGifs credentials have expired [{CInt(sc)}]: {ToStringForLog()}"
|
||||
Else
|
||||
If Not FromPE Then LogError(ex, Message) : HasError = True
|
||||
Return 0
|
||||
|
||||
@@ -10,7 +10,7 @@ Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace API.TikTok
|
||||
Friend Class UserData : Inherits UserDataBase
|
||||
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
|
||||
|
||||
@@ -6,14 +6,21 @@
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Globalization
|
||||
Imports PersonalUtilities.Functions.XML.Base
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Namespace API.Twitter
|
||||
Friend Module Declarations
|
||||
Friend Const TwitterSite As String = "Twitter"
|
||||
Friend DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
|
||||
Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
|
||||
Friend ReadOnly VideoNode As NodeParams() = {New NodeParams("video_info", True, True, True, True, 10)}
|
||||
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)
|
||||
Friend ReadOnly UserIdRegEx As RParams = RParams.DMS("user_id.:.(\d+)", 1, EDP.ReturnValue)
|
||||
Private Function GetDateProvider() As ADateTime
|
||||
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
|
||||
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"
|
||||
n.TimeSeparator = String.Empty
|
||||
Return New ADateTime(DirectCast(n.Clone, DateTimeFormatInfo)) With {.DateTimeStyle = DateTimeStyles.AssumeUniversal}
|
||||
End Function
|
||||
End Module
|
||||
End Namespace
|
||||
@@ -9,8 +9,9 @@
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.Plugin
|
||||
Imports SCrawler.Plugin.Attributes
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Cookies
|
||||
Namespace API.Twitter
|
||||
<Manifest("AndyProgram_Twitter"), SavedPosts>
|
||||
Friend Class SiteSettings : Inherits SiteSettingsBase
|
||||
@@ -31,7 +32,7 @@ Namespace API.Twitter
|
||||
Private ReadOnly Property Auth As PropertyValue
|
||||
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")>
|
||||
Private ReadOnly Property Token As PropertyValue
|
||||
<PropertyOption(ControlText:="Saved posts user name", ControlToolTip:="Personal profile username", LeftOffset:=120), PXML>
|
||||
<PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
|
||||
Friend ReadOnly Property SavedPostsUserName As PropertyValue
|
||||
Friend Overrides ReadOnly Property Responser As Response
|
||||
Friend Sub New()
|
||||
@@ -45,10 +46,8 @@ Namespace API.Twitter
|
||||
If .File.Exists Then
|
||||
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
|
||||
.LoadSettings()
|
||||
With .Headers
|
||||
If .ContainsKey(Header_Authorization) Then a = .Item(Header_Authorization)
|
||||
If .ContainsKey(Header_Token) Then t = .Item(Header_Token)
|
||||
End With
|
||||
a = .HeadersValue(Header_Authorization)
|
||||
t = .HeadersValue(Header_Token)
|
||||
Else
|
||||
.ContentType = "application/json"
|
||||
.Accept = "*/*"
|
||||
@@ -56,17 +55,15 @@ Namespace API.Twitter
|
||||
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
|
||||
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
|
||||
.Decoders.Add(SymbolsConverter.Converters.Unicode)
|
||||
With .Headers
|
||||
.Add("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
|
||||
.Add("sec-ch-ua-mobile", "?0")
|
||||
.Add("sec-fetch-dest", "empty")
|
||||
.Add("sec-fetch-mode", "cors")
|
||||
.Add("sec-fetch-site", "same-origin")
|
||||
.Add(Header_Token, String.Empty)
|
||||
.Add("x-twitter-active-user", "yes")
|
||||
.Add("x-twitter-auth-type", "OAuth2Session")
|
||||
.Add(Header_Authorization, String.Empty)
|
||||
End With
|
||||
.HeadersAdd("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
|
||||
.HeadersAdd("sec-ch-ua-mobile", "?0")
|
||||
.HeadersAdd("sec-fetch-dest", "empty")
|
||||
.HeadersAdd("sec-fetch-mode", "cors")
|
||||
.HeadersAdd("sec-fetch-site", "same-origin")
|
||||
.HeadersAdd(Header_Token, String.Empty)
|
||||
.HeadersAdd("x-twitter-active-user", "yes")
|
||||
.HeadersAdd("x-twitter-auth-type", "OAuth2Session")
|
||||
.HeadersAdd(Header_Authorization, String.Empty)
|
||||
.SaveSettings()
|
||||
End If
|
||||
End With
|
||||
@@ -87,8 +84,8 @@ Namespace API.Twitter
|
||||
Case NameOf(Token) : f = Header_Token
|
||||
End Select
|
||||
If Not f.IsEmptyString Then
|
||||
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
|
||||
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
|
||||
Responser.HeadersRemove(f)
|
||||
If Not CStr(Value).IsEmptyString Then Responser.HeadersAdd(f, CStr(Value))
|
||||
Responser.SaveSettings()
|
||||
End If
|
||||
End If
|
||||
@@ -103,8 +100,8 @@ Namespace API.Twitter
|
||||
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
|
||||
Return UserData.GetVideoInfo(URL, Responser)
|
||||
End Function
|
||||
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
|
||||
Return $"https://twitter.com/{UserID}/status/{PostID}"
|
||||
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
|
||||
Return $"https://twitter.com/{User.Name}/status/{Media.Post.ID}"
|
||||
End Function
|
||||
Friend Overrides Function BaseAuthExists() As Boolean
|
||||
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(Token.Value) And ACheck(Auth.Value)
|
||||
|
||||
@@ -11,8 +11,8 @@ Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports UStates = SCrawler.API.Base.UserMedia.States
|
||||
Namespace API.Twitter
|
||||
Friend Class UserData : Inherits UserDataBase
|
||||
@@ -355,18 +355,20 @@ Namespace API.Twitter
|
||||
#Region "Exception"
|
||||
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
|
||||
Optional ByVal EObj As Object = Nothing) As Integer
|
||||
If Responser.StatusCode = HttpStatusCode.NotFound Then
|
||||
UserExists = False
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.Unauthorized Then
|
||||
UserSuspended = True
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
|
||||
MyMainLOG = "Twitter has invalid credentials"
|
||||
ElseIf Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
|
||||
MyMainLOG = $"Twitter is currently unavailable ({ToString()})"
|
||||
Else
|
||||
If Not FromPE Then LogError(ex, Message) : HasError = True
|
||||
Return 0
|
||||
End If
|
||||
With Responser
|
||||
If .StatusCode = HttpStatusCode.NotFound Then
|
||||
UserExists = False
|
||||
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then
|
||||
UserSuspended = True
|
||||
ElseIf .StatusCode = HttpStatusCode.BadRequest Then
|
||||
MyMainLOG = "Twitter has invalid credentials"
|
||||
ElseIf .StatusCode = HttpStatusCode.ServiceUnavailable Or .StatusCode = HttpStatusCode.InternalServerError Then
|
||||
MyMainLOG = $"[{CInt(.StatusCode)}] Twitter is currently unavailable ({ToString()})"
|
||||
Else
|
||||
If Not FromPE Then LogError(ex, Message) : HasError = True
|
||||
Return 0
|
||||
End If
|
||||
End With
|
||||
Return 1
|
||||
End Function
|
||||
#End Region
|
||||
|
||||
@@ -8,9 +8,10 @@
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Forms
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.Messaging
|
||||
Imports PersonalUtilities.Tools
|
||||
Namespace API
|
||||
Friend Class UserDataBind : Inherits UserDataBase : Implements ICollection(Of IUserData), IMyEnumerator(Of IUserData)
|
||||
#Region "Events"
|
||||
@@ -20,6 +21,17 @@ Namespace API
|
||||
#Region "Declarations"
|
||||
Friend ReadOnly Property Collections As List(Of IUserData)
|
||||
#Region "Base class overrides"
|
||||
Friend Overrides ReadOnly Property IsVirtual As Boolean
|
||||
Get
|
||||
Return CollectionModel = UsageModel.Virtual
|
||||
End Get
|
||||
End Property
|
||||
Friend Overrides ReadOnly Property CollectionModel As UsageModel
|
||||
Get
|
||||
If Count > 0 Then Return Item(0).CollectionModel Else Return UsageModel.Default
|
||||
End Get
|
||||
End Property
|
||||
Friend Property CurrentlyEdited As Boolean = False
|
||||
Private _CollectionName As String = String.Empty
|
||||
Friend Overrides Property CollectionName As String
|
||||
Get
|
||||
@@ -80,10 +92,13 @@ Namespace API
|
||||
End Sub
|
||||
Friend Overrides Function GetUserPicture() As Image
|
||||
If Count > 0 Then
|
||||
Return Collections(0).GetPicture
|
||||
Else
|
||||
Return GetNullPicture(Settings.MaxLargeImageHeight)
|
||||
Dim img As Image
|
||||
For Each u As UserDataBase In Collections
|
||||
img = u.GetPicture(Of Image)(False)
|
||||
If Not img Is Nothing Then Return img
|
||||
Next
|
||||
End If
|
||||
Return GetNullPicture(Settings.MaxLargeImageHeight)
|
||||
End Function
|
||||
#End Region
|
||||
Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
|
||||
@@ -102,7 +117,15 @@ Namespace API
|
||||
End Property
|
||||
Friend Overrides Property MyFile As SFile
|
||||
Get
|
||||
If Count > 0 Then Return Collections(0).File Else Return Nothing
|
||||
If Count > 0 Then
|
||||
If IsVirtual Then
|
||||
Return GetRealUserFile.IfNullOrEmpty(Collections(0).File)
|
||||
Else
|
||||
Return Collections(0).File
|
||||
End If
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal NewFile As SFile)
|
||||
End Set
|
||||
@@ -120,8 +143,8 @@ Namespace API
|
||||
End Property
|
||||
Friend Overrides Property DataMerging As Boolean
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return DirectCast(Collections(0), UserDataBase).DataMerging
|
||||
If Count > 0 AndAlso Collections.Exists(RealUser) Then
|
||||
Return DirectCast(Collections.Find(RealUser), UserDataBase).DataMerging
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
@@ -184,6 +207,7 @@ Namespace API
|
||||
End Property
|
||||
Friend Overrides Function GetUserInformation() As String
|
||||
Dim OutStr$ = String.Empty
|
||||
If IsVirtual Then OutStr = "This is a virtual collection."
|
||||
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), vbNewLine.StringDup(2)))
|
||||
Return OutStr
|
||||
End Function
|
||||
@@ -346,12 +370,36 @@ Namespace API
|
||||
If Not e.Exists Then e = New ErrorsDescriber(EDP.SendInLog)
|
||||
If Count > 0 Then Collections.ForEach(Sub(c) c.OpenSite(e))
|
||||
End Sub
|
||||
Private ReadOnly RealUser As Predicate(Of IUserData) = Function(u) u.UserModel = UsageModel.Default
|
||||
Friend Overrides Sub OpenFolder()
|
||||
Try
|
||||
If Count > 0 Then GlobalOpenPath(Collections(0).File.CutPath(2))
|
||||
If Count > 0 Then
|
||||
Dim i% = Collections.FindIndex(RealUser)
|
||||
If i = -1 Then i = 0
|
||||
If i >= 0 Then
|
||||
If IsVirtual Or Collections(i).UserModel = UsageModel.Virtual Then
|
||||
Collections(i).OpenFolder()
|
||||
Else
|
||||
GlobalOpenPath(Collections(i).File.CutPath(2))
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
End Sub
|
||||
Friend Function GetRealUserFile() As SFile
|
||||
Dim i% = -1
|
||||
If Count > 0 Then i = Collections.FindIndex(RealUser)
|
||||
If i >= 0 Then Return Collections(i).File Else Return Nothing
|
||||
End Function
|
||||
Friend Function GetRealUserSpecialCollectionPath()
|
||||
Dim _SpecialCollectionPath As SFile = Nothing
|
||||
If Count > 0 And Not IsVirtual Then
|
||||
Dim _RealUser As UserDataBase = Collections.Find(RealUser)
|
||||
If Not _RealUser Is Nothing Then _SpecialCollectionPath = _RealUser.User.SpecialCollectionPath
|
||||
End If
|
||||
Return _SpecialCollectionPath
|
||||
End Function
|
||||
#End Region
|
||||
#Region "ICollection Support"
|
||||
Private ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of IUserData).IsReadOnly
|
||||
@@ -386,8 +434,8 @@ Namespace API
|
||||
''' <exception cref="InvalidOperationException"></exception>
|
||||
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
|
||||
With _Item
|
||||
If .MoveFiles(CollectionName) Then
|
||||
If DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
|
||||
If .MoveFiles(CollectionName, GetRealUserSpecialCollectionPath()) Then
|
||||
If Not _Item.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
|
||||
Collections.Add(_Item)
|
||||
With Collections.Last
|
||||
If Count > 1 Then
|
||||
@@ -445,14 +493,9 @@ Namespace API
|
||||
Private Sub ConsolidateScripts()
|
||||
If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True)
|
||||
End Sub
|
||||
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
|
||||
If _Items.ListExists Then
|
||||
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
|
||||
End If
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Move, Merge"
|
||||
Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean
|
||||
Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean
|
||||
Throw New NotImplementedException("Move files is not available in the collection context")
|
||||
End Function
|
||||
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
|
||||
@@ -488,52 +531,69 @@ Namespace API
|
||||
"Operation canceled", MsgBoxStyle.Critical)
|
||||
Return False
|
||||
Else
|
||||
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty)
|
||||
_Item.MoveFiles(String.Empty, Nothing)
|
||||
MainFrameObj.ImageHandler(_Item)
|
||||
AddRemoveBttDeleteHandler(_Item, False)
|
||||
RaiseEvent OnUserRemoved(_Item)
|
||||
Return Collections.Remove(_Item)
|
||||
End If
|
||||
End Function
|
||||
Friend Overrides Function Delete(Optional ByVal Multiple As Boolean = False) As Integer
|
||||
Friend Overrides Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
|
||||
If Count > 0 Then
|
||||
Const MsgTitle$ = "Deleting a collection"
|
||||
Dim f As SFile
|
||||
Dim f As SFile = Nothing
|
||||
If Not IsVirtual Then
|
||||
f = GetRealUserFile()
|
||||
If Not f.IsEmptyString Then f = f.CutPath(IIf(DataMerging, 1, 2))
|
||||
End If
|
||||
Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr &
|
||||
"Are you sure you want to delete the collection and all of its files?", MsgTitle,
|
||||
{New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files"},
|
||||
{New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files", .KeyCode = Keys.Enter},
|
||||
New MsgBoxButton("Split") With {
|
||||
.ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr &
|
||||
"All user data will remain."},
|
||||
"All user data will remain.",
|
||||
.KeyCode = New ButtonKey(Keys.Enter, True)},
|
||||
"Cancel"}, vbExclamation)
|
||||
Select Case If(Multiple, 0, MsgBoxE(m).Index)
|
||||
Dim v%
|
||||
If CollectionValue >= 0 Then
|
||||
v = CollectionValue
|
||||
ElseIf Multiple Then
|
||||
v = 0
|
||||
Else
|
||||
v = MsgBoxE(m)
|
||||
End If
|
||||
Select Case v
|
||||
Case 0
|
||||
f = Collections(0).File.CutPath(IIf(DataMerging, 1, 2)).PathWithSeparator
|
||||
Settings.Users.Remove(Me)
|
||||
Collections.ForEach(Sub(c) c.Delete())
|
||||
Downloader.UserRemove(Me)
|
||||
MainFrameObj.ImageHandler(Me, False)
|
||||
Collections.ListClearDispose
|
||||
Dispose(False)
|
||||
f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
|
||||
Return 2
|
||||
If Collections.All(Function(c As UserDataBase) c.Disposed) Then
|
||||
Settings.Users.Remove(Me)
|
||||
Downloader.UserRemove(Me)
|
||||
MainFrameObj.ImageHandler(Me, False)
|
||||
Collections.ListClearDispose
|
||||
Dispose(False)
|
||||
If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
|
||||
Return 2
|
||||
End If
|
||||
Case 1
|
||||
If DataMerging Then
|
||||
MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation)
|
||||
Return 0
|
||||
Else
|
||||
f = Collections(0).File.CutPath(2)
|
||||
Settings.Users.Remove(Me)
|
||||
Collections.ForEach(Sub(c)
|
||||
c.MoveFiles(String.Empty)
|
||||
MainFrameObj.ImageHandler(c)
|
||||
Collections.ForEach(Sub(ByVal c As IUserData)
|
||||
If c.MoveFiles(String.Empty, Nothing) Then
|
||||
UserListLoader.UpdateUser(Settings.GetUser(c), True)
|
||||
MainFrameObj.ImageHandler(c)
|
||||
End If
|
||||
End Sub)
|
||||
Collections.Clear()
|
||||
f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
|
||||
Downloader.UserRemove(Me)
|
||||
MainFrameObj.ImageHandler(Me, False)
|
||||
Dispose(False)
|
||||
Return 3
|
||||
If Collections.All(Function(c) c.CollectionName.IsEmptyString) Then
|
||||
Settings.Users.Remove(Me)
|
||||
Collections.Clear()
|
||||
If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
|
||||
Downloader.UserRemove(Me)
|
||||
MainFrameObj.ImageHandler(Me, False)
|
||||
Dispose(False)
|
||||
Return 3
|
||||
End If
|
||||
End If
|
||||
Case Else : If Not Multiple Then MsgBoxE({"Operation canceled", MsgTitle})
|
||||
End Select
|
||||
@@ -562,9 +622,11 @@ Namespace API
|
||||
"Deleting a user"}, vbExclamation,,,
|
||||
{
|
||||
New MsgBoxButton("Remove") With {
|
||||
.ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program."},
|
||||
.ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program.",
|
||||
.KeyCode = Keys.Enter},
|
||||
New MsgBoxButton("Delete") With {
|
||||
.ToolTip = "Delete a user from the collection and erase their data."},
|
||||
.ToolTip = "Delete a user from the collection and erase their data.",
|
||||
.KeyCode = New ButtonKey(Keys.Enter, True)},
|
||||
"Cancel"
|
||||
}).Index
|
||||
Case 0
|
||||
|
||||
@@ -10,10 +10,13 @@ Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Namespace API.XVIDEOS
|
||||
Friend Module Declarations
|
||||
Friend Const XvideosSiteKey As String = "AndyProgram_XVIDEOS"
|
||||
Friend ReadOnly Property M3U8Regex As RParams = RParams.DM("http.+?.m3u8.*?(?=')", 0)
|
||||
Friend ReadOnly Property VideoTitleRegex As RParams = RParams.DMS("html5player.setVideoTitle\('(.+)(?='\);)", 1)
|
||||
Friend ReadOnly Property VideoID As RParams = RParams.DMS(".*?www.xvideos.com/(video\d+).*", 1)
|
||||
Friend ReadOnly Property M3U8Reparse As RParams = RParams.DM("NAME=""(\d+).*?""[\r\n]*?(.+)(?=(|[\r\n]+?))", 0, RegexReturn.List)
|
||||
Friend ReadOnly Property M3U8Appender As RParams = RParams.DM("(.+)(?=/.+?\.m3u8.*?)", 0)
|
||||
Private ReadOnly HtmlConverter As Func(Of String, String) = Function(Input) SymbolsConverter.HTML.Decode(Input, EDP.ReturnValue)
|
||||
Friend ReadOnly Regex_M3U8 As RParams = RParams.DM("http.+?.m3u8.*?(?=')", 0)
|
||||
Friend ReadOnly Regex_VideoTitle As RParams = RParams.DMS("html5player.setVideoTitle\('(.+)(?='\);)", 1, EDP.ReturnValue, HtmlConverter)
|
||||
Friend ReadOnly Regex_VideoID As RParams = RParams.DMS(".*?www.xvideos.com/(video\d+).*", 1)
|
||||
Friend ReadOnly Regex_M3U8_Reparse As RParams = RParams.DM("NAME=""(\d+).*?""[\r\n]*?(.+)(?=(|[\r\n]+?))", 0, RegexReturn.List)
|
||||
Friend ReadOnly Regex_M3U8_Appender As RParams = RParams.DM("(.+)(?=/.+?\.m3u8.*?)", 0)
|
||||
Friend ReadOnly Regex_SavedVideosPlaylist As RParams = RParams.DM("<div id=""video.+?data-id=""(\d+).+?a href=""([^""]+)"".+?title=""([^""]*)""",
|
||||
0, RegexReturn.List, EDP.ReturnValue, HtmlConverter)
|
||||
End Module
|
||||
End Namespace
|
||||
@@ -7,44 +7,11 @@
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Net
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Namespace API.XVIDEOS
|
||||
Friend NotInheritable Class M3U8
|
||||
Private Sub New()
|
||||
End Sub
|
||||
Private Shared Function Save(ByVal URLs As List(Of String), ByVal ffmpegFile As SFile, ByVal f As SFile) As SFile
|
||||
Dim CachePath As SFile = Nothing
|
||||
Try
|
||||
If URLs.ListExists Then
|
||||
Dim ConcatFile As SFile = f
|
||||
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
|
||||
ConcatFile.Extension = "mp4"
|
||||
CachePath = $"{f.PathWithSeparator}_Cache\{SFile.GetDirectories($"{f.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\"
|
||||
If CachePath.Exists(SFO.Path) Then
|
||||
Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General})
|
||||
ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ReturnValue)
|
||||
Dim i%
|
||||
Dim eFiles As New List(Of SFile)
|
||||
Dim dFile As SFile = CachePath
|
||||
dFile.Extension = "ts"
|
||||
Using w As New WebClient
|
||||
For i = 0 To URLs.Count - 1
|
||||
dFile.Name = $"ConPart_{i}"
|
||||
w.DownloadFile(URLs(i), dFile)
|
||||
eFiles.Add(dFile)
|
||||
Next
|
||||
End Using
|
||||
f = FFMPEG.ConcatenateFiles(eFiles, ffmpegFile, ConcatFile, p, EDP.ThrowException)
|
||||
eFiles.Clear()
|
||||
Return f
|
||||
End If
|
||||
End If
|
||||
Return Nothing
|
||||
Finally
|
||||
CachePath.Delete(SFO.Path, SFODelete.None, EDP.None)
|
||||
End Try
|
||||
End Function
|
||||
Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal ffmpegFile As SFile, ByVal f As SFile) As SFile
|
||||
Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal f As SFile) As SFile
|
||||
Try
|
||||
If Not URL.IsEmptyString Then
|
||||
Using w As New WebClient
|
||||
@@ -52,13 +19,13 @@ Namespace API.XVIDEOS
|
||||
If Not r.IsEmptyString Then
|
||||
Dim l As List(Of String) = ListAddList(Nothing, r.StringFormatLines.StringToList(Of String)(vbNewLine).ListWithRemove(Function(v) v.Trim.StartsWith("#")),
|
||||
New ListAddParams With {.Converter = Function(Input) $"{Appender}/{Input.ToString.Trim}"})
|
||||
If l.ListExists Then Return Save(l, ffmpegFile, f)
|
||||
If l.ListExists Then Return Base.M3U8Base.Download(l, f)
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[M3U8.Download({URL}, {Appender}, {ffmpegFile}, {f})]")
|
||||
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[M3U8.Download({URL}, {Appender}, {f})]")
|
||||
Throw ex
|
||||
End Try
|
||||
End Function
|
||||
|
||||
80
SCrawler/API/XVIDEOS/SettingsForm.Designer.vb
generated
@@ -1,80 +0,0 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Namespace API.XVIDEOS
|
||||
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
|
||||
Partial Friend Class SettingsForm : Inherits System.Windows.Forms.Form
|
||||
<System.Diagnostics.DebuggerNonUserCode()>
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
Try
|
||||
If disposing AndAlso components IsNot Nothing Then
|
||||
components.Dispose()
|
||||
End If
|
||||
Finally
|
||||
MyBase.Dispose(disposing)
|
||||
End Try
|
||||
End Sub
|
||||
Private components As System.ComponentModel.IContainer
|
||||
<System.Diagnostics.DebuggerStepThrough()>
|
||||
Private Sub InitializeComponent()
|
||||
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
|
||||
Me.LIST_DOMAINS = New System.Windows.Forms.ListBox()
|
||||
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
|
||||
CONTAINER_MAIN.ContentPanel.SuspendLayout()
|
||||
CONTAINER_MAIN.SuspendLayout()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'CONTAINER_MAIN
|
||||
'
|
||||
'
|
||||
'CONTAINER_MAIN.ContentPanel
|
||||
'
|
||||
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.LIST_DOMAINS)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 241)
|
||||
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
CONTAINER_MAIN.LeftToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
|
||||
CONTAINER_MAIN.RightToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(384, 291)
|
||||
CONTAINER_MAIN.TabIndex = 0
|
||||
'
|
||||
'LIST_DOMAINS
|
||||
'
|
||||
Me.LIST_DOMAINS.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.LIST_DOMAINS.FormattingEnabled = True
|
||||
Me.LIST_DOMAINS.Location = New System.Drawing.Point(0, 0)
|
||||
Me.LIST_DOMAINS.Name = "LIST_DOMAINS"
|
||||
Me.LIST_DOMAINS.Size = New System.Drawing.Size(384, 241)
|
||||
Me.LIST_DOMAINS.TabIndex = 0
|
||||
'
|
||||
'SettingsForm
|
||||
'
|
||||
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(384, 291)
|
||||
Me.Controls.Add(CONTAINER_MAIN)
|
||||
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
|
||||
Me.Icon = Global.SCrawler.My.Resources.SiteResources.XvideosIcon_48
|
||||
Me.KeyPreview = True
|
||||
Me.MaximizeBox = False
|
||||
Me.MaximumSize = New System.Drawing.Size(400, 330)
|
||||
Me.MinimizeBox = False
|
||||
Me.MinimumSize = New System.Drawing.Size(400, 330)
|
||||
Me.Name = "SettingsForm"
|
||||
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
|
||||
Me.Text = "Settings"
|
||||
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
|
||||
CONTAINER_MAIN.ResumeLayout(False)
|
||||
CONTAINER_MAIN.PerformLayout()
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
Private WithEvents LIST_DOMAINS As Windows.Forms.ListBox
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -1,70 +0,0 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Forms
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Namespace API.XVIDEOS
|
||||
Friend Class SettingsForm
|
||||
Private Const SettingsDesignXmlNode As String = "XvideosSettingsForm"
|
||||
Private WithEvents MyDefs As DefaultFormOptions
|
||||
Private ReadOnly Property Source As SiteSettings
|
||||
Friend Sub New(ByRef s As SiteSettings)
|
||||
InitializeComponent()
|
||||
Source = s
|
||||
MyDefs = New DefaultFormOptions(Me, Settings.Design)
|
||||
End Sub
|
||||
Private Sub SettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
|
||||
With MyDefs
|
||||
If Not Settings.Design.Contains(SettingsDesignXmlNode) Then Settings.Design.Add(SettingsDesignXmlNode, String.Empty)
|
||||
.MyViewInitialize(Me, Settings.Design(SettingsDesignXmlNode), True)
|
||||
.AddEditToolbar()
|
||||
.AddOkCancelToolbar()
|
||||
If Source.Domains.Count > 0 Then Source.Domains.ForEach(Sub(d) LIST_DOMAINS.Items.Add(d))
|
||||
.EndLoaderOperations()
|
||||
End With
|
||||
End Sub
|
||||
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
|
||||
Source.Domains.Clear()
|
||||
With LIST_DOMAINS
|
||||
If .Items.Count > 0 Then
|
||||
For Each i In .Items : Source.Domains.Add(i.ToString) : Next
|
||||
End If
|
||||
End With
|
||||
Source.UpdateDomains()
|
||||
MyDefs.CloseForm()
|
||||
End Sub
|
||||
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
|
||||
Dim nd$ = InputBoxE("Enter a new domain using the pattern [xvideos.com]:", "New domain")
|
||||
If Not nd.IsEmptyString Then
|
||||
If Not LIST_DOMAINS.Items.Contains(nd) Then
|
||||
LIST_DOMAINS.Items.Add(nd)
|
||||
Else
|
||||
MsgBoxE($"The domain [{nd}] already added")
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
|
||||
Const MsgTitle$ = "Removing domains"
|
||||
If _LatestSelected.ValueBetween(0, LIST_DOMAINS.Items.Count - 1) Then
|
||||
Dim n$ = LIST_DOMAINS.Items(_LatestSelected)
|
||||
If MsgBoxE({$"Are you sure you want to delete the [{n}] domain?", MsgTitle}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
|
||||
LIST_DOMAINS.Items.RemoveAt(_LatestSelected)
|
||||
MsgBoxE({$"Domain [{n}] removed", MsgTitle})
|
||||
Else
|
||||
MsgBoxE({"Operation canceled", MsgTitle})
|
||||
End If
|
||||
Else
|
||||
MsgBoxE({"No domain selected", MsgTitle}, vbExclamation)
|
||||
End If
|
||||
End Sub
|
||||
Private _LatestSelected As Integer = -1
|
||||
Private Sub LIST_DOMENS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_DOMAINS.SelectedIndexChanged
|
||||
_LatestSelected = LIST_DOMAINS.SelectedIndex
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -7,15 +7,16 @@
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.API.BaseObjects
|
||||
Imports SCrawler.Plugin
|
||||
Imports SCrawler.Plugin.Attributes
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace API.XVIDEOS
|
||||
<Manifest(XvideosSiteKey), SpecialForm(True)>
|
||||
Friend Class SiteSettings : Inherits SiteSettingsBase
|
||||
#Region "Images"
|
||||
Friend Overrides ReadOnly Property Icon As Icon
|
||||
<Manifest(XvideosSiteKey), SavedPosts, SpecialForm(True), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
|
||||
Friend Class SiteSettings : Inherits SiteSettingsBase : Implements IDomainContainer
|
||||
#Region "Declarations"
|
||||
Friend Overrides ReadOnly Property Icon As Icon Implements IDomainContainer.Icon
|
||||
Get
|
||||
Return My.Resources.SiteResources.XvideosIcon_48
|
||||
End Get
|
||||
@@ -25,58 +26,87 @@ Namespace API.XVIDEOS
|
||||
Return My.Resources.SiteResources.XvideosPic_32
|
||||
End Get
|
||||
End Property
|
||||
#Region "Domains"
|
||||
Private ReadOnly Property IDomainContainer_Site As String Implements IDomainContainer.Site
|
||||
Get
|
||||
Return Site
|
||||
End Get
|
||||
End Property
|
||||
<PXML("Domains")> Private ReadOnly Property SiteDomains As PropertyValue Implements IDomainContainer.DomainsSettingProp
|
||||
Friend ReadOnly Property Domains As List(Of String) Implements IDomainContainer.Domains
|
||||
Private ReadOnly Property DomainsTemp As List(Of String) Implements IDomainContainer.DomainsTemp
|
||||
Private Property DomainsChanged As Boolean = False Implements IDomainContainer.DomainsChanged
|
||||
Private ReadOnly Property DomainsDefault As String = "xvideos.com|xnxx.com" Implements IDomainContainer.DomainsDefault
|
||||
#End Region
|
||||
#Region "Declarations"
|
||||
<PXML("Domains")> Private Property SiteDomains As PropertyValue
|
||||
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
|
||||
Public Property DownloadUHD As PropertyValue
|
||||
Friend ReadOnly Property Domains As List(Of String)
|
||||
Private Const DomainsDefault As String = "xvideos.com|xnxx.com"
|
||||
Private _Initialized As Boolean = False
|
||||
Friend Property DownloadUHD As PropertyValue
|
||||
Private Property Initialized As Boolean = False Implements IDomainContainer.Initialized
|
||||
<PropertyOption(ControlText:="Playlist of saved videos",
|
||||
ControlToolTip:="Your personal videos playlist to download as 'saved posts'. " & vbCr &
|
||||
"This playlist must be private (Visibility = 'Only me'). It also required cookies." & vbCr &
|
||||
"This playlist must be entered by pattern: https://www.xvideos.com/favorite/01234567/playlistname.",
|
||||
LeftOffset:=130), PXML>
|
||||
Friend ReadOnly Property SavedVideosPlaylist As PropertyValue
|
||||
#End Region
|
||||
#Region "Initializer"
|
||||
Friend Sub New()
|
||||
MyBase.New("XVIDEOS", "www.xvideos.com")
|
||||
Responser.DeclaredError = EDP.ThrowException
|
||||
Domains = New List(Of String)
|
||||
DomainsTemp = New List(Of String)
|
||||
SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
|
||||
DownloadUHD = New PropertyValue(False)
|
||||
SavedVideosPlaylist = New PropertyValue(String.Empty, GetType(String))
|
||||
End Sub
|
||||
Friend Overrides Sub EndInit()
|
||||
_Initialized = True
|
||||
UpdateDomains()
|
||||
Initialized = True
|
||||
DomainContainer.EndInit(Me)
|
||||
DomainsTemp.ListAddList(Domains)
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Update"
|
||||
Private _DomainsUpdateInProgress As Boolean = False
|
||||
Friend Sub UpdateDomains()
|
||||
If Not _Initialized Then Exit Sub
|
||||
If Not _DomainsUpdateInProgress Then
|
||||
_DomainsUpdateInProgress = True
|
||||
If Not ACheck(SiteDomains.Value) Then SiteDomains.Value = DomainsDefault
|
||||
Domains.ListAddList(CStr(SiteDomains.Value).Split("|"), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
Domains.ListAddList(DomainsDefault.Split("|"), LAP.NotContainsOnly)
|
||||
SiteDomains.Value = Domains.ListToString("|")
|
||||
_DomainsUpdateInProgress = False
|
||||
End If
|
||||
#Region "Edit"
|
||||
Private Property DomainsUpdateInProgress As Boolean = False Implements IDomainContainer.DomainsUpdateInProgress
|
||||
Private Property DomainsUpdatedBySite As Boolean = False Implements IDomainContainer.DomainsUpdatedBySite
|
||||
Friend Sub UpdateDomains() Implements IDomainContainer.UpdateDomains
|
||||
DomainContainer.UpdateDomains(Me)
|
||||
End Sub
|
||||
Friend Overrides Sub Update()
|
||||
UpdateDomains()
|
||||
DomainContainer.Update(Me)
|
||||
Responser.SaveSettings()
|
||||
End Sub
|
||||
Friend Overrides Sub EndEdit()
|
||||
DomainContainer.EndEdit(Me)
|
||||
MyBase.EndEdit()
|
||||
End Sub
|
||||
Friend Overrides Sub OpenSettingsForm()
|
||||
DomainContainer.OpenSettingsForm(Me)
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download"
|
||||
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
|
||||
Return New UserData
|
||||
If What = ISiteSettings.Download.SavedPosts Then
|
||||
Return New UserData With {.IsSavedPosts = True, .User = New UserInfo With {.Name = "XVIDEOS"}}
|
||||
Else
|
||||
Return New UserData
|
||||
End If
|
||||
End Function
|
||||
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
|
||||
Return Settings.UseM3U8
|
||||
If Settings.UseM3U8 Then
|
||||
If What = ISiteSettings.Download.SavedPosts Then
|
||||
Return ACheck(SavedVideosPlaylist.Value) And If(Responser.Cookies?.Count, 0) > 0
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Function
|
||||
#End Region
|
||||
#Region "User: get, check"
|
||||
Friend Overrides Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String
|
||||
Dim user$ = UserName.Split("_").FirstOrDefault
|
||||
user &= $"/{UserName.Replace($"{user}_", String.Empty)}"
|
||||
Return user
|
||||
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
|
||||
Dim __user$ = User.Name.Split("_").FirstOrDefault
|
||||
__user &= $"/{User.Name.Replace($"{User}_", String.Empty)}"
|
||||
Return __user
|
||||
End Function
|
||||
Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)"
|
||||
Private Const URD As String = ".*?{0}{1}"
|
||||
@@ -84,9 +114,10 @@ Namespace API.XVIDEOS
|
||||
If Not UserURL.IsEmptyString Then
|
||||
If Domains.Count > 0 Then
|
||||
Dim uName$, uOpt$, fStr$
|
||||
Dim uErr As New ErrorsDescriber(EDP.ReturnValue)
|
||||
For i% = 0 To Domains.Count - 1
|
||||
fStr = String.Format(URD, Domains(i), UserRegexDefault)
|
||||
uName = RegexReplace(UserURL, RParams.DMS(fStr, 2))
|
||||
uName = RegexReplace(UserURL, RParams.DMS(fStr, 2, uErr))
|
||||
If Not uName.IsEmptyString Then
|
||||
uOpt = RegexReplace(UserURL, RParams.DMS(fStr, 1))
|
||||
If Not uOpt.IsEmptyString Then Return New ExchangeOptions(Site, $"{uOpt}_{uName}")
|
||||
@@ -97,11 +128,6 @@ Namespace API.XVIDEOS
|
||||
Return Nothing
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Settings"
|
||||
Friend Overrides Sub OpenSettingsForm()
|
||||
Using f As New SettingsForm(Me) : f.ShowDialog() : End Using
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Get special data"
|
||||
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
|
||||
If Not URL.IsEmptyString And Domains.Count > 0 Then
|
||||
|
||||
@@ -10,12 +10,29 @@ Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports UStates = SCrawler.API.Base.UserMedia.States
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Namespace API.XVIDEOS
|
||||
Friend Class UserData : Inherits UserDataBase
|
||||
Private Structure PlayListVideo : Implements IRegExCreator
|
||||
Friend ID As String
|
||||
Friend URL As String
|
||||
Friend Title As String
|
||||
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
|
||||
If ParamsArray.ListExists(3) Then
|
||||
ID = ParamsArray(0)
|
||||
URL = ParamsArray(1)
|
||||
If Not URL.IsEmptyString Then URL = $"https://www.xvideos.com/{URL.StringTrimStart("/")}"
|
||||
Title = ParamsArray(2).StringRemoveWinForbiddenSymbols.StringTrim
|
||||
End If
|
||||
Return Me
|
||||
End Function
|
||||
Friend Function ToUserMedia() As UserMedia
|
||||
Return New UserMedia(URL, UTypes.VideoPre) With {.Object = Me, .PictureOption = Title, .Post = ID}
|
||||
End Function
|
||||
End Structure
|
||||
Private ReadOnly Property MySettings As SiteSettings
|
||||
Get
|
||||
Return DirectCast(HOST.Source, SiteSettings)
|
||||
@@ -28,71 +45,74 @@ Namespace API.XVIDEOS
|
||||
UseInternalM3U8Function = True
|
||||
End Sub
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
If Not Settings.UseM3U8 Then
|
||||
If Not Settings.OS64 Then
|
||||
MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
|
||||
Else
|
||||
MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
|
||||
End If
|
||||
Exit Sub
|
||||
End If
|
||||
If IsSavedPosts Then
|
||||
If Not ACheck(MySettings.SavedVideosPlaylist.Value) Then Throw New ArgumentNullException("SavedVideosPlaylist", "Playlist of saved videos cannot be null")
|
||||
DownloadSavedVideos(Token)
|
||||
Else
|
||||
DownloadUserVideo(Token)
|
||||
End If
|
||||
End Sub
|
||||
Private Sub DownloadUserVideo(ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
If Not Settings.UseM3U8 Then
|
||||
If Not Settings.OS64 Then
|
||||
MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
|
||||
Else
|
||||
MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
|
||||
End If
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim NextPage% = 0
|
||||
Dim r$
|
||||
Dim j As EContainer = Nothing
|
||||
Dim jj As EContainer
|
||||
Dim e As ErrorsDescriber = EDP.ThrowException
|
||||
Dim user$ = MySettings.GetUserUrl(Name, False)
|
||||
Dim user$ = MySettings.GetUserUrl(Me, False)
|
||||
Dim p As UserMedia
|
||||
Dim EnvirSet As Boolean = False
|
||||
|
||||
Do
|
||||
ThrowAny(Token)
|
||||
URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}"
|
||||
r = Responser.GetResponse(URL,, e)
|
||||
r = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
|
||||
With JsonDocument.Parse(r).XmlIfNothing
|
||||
j = JsonDocument.Parse(r).XmlIfNothing
|
||||
With j
|
||||
If .Contains("videos") Then
|
||||
With .Item("videos")
|
||||
If .Count > 0 Then
|
||||
NextPage += 1
|
||||
For Each jj In .Self
|
||||
p = New UserMedia With {
|
||||
.Post = New UserPost With {.ID = jj.Value("id")},
|
||||
.URL = $"https://www.xvideos.com{jj.Value("u")}"
|
||||
.Post = jj.Value("id"),
|
||||
.URL = $"https://www.xvideos.com/{jj.Value("u").StringTrimStart("/")}"
|
||||
}
|
||||
If Not p.Post.ID.IsEmptyString And Not jj.Value("u").IsEmptyString Then
|
||||
If Not _TempPostsList.Contains(p.Post.ID) Then
|
||||
_TempPostsList.Add(p.Post.ID)
|
||||
_TempMediaList.Add(p)
|
||||
Else
|
||||
.Dispose()
|
||||
Exit Do
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
Else
|
||||
.Dispose()
|
||||
Exit Do
|
||||
Continue Do
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
.Dispose()
|
||||
Exit Do
|
||||
End If
|
||||
.Dispose()
|
||||
End With
|
||||
Else
|
||||
Exit Do
|
||||
End If
|
||||
Loop
|
||||
If Not j Is Nothing Then j.Dispose()
|
||||
Exit Do
|
||||
Loop While NextPage < 100
|
||||
|
||||
If Not j Is Nothing Then j.Dispose()
|
||||
|
||||
If _TempMediaList.Count > 0 Then
|
||||
For i% = 0 To _TempMediaList.Count - 1
|
||||
ThrowAny(Token)
|
||||
With _TempMediaList(i) : _TempMediaList(i) = GetVideoData(.URL, Responser, MySettings.DownloadUHD.Value, .Post.ID) : End With
|
||||
_TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
|
||||
Next
|
||||
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
|
||||
End If
|
||||
@@ -108,38 +128,80 @@ Namespace API.XVIDEOS
|
||||
If _TempMediaList.ListExists Then _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
|
||||
End Try
|
||||
End Sub
|
||||
Private Function GetVideoData(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String) As UserMedia
|
||||
Private Sub DownloadSavedVideos(ByVal Token As CancellationToken)
|
||||
Dim URL$ = MySettings.SavedVideosPlaylist.Value
|
||||
Try
|
||||
If Not URL.IsEmptyString Then
|
||||
Dim r$ = resp.GetResponse(URL,, EDP.ThrowException)
|
||||
Dim NextPage% = 0
|
||||
Dim __continue As Boolean = True
|
||||
Dim r$
|
||||
Dim data As List(Of PlayListVideo)
|
||||
Dim i%
|
||||
Do
|
||||
ThrowAny(Token)
|
||||
URL = $"{MySettings.SavedVideosPlaylist.Value}{If(NextPage = 0, String.Empty, $"/{NextPage}")}"
|
||||
r = Responser.GetResponse(URL,, EDP.ReturnValue)
|
||||
If Responser.HasError Then
|
||||
If Responser.StatusCode = Net.HttpStatusCode.NotFound And NextPage > 0 Then Exit Do
|
||||
Throw New Exception(Responser.ErrorText, Responser.ErrorException)
|
||||
End If
|
||||
NextPage += 1
|
||||
If Not r.IsEmptyString Then
|
||||
Dim m$ = RegexReplace(r, M3U8Regex)
|
||||
If Not m.IsEmptyString Then
|
||||
Dim appender$ = RegexReplace(m, M3U8Appender)
|
||||
Dim t$ = RegexReplace(r, VideoTitleRegex)
|
||||
r = resp.GetResponse(m,, EDP.ThrowException)
|
||||
data = RegexFields(Of PlayListVideo)(r, {Regex_SavedVideosPlaylist}, {1, 2, 3}, EDP.ReturnValue)
|
||||
If data.ListExists Then
|
||||
If data.RemoveAll(Function(d) _TempPostsList.Contains(d.ID)) > 0 Then __continue = False
|
||||
If data.ListExists Then
|
||||
_TempPostsList.ListAddList(data.Select(Function(d) d.ID), LNC)
|
||||
i = _TempMediaList.Count
|
||||
_TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC)
|
||||
If _TempMediaList.Count = i Or Not __continue Then Exit Do Else Continue Do
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Exit Do
|
||||
Loop While NextPage < 100 And __continue
|
||||
|
||||
If _TempMediaList.Count > 0 Then
|
||||
For i% = 0 To _TempMediaList.Count - 1
|
||||
ThrowAny(Token)
|
||||
_TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
|
||||
Next
|
||||
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, $"data downloading error [{URL}]")
|
||||
End Try
|
||||
End Sub
|
||||
Private Function GetVideoData(ByVal Media As UserMedia, ByVal resp As Response, ByVal DownloadUHD As Boolean) As UserMedia
|
||||
Try
|
||||
If Not Media.URL.IsEmptyString Then
|
||||
Dim r$ = resp.GetResponse(Media.URL)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim NewUrl$ = RegexReplace(r, Regex_M3U8)
|
||||
If Not NewUrl.IsEmptyString Then
|
||||
Dim appender$ = RegexReplace(NewUrl, Regex_M3U8_Appender)
|
||||
Dim t$ = If(Media.PictureOption.IsEmptyString, RegexReplace(r, Regex_VideoTitle), Media.PictureOption)
|
||||
r = resp.GetResponse(NewUrl)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim ls As List(Of Sizes) = RegexFields(Of Sizes)(r, {M3U8Reparse}, {1, 2})
|
||||
Dim ls As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_Reparse}, {1, 2})
|
||||
If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) Not v.Value.ValueBetween(1, 1080))
|
||||
If ls.ListExists Then
|
||||
ls.Sort()
|
||||
m = $"{appender}/{ls(0).Data}"
|
||||
NewUrl = $"{appender}/{ls(0).Data.StringTrimStart("/")}"
|
||||
ls.Clear()
|
||||
Dim pID$ = ID
|
||||
If pID.IsEmptyString Then pID = RegexReplace(r, VideoID)
|
||||
Dim pID$ = Media.Post.ID
|
||||
If pID.IsEmptyString Then pID = RegexReplace(r, Regex_VideoID)
|
||||
If pID.IsEmptyString Then pID = "0"
|
||||
|
||||
If Not t.IsEmptyString Then t = t.StringRemoveWinForbiddenSymbols(" ")
|
||||
t = t.StringRemoveWinForbiddenSymbols.StringTrim
|
||||
If t.IsEmptyString Then
|
||||
t = pID
|
||||
Else
|
||||
If t.Length > 100 Then t = Left(t, 100)
|
||||
End If
|
||||
If Not m.IsEmptyString Then
|
||||
Return New UserMedia With {
|
||||
.Type = UTypes.m3u8,
|
||||
.Post = New UserPost With {.ID = pID},
|
||||
.URL = m,
|
||||
If Not NewUrl.IsEmptyString Then
|
||||
Return New UserMedia(NewUrl, UTypes.m3u8) With {
|
||||
.Post = pID,
|
||||
.URL_BASE = Media.URL,
|
||||
.File = $"{t}.mp4",
|
||||
.PictureOption = appender
|
||||
}
|
||||
@@ -151,18 +213,18 @@ Namespace API.XVIDEOS
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
LogError(ex, $"[XVIDEOS.UserData.GetVideoData({URL})]")
|
||||
LogError(ex, $"[XVIDEOS.UserData.GetVideoData({Media.URL})]")
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
Friend Function Download(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String)
|
||||
Dim m As UserMedia = GetVideoData(URL, resp, DownloadUHD, ID)
|
||||
Dim m As UserMedia = GetVideoData(New UserMedia(URL, UTypes.VideoPre) With {.Post = ID}, resp, DownloadUHD)
|
||||
If Not m.URL.IsEmptyString Then
|
||||
Dim f As SFile = m.File
|
||||
f.Path = MyFile.PathNoSeparator
|
||||
m.State = UStates.Tried
|
||||
Try
|
||||
f = M3U8.Download(m.URL, m.PictureOption, Settings.FfmpegFile, f)
|
||||
f = M3U8.Download(m.URL, m.PictureOption, f)
|
||||
m.File = f
|
||||
m.State = UStates.Downloaded
|
||||
Catch ex As Exception
|
||||
@@ -175,7 +237,7 @@ Namespace API.XVIDEOS
|
||||
DownloadContentDefault(Token)
|
||||
End Sub
|
||||
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
|
||||
Return M3U8.Download(Media.URL, Media.PictureOption, Settings.FfmpegFile, DestinationFile)
|
||||
Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile)
|
||||
End Function
|
||||
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
|
||||
Optional ByVal EObj As Object = Nothing) As Integer
|
||||
|
||||
19
SCrawler/API/Xhamster/Declarations.vb
Normal file
@@ -0,0 +1,19 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
'Imports System.Globalization
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Namespace API.Xhamster
|
||||
Friend Module Declarations
|
||||
Friend Const XhamsterSiteKey As String = "AndyProgram_XHamster"
|
||||
Friend ReadOnly HtmlScript As RParams = RParams.DMS("\<script id='initials-script'\>window.initials=(\{.+?\});\</script\>", 1, EDP.ReturnValue,
|
||||
CType(Function(Input$) Input.StringTrim, Func(Of String, String)))
|
||||
Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v))
|
||||
Friend ReadOnly FirstM3U8FileRegEx As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]+?([^#]*?\.m3u8.*)", 0, RegexReturn.List)
|
||||
End Module
|
||||
End Namespace
|
||||
79
SCrawler/API/Xhamster/M3U8.vb
Normal file
@@ -0,0 +1,79 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.API.Base.M3U8Declarations
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace API.Xhamster
|
||||
Friend NotInheritable Class M3U8
|
||||
Private Sub New()
|
||||
End Sub
|
||||
Private Shared Function ParseFirstM3U8(ByVal URL As String, ByVal Responser As Response, ByVal UHD As Boolean) As String
|
||||
Dim r$, d$
|
||||
Dim _DataObtained As Boolean = False
|
||||
For i% = 0 To 1
|
||||
Try
|
||||
Responser.UseGZipStream = i
|
||||
r = Responser.GetResponse(URL.Replace("\", String.Empty))
|
||||
If Not r.IsEmptyString Then
|
||||
r = r.StringFormatLines
|
||||
Dim sList As List(Of Sizes) = RegexFields(Of Sizes)(r, {FirstM3U8FileRegEx}, {1, 2})
|
||||
If sList.ListExists Then _DataObtained = True : sList.RemoveAll(Function(sv) sv.HasError Or sv.Data.IsEmptyString Or
|
||||
sv.Value = 0 Or (Not UHD And sv.Value > 1080))
|
||||
If sList.ListExists Then
|
||||
sList.Sort()
|
||||
d = sList.First.Data.Trim
|
||||
If Not d.IsEmptyString Then Return d
|
||||
End If
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
If _DataObtained Then Exit For
|
||||
Next
|
||||
Return String.Empty
|
||||
End Function
|
||||
Private Shared Function ParseSecondM3U8(ByVal URL As String, ByVal Responser As Response, ByVal Appender As String) As List(Of String)
|
||||
Dim r$
|
||||
Dim l As List(Of String)
|
||||
For i% = 0 To 1
|
||||
Try
|
||||
Responser.UseGZipStream = i
|
||||
r = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
l = RegexReplace(r, TsFilesRegEx)
|
||||
If l.ListExists Then
|
||||
For indx% = 0 To l.Count - 1 : l(indx) = M3U8Base.CreateUrl(Appender, l(indx)) : Next
|
||||
Return l
|
||||
End If
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
Next
|
||||
Return Nothing
|
||||
End Function
|
||||
Private Shared Function ObtainUrls(ByVal URL As String, ByVal Responser As Response, ByVal UHD As Boolean) As List(Of String)
|
||||
Try
|
||||
Dim file$ = ParseFirstM3U8(URL, Responser, UHD)
|
||||
If Not file.IsEmptyString Then
|
||||
Responser.UseGZipStream = False
|
||||
Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
|
||||
URL = M3U8Base.CreateUrl(appender, file)
|
||||
Dim l As List(Of String) = ParseSecondM3U8(URL, Responser, appender)
|
||||
If l.ListExists Then Return l
|
||||
End If
|
||||
Return Nothing
|
||||
Finally
|
||||
Responser.UseGZipStream = False
|
||||
End Try
|
||||
End Function
|
||||
Friend Shared Function Download(ByVal Media As UserMedia, ByVal Responser As Response, ByVal UHD As Boolean) As SFile
|
||||
Return M3U8Base.Download(ObtainUrls(Media.URL, Responser, UHD), Media.File, Responser)
|
||||
End Function
|
||||
End Class
|
||||
End Namespace
|
||||
155
SCrawler/API/Xhamster/SiteSettings.vb
Normal file
@@ -0,0 +1,155 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.API.BaseObjects
|
||||
Imports SCrawler.Plugin
|
||||
Imports SCrawler.Plugin.Attributes
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace API.Xhamster
|
||||
<Manifest(XhamsterSiteKey), SavedPosts, SpecialForm(True), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
|
||||
Friend Class SiteSettings : Inherits SiteSettingsBase : Implements IDomainContainer
|
||||
#Region "Declarations"
|
||||
Friend Overrides ReadOnly Property Icon As Icon Implements IDomainContainer.Icon
|
||||
Get
|
||||
Return My.Resources.SiteResources.XhamsterIcon_32
|
||||
End Get
|
||||
End Property
|
||||
Friend Overrides ReadOnly Property Image As Image
|
||||
Get
|
||||
Return My.Resources.SiteResources.XhamsterPic_32
|
||||
End Get
|
||||
End Property
|
||||
#Region "Domains"
|
||||
Private ReadOnly Property IDomainContainer_Site As String Implements IDomainContainer.Site
|
||||
Get
|
||||
Return Site
|
||||
End Get
|
||||
End Property
|
||||
<PXML("Domains")> Private ReadOnly Property SiteDomains As PropertyValue Implements IDomainContainer.DomainsSettingProp
|
||||
Friend ReadOnly Property Domains As List(Of String) Implements IDomainContainer.Domains
|
||||
Private ReadOnly Property DomainsTemp As List(Of String) Implements IDomainContainer.DomainsTemp
|
||||
Private Property DomainsChanged As Boolean = False Implements IDomainContainer.DomainsChanged
|
||||
Friend ReadOnly Property DomainsUpdated As Boolean
|
||||
Get
|
||||
Return DomainsUpdatedBySite
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly Property DomainsDefault As String = "xhamster.com" Implements IDomainContainer.DomainsDefault
|
||||
#End Region
|
||||
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
|
||||
Friend Property DownloadUHD As PropertyValue
|
||||
Private Property Initialized As Boolean = False Implements IDomainContainer.Initialized
|
||||
#End Region
|
||||
#Region "Initializer"
|
||||
Friend Sub New()
|
||||
MyBase.New("XHamster", "xhamster.com")
|
||||
|
||||
Responser.DeclaredError = EDP.ThrowException
|
||||
|
||||
Domains = New List(Of String)
|
||||
DomainsTemp = New List(Of String)
|
||||
SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
|
||||
DownloadUHD = New PropertyValue(False)
|
||||
|
||||
UrlPatternUser = "https://xhamster.com/users/{0}"
|
||||
UserRegex = RParams.DMS("xhamster.com/users/([^/]+).*?", 1)
|
||||
ImageVideoContains = "xhamster"
|
||||
End Sub
|
||||
Friend Overrides Sub EndInit()
|
||||
Initialized = True
|
||||
DomainContainer.EndInit(Me)
|
||||
DomainsTemp.ListAddList(Domains)
|
||||
MyBase.EndInit()
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "UpdateDomains"
|
||||
Private Property DomainsUpdateInProgress As Boolean = False Implements IDomainContainer.DomainsUpdateInProgress
|
||||
Private Property DomainsUpdatedBySite As Boolean = False Implements IDomainContainer.DomainsUpdatedBySite
|
||||
Friend Overloads Sub UpdateDomains() Implements IDomainContainer.UpdateDomains
|
||||
DomainContainer.UpdateDomains(Me)
|
||||
End Sub
|
||||
Friend Overloads Sub UpdateDomains(ByVal NewDomains As IEnumerable(Of String), ByVal Internal As Boolean)
|
||||
DomainContainer.UpdateDomains(Me, NewDomains, Internal)
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Edit"
|
||||
Friend Overrides Sub Update()
|
||||
DomainContainer.Update(Me)
|
||||
Responser.SaveSettings()
|
||||
MyBase.Update()
|
||||
End Sub
|
||||
Friend Overrides Sub EndEdit()
|
||||
DomainContainer.EndEdit(Me)
|
||||
MyBase.EndEdit()
|
||||
End Sub
|
||||
Friend Overrides Sub OpenSettingsForm()
|
||||
DomainContainer.OpenSettingsForm(Me)
|
||||
End Sub
|
||||
#End Region
|
||||
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
|
||||
If What = ISiteSettings.Download.SavedPosts Then
|
||||
Return New UserData With {.IsSavedPosts = True, .User = New UserInfo With {.Name = "xhamster"}}
|
||||
Else
|
||||
Return New UserData
|
||||
End If
|
||||
End Function
|
||||
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
|
||||
If Available(ISiteSettings.Download.Main, True) Then
|
||||
Using resp As Response = Responser.Copy
|
||||
Dim spf$ = String.Empty
|
||||
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
|
||||
Dim m As UserMedia = UserData.GetVideoInfo(URL, resp, f)
|
||||
If m.State = UserMedia.States.Downloaded Then
|
||||
m.SpecialFolder = f
|
||||
Return {m}
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
Return Nothing
|
||||
End Function
|
||||
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, Silent As Boolean) As Boolean
|
||||
If Settings.UseM3U8 AndAlso MyBase.Available(What, Silent) Then
|
||||
If What = ISiteSettings.Download.SavedPosts Then
|
||||
Return If(Responser.Cookies?.Count, 0) > 0
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Function
|
||||
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
|
||||
Return Media.URL_BASE
|
||||
End Function
|
||||
#Region "Is my user/data"
|
||||
Private Const UserRegexDefault As String = "{0}/users/([^/]+).*?"
|
||||
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
|
||||
Dim b As ExchangeOptions = MyBase.IsMyUser(UserURL)
|
||||
If b.Exists Then Return b
|
||||
If Not UserURL.IsEmptyString And Domains.Count > 0 Then
|
||||
Dim uName$, fStr$
|
||||
Dim uErr As New ErrorsDescriber(EDP.ReturnValue)
|
||||
For i% = 0 To Domains.Count - 1
|
||||
fStr = String.Format(UserRegexDefault, Domains(i))
|
||||
uName = RegexReplace(UserURL, RParams.DMS(fStr, 1, uErr))
|
||||
If Not uName.IsEmptyString Then Return New ExchangeOptions(Site, uName)
|
||||
Next
|
||||
End If
|
||||
Return Nothing
|
||||
End Function
|
||||
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
|
||||
If Not URL.IsEmptyString And Domains.Count > 0 Then
|
||||
If Domains.Exists(Function(d) URL.Contains(d)) Then Return New ExchangeOptions With {.UserName = URL, .Exists = True}
|
||||
End If
|
||||
Return Nothing
|
||||
End Function
|
||||
#End Region
|
||||
End Class
|
||||
End Namespace
|
||||
344
SCrawler/API/Xhamster/UserData.vb
Normal file
@@ -0,0 +1,344 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
||||
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
||||
Namespace API.Xhamster
|
||||
Friend Class UserData : Inherits UserDataBase
|
||||
#Region "Declarations"
|
||||
Private ReadOnly Property MySettings As SiteSettings
|
||||
Get
|
||||
Return DirectCast(HOST.Source, SiteSettings)
|
||||
End Get
|
||||
End Property
|
||||
Private Structure ExchObj
|
||||
Friend IsPhoto As Boolean
|
||||
End Structure
|
||||
Private ReadOnly _TempPhotoData As List(Of UserMedia)
|
||||
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Initializer"
|
||||
Friend Sub New()
|
||||
UseInternalM3U8Function = True
|
||||
_TempPhotoData = New List(Of UserMedia)
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download base functions"
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
_TempPhotoData.Clear()
|
||||
If DownloadVideos Then DownloadData(1, True, Token)
|
||||
If DownloadImages Then
|
||||
DownloadData(1, False, Token)
|
||||
ReparsePhoto(Token)
|
||||
End If
|
||||
End Sub
|
||||
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsVideo As Boolean, ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
Dim MaxPage% = -1
|
||||
Dim Type As UTypes = IIf(IsVideo, UTypes.VideoPre, UTypes.Picture)
|
||||
Dim mPages$ = IIf(IsVideo, "maxVideoPages", "maxPhotoPages")
|
||||
Dim listNode$()
|
||||
Dim m As UserMedia
|
||||
|
||||
If IsSavedPosts Then
|
||||
URL = $"https://xhamster.com/my/favorites/{IIf(IsVideo, "videos", "photos-and-galleries")}{IIf(Page = 1, String.Empty, $"/{Page}")}"
|
||||
listNode = If(IsVideo, {"favoriteVideoListComponent", "models"}, {"favoritesGalleriesAndPhotosCollection"})
|
||||
Else
|
||||
URL = $"https://xhamster.com/users/{Name}/{IIf(IsVideo, "videos", "photos")}{IIf(Page = 1, String.Empty, $"/{Page}")}"
|
||||
listNode = {If(IsVideo, "userVideoCollection", "userGalleriesCollection")}
|
||||
End If
|
||||
ThrowAny(Token)
|
||||
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript)
|
||||
If Not r.IsEmptyString Then
|
||||
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
|
||||
If j.Count > 0 Then
|
||||
If Not MySettings.DomainsUpdated AndAlso j.Contains("trustURLs") Then _
|
||||
MySettings.UpdateDomains(j("trustURLs").Select(Function(d) d(0).XmlIfNothingValue), False)
|
||||
|
||||
MaxPage = j.Value(mPages).FromXML(Of Integer)(-1)
|
||||
|
||||
With j(listNode)
|
||||
If .ListExists Then
|
||||
For Each e As EContainer In .Self
|
||||
m = ExtractMedia(e, Type)
|
||||
If Not m.URL.IsEmptyString Then
|
||||
If m.File.IsEmptyString Then Continue For
|
||||
|
||||
If m.Post.Date.HasValue Then
|
||||
Select Case CheckDatesLimit(m.Post.Date.Value, Nothing)
|
||||
Case DateResult.Skip : Continue For
|
||||
Case DateResult.Exit : Exit Sub
|
||||
End Select
|
||||
End If
|
||||
|
||||
If IsVideo AndAlso Not _TempPostsList.Contains(m.Post.ID) Then
|
||||
_TempPostsList.Add(m.Post.ID)
|
||||
_TempMediaList.ListAddValue(m, LNC)
|
||||
ElseIf Not IsVideo Then
|
||||
If DirectCast(m.Object, ExchObj).IsPhoto Then
|
||||
If Not m.Post.ID.IsEmptyString AndAlso Not _TempPostsList.Contains(m.Post.ID) Then
|
||||
_TempPostsList.Add(m.Post.ID)
|
||||
_TempMediaList.ListAddValue(m, LNC)
|
||||
End If
|
||||
Else
|
||||
_TempPhotoData.ListAddValue(m, LNC)
|
||||
End If
|
||||
Else
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End With
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
|
||||
If MaxPage > 0 AndAlso Page < MaxPage Then DownloadData(Page + 1, IsVideo, Token)
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, $"data downloading error [{URL}]")
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Reparse video, photo"
|
||||
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
|
||||
Dim m As UserMedia, m2 As UserMedia
|
||||
For i% = _TempMediaList.Count - 1 To 0 Step -1
|
||||
If _TempMediaList(i).Type = UTypes.VideoPre Then
|
||||
m = _TempMediaList(i)
|
||||
If Not m.URL_BASE.IsEmptyString Then
|
||||
m2 = Nothing
|
||||
If GetM3U8(m2, m.URL_BASE, Responser) Then
|
||||
m2.URL_BASE = m.URL_BASE
|
||||
_TempMediaList(i) = m2
|
||||
Else
|
||||
m.State = UserMedia.States.Missing
|
||||
_TempMediaList(i) = m
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, "video reparsing error", False)
|
||||
End Try
|
||||
End Sub
|
||||
Private Overloads Sub ReparsePhoto(ByVal Token As CancellationToken)
|
||||
If _TempPhotoData.Count > 0 Then
|
||||
For i% = 0 To _TempPhotoData.Count - 1 : ReparsePhoto(i, 1, Token) : Next
|
||||
_TempPhotoData.Clear()
|
||||
End If
|
||||
End Sub
|
||||
Private Overloads Sub ReparsePhoto(ByVal Index As Integer, ByVal Page As Integer, ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
Dim MaxPage% = -1
|
||||
Dim m As UserMedia
|
||||
Dim sm As UserMedia = _TempPhotoData(Index)
|
||||
|
||||
URL = $"{sm.URL}{IIf(Page = 1, String.Empty, $"/{Page}")}"
|
||||
ThrowAny(Token)
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript)
|
||||
If Not r.IsEmptyString Then
|
||||
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
|
||||
If j.Count > 0 Then
|
||||
MaxPage = j.Value({"pagination"}, "maxPage").FromXML(Of Integer)(-1)
|
||||
With j({"photosGalleryModel"}, "photos")
|
||||
If .ListExists Then
|
||||
For Each e In .Self
|
||||
m = ExtractMedia(e, UTypes.Picture, "imageURL", False, sm.Post.Date)
|
||||
m.URL_BASE = sm.URL
|
||||
If Not m.URL.IsEmptyString Then
|
||||
m.Post.ID = $"{sm.Post.ID}_{m.Post.ID}"
|
||||
m.SpecialFolder = sm.SpecialFolder
|
||||
If Not _TempPostsList.Contains(m.Post.ID) Then
|
||||
_TempPostsList.Add(m.Post.ID)
|
||||
_TempMediaList.ListAddValue(m, LNC)
|
||||
Else
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End With
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
|
||||
If MaxPage > 0 AndAlso Page < MaxPage Then ReparsePhoto(Index, Page + 1, Token)
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, "photo reparsing error", False)
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Reparse missing"
|
||||
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
|
||||
Dim rList As New List(Of Integer)
|
||||
Try
|
||||
If ContentMissingExists Then
|
||||
Dim m As UserMedia, m2 As UserMedia
|
||||
For i% = 0 To _ContentList.Count - 1
|
||||
m = _ContentList(i)
|
||||
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
|
||||
ThrowAny(Token)
|
||||
m2 = Nothing
|
||||
If GetM3U8(m2, m.URL_BASE, Responser) Then
|
||||
m2.URL_BASE = m.URL_BASE
|
||||
_TempMediaList.ListAddValue(m2, LNC)
|
||||
rList.Add(i)
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ProcessException(ex, Token, "missing data downloading error")
|
||||
Finally
|
||||
If rList.Count > 0 Then
|
||||
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
|
||||
rList.Clear()
|
||||
End If
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "GetM3U8"
|
||||
Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal URL As String, ByVal Responser As Response,
|
||||
Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
|
||||
Try
|
||||
If Not URL.IsEmptyString Then
|
||||
Dim r$ = Responser.GetResponse(URL)
|
||||
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript)
|
||||
If Not r.IsEmptyString Then
|
||||
Using j As EContainer = JsonDocument.Parse(r)
|
||||
If j.ListExists Then
|
||||
m = ExtractMedia(j("videoModel"), UTypes.VideoPre)
|
||||
m.URL_BASE = URL
|
||||
Return GetM3U8(m, j)
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
End If
|
||||
Return False
|
||||
Catch ex As Exception
|
||||
If Not e.Exists Then e = EDP.ReturnValue
|
||||
Return ErrorsDescriber.Execute(e, ex, $"[{ToStringForLog()}]: API.Xhamster.GetM3U8({URL})", False)
|
||||
End Try
|
||||
End Function
|
||||
Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal j As EContainer) As Boolean
|
||||
Dim url$ = j.Value({"xplayerSettings", "sources", "hls"}, "url")
|
||||
If Not url.IsEmptyString Then m.URL = url : m.Type = UTypes.m3u8 : Return True
|
||||
Return False
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Standalone downloader"
|
||||
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Response, ByVal Path As SFile) As UserMedia
|
||||
Try
|
||||
Using u As New UserData With {.Responser = Responser, .HOST = Settings(XhamsterSiteKey)}
|
||||
Dim m As UserMedia = Nothing
|
||||
If u.GetM3U8(m, URL, Responser, EDP.ThrowException) Then
|
||||
m.File.Path = Path.Path
|
||||
Dim f As SFile = u.DownloadM3U8(m.URL, m, m.File)
|
||||
If Not f.IsEmptyString Then
|
||||
m.File = f
|
||||
m.State = UserMedia.States.Downloaded
|
||||
Return m
|
||||
End If
|
||||
End If
|
||||
End Using
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"XHamster standalone download error: [{URL}]", New UserMedia)
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Download data"
|
||||
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
DownloadContentDefault(Token)
|
||||
End Sub
|
||||
Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
|
||||
Media.File = DestinationFile
|
||||
Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value)
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Create media"
|
||||
Private Shared Function ExtractMedia(ByVal j As EContainer, ByVal t As UTypes, Optional ByVal UrlNode As String = "pageURL",
|
||||
Optional ByVal DetectGalery As Boolean = True, Optional ByVal PostDate As Date? = Nothing) As UserMedia
|
||||
If Not j Is Nothing Then
|
||||
Dim m As New UserMedia(j.Value(UrlNode).Replace("\", String.Empty), t) With {
|
||||
.Post = New UserPost With {
|
||||
.ID = j.Value("id"),
|
||||
.Date = AConvert(Of Date)(j.Value("created"), DateProvider, Nothing)
|
||||
},
|
||||
.PictureOption = j.Value("title").StringRemoveWinForbiddenSymbols,
|
||||
.Object = New ExchObj
|
||||
}
|
||||
If PostDate.HasValue Then m.Post.Date = PostDate
|
||||
Dim setSpecialFolder As Boolean = False
|
||||
Dim processFile As Boolean = True
|
||||
Dim ext$ = "mp4"
|
||||
If t = UTypes.Picture Then
|
||||
ext = "jpg"
|
||||
If (Not DetectGalery OrElse j.Contains("galleryId")) AndAlso Not j.Value("imageURL").IsEmptyString Then
|
||||
m.Object = New ExchObj With {.IsPhoto = True}
|
||||
m.URL = j.Value("imageURL")
|
||||
m.URL_BASE = m.URL
|
||||
If DetectGalery Then m.Post.ID = $"{j.Value("galleryId")}_{m.Post.ID}"
|
||||
m.File = m.URL
|
||||
m.File.Separator = "\"
|
||||
processFile = m.File.File.IsEmptyString
|
||||
Else
|
||||
setSpecialFolder = True
|
||||
End If
|
||||
End If
|
||||
If Not m.URL.IsEmptyString Then
|
||||
If m.Post.ID.IsEmptyString Then m.Post.ID = m.URL.Split("/").LastOrDefault
|
||||
If m.PictureOption.IsEmptyString Then m.PictureOption = j.Value("titleLocalized").StringRemoveWinForbiddenSymbols
|
||||
If m.PictureOption.IsEmptyString Then m.PictureOption = m.Post.ID
|
||||
If setSpecialFolder Then m.SpecialFolder = m.PictureOption
|
||||
|
||||
If processFile Then
|
||||
If Not m.PictureOption.IsEmptyString Then
|
||||
m.File = $"{m.PictureOption}.{ext}"
|
||||
ElseIf Not m.Post.ID.IsEmptyString Then
|
||||
m.File = $"{m.Post.ID}.{ext}"
|
||||
End If
|
||||
End If
|
||||
m.File.Separator = "\"
|
||||
End If
|
||||
Return m
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Exception"
|
||||
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
|
||||
Optional ByVal EObj As Object = Nothing) As Integer
|
||||
Return If(Responser.Status = Net.WebExceptionStatus.ConnectionClosed, 1, 0)
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Idisposable support"
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue And disposing Then _TempPhotoData.Clear()
|
||||
MyBase.Dispose(disposing)
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
End Namespace
|
||||
6
SCrawler/Channels/ChannelViewForm.Designer.vb
generated
@@ -140,24 +140,28 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
|
||||
'
|
||||
'BTT_C_OPEN_USER
|
||||
'
|
||||
Me.BTT_C_OPEN_USER.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
|
||||
Me.BTT_C_OPEN_USER.Name = "BTT_C_OPEN_USER"
|
||||
Me.BTT_C_OPEN_USER.Size = New System.Drawing.Size(305, 22)
|
||||
Me.BTT_C_OPEN_USER.Text = "Open user"
|
||||
'
|
||||
'BTT_C_OPEN_POST
|
||||
'
|
||||
Me.BTT_C_OPEN_POST.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
|
||||
Me.BTT_C_OPEN_POST.Name = "BTT_C_OPEN_POST"
|
||||
Me.BTT_C_OPEN_POST.Size = New System.Drawing.Size(305, 22)
|
||||
Me.BTT_C_OPEN_POST.Text = "Open post"
|
||||
'
|
||||
'BTT_C_OPEN_PICTURE
|
||||
'
|
||||
Me.BTT_C_OPEN_PICTURE.Image = Global.SCrawler.My.Resources.Resources.PicturePic_32
|
||||
Me.BTT_C_OPEN_PICTURE.Name = "BTT_C_OPEN_PICTURE"
|
||||
Me.BTT_C_OPEN_PICTURE.Size = New System.Drawing.Size(305, 22)
|
||||
Me.BTT_C_OPEN_PICTURE.Text = "Open picture"
|
||||
'
|
||||
'BTT_C_OPEN_FOLDER
|
||||
'
|
||||
Me.BTT_C_OPEN_FOLDER.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32
|
||||
Me.BTT_C_OPEN_FOLDER.Name = "BTT_C_OPEN_FOLDER"
|
||||
Me.BTT_C_OPEN_FOLDER.Size = New System.Drawing.Size(305, 22)
|
||||
Me.BTT_C_OPEN_FOLDER.Text = "Open folder"
|
||||
@@ -165,6 +169,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
|
||||
'BTT_C_REMOVE_FROM_SELECTED
|
||||
'
|
||||
Me.BTT_C_REMOVE_FROM_SELECTED.AutoToolTip = True
|
||||
Me.BTT_C_REMOVE_FROM_SELECTED.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
|
||||
Me.BTT_C_REMOVE_FROM_SELECTED.Name = "BTT_C_REMOVE_FROM_SELECTED"
|
||||
Me.BTT_C_REMOVE_FROM_SELECTED.Size = New System.Drawing.Size(305, 22)
|
||||
Me.BTT_C_REMOVE_FROM_SELECTED.Text = "Remove user from selected"
|
||||
@@ -172,6 +177,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
|
||||
'
|
||||
'BTT_C_ADD_TO_BLACKLIST
|
||||
'
|
||||
Me.BTT_C_ADD_TO_BLACKLIST.Image = Global.SCrawler.My.Resources.Resources.DBPic_32
|
||||
Me.BTT_C_ADD_TO_BLACKLIST.Name = "BTT_C_ADD_TO_BLACKLIST"
|
||||
Me.BTT_C_ADD_TO_BLACKLIST.Size = New System.Drawing.Size(305, 22)
|
||||
Me.BTT_C_ADD_TO_BLACKLIST.Text = "Add/Remove this user to/from the BlackList"
|
||||
|
||||
@@ -581,7 +581,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Private Sub CMB_CHANNELS_ActionSelectedItemChanged(ByVal _Item As ListViewItem) Handles CMB_CHANNELS.ActionSelectedItemChanged
|
||||
Private Sub CMB_CHANNELS_ActionSelectedItemChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles CMB_CHANNELS.ActionSelectedItemChanged
|
||||
SetLimitsByChannel()
|
||||
Dim c As Channel = GetCurrentChannel()
|
||||
If Not c Is Nothing Then MyRange.Source = c
|
||||
@@ -814,6 +814,14 @@ Friend Class ChannelViewForm : Implements IChannelLimits
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "MyRange"
|
||||
Private ReadOnly GetListImage_Error As New ErrorsDescriber(EDP.ReturnValue)
|
||||
Private Function GetListImage(ByVal Post As UserPost, ByVal s As Size, ByVal NullArg As Image) As Image
|
||||
If Not Post.CachedFile.IsEmptyString Then
|
||||
Return If(ImageRenderer.GetImage(SFile.GetBytes(Post.CachedFile), s, GetListImage_Error), NullArg.Clone)
|
||||
Else
|
||||
Return NullArg.Clone
|
||||
End If
|
||||
End Function
|
||||
Private Sub MyRange_IndexChanged(ByVal Sender As Object, ByVal e As EventArgs) Handles MyRange.IndexChanged
|
||||
Try
|
||||
If MyDefs.Initializing Then Exit Sub
|
||||
@@ -825,11 +833,10 @@ Friend Class ChannelViewForm : Implements IChannelLimits
|
||||
If .Count > 0 Then
|
||||
Dim s As Size = GetImageSize()
|
||||
Dim NullImage As Image = New Bitmap(s.Width, s.Height)
|
||||
Dim ie As New ErrorsDescriber(EDP.ReturnValue)
|
||||
For i% = 0 To .Count - 1
|
||||
p = .Item(i)
|
||||
With p
|
||||
LIST_POSTS.LargeImageList.Images.Add(.GetImage(s, ie, NullImage))
|
||||
LIST_POSTS.LargeImageList.Images.Add(GetListImage(p, s, NullImage))
|
||||
LIST_POSTS.Items.Add(New ListViewItem(.UserID, i) With {.Tag = p.ID})
|
||||
With LIST_POSTS.Items(LIST_POSTS.Items.Count - 1)
|
||||
If PendingUsers.Contains(.Text) Then .Checked = True
|
||||
|
||||
@@ -20,6 +20,7 @@ Friend Class ChannelsStatsForm
|
||||
.MyViewInitialize()
|
||||
.AddOkCancelToolbar()
|
||||
If Settings.Channels.Count > 0 Then RefillList() Else MsgBoxE("Channels not found", vbExclamation)
|
||||
.DelegateClosingChecker = False
|
||||
.EndLoaderOperations()
|
||||
End With
|
||||
End Sub
|
||||
|
||||
BIN
SCrawler/Content/Icons/SiteIcons/PornHubIcon_16.ico
Normal file
|
After Width: | Height: | Size: 1.4 KiB |
BIN
SCrawler/Content/Icons/SiteIcons/XhamsterIcon_32.ico
Normal file
|
After Width: | Height: | Size: 15 KiB |
BIN
SCrawler/Content/Icons/TagIcon_32.ico
Normal file
|
After Width: | Height: | Size: 5.3 KiB |
BIN
SCrawler/Content/Pictures/SitePictures/PornHubPic_16.png
Normal file
|
After Width: | Height: | Size: 764 B |
BIN
SCrawler/Content/Pictures/SitePictures/XhamsterPic_32.png
Normal file
|
After Width: | Height: | Size: 1.5 KiB |
@@ -22,7 +22,6 @@ Namespace DownloadObjects
|
||||
Private components As System.ComponentModel.IContainer
|
||||
<System.Diagnostics.DebuggerStepThrough()>
|
||||
Private Sub InitializeComponent()
|
||||
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ActiveDownloadingProgress))
|
||||
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
@@ -36,8 +35,8 @@ Namespace DownloadObjects
|
||||
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
Me.TP_MAIN.Name = "TP_MAIN"
|
||||
Me.TP_MAIN.RowCount = 1
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 64.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 64.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 66.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 66.0!))
|
||||
Me.TP_MAIN.Size = New System.Drawing.Size(434, 61)
|
||||
Me.TP_MAIN.TabIndex = 0
|
||||
'
|
||||
@@ -47,12 +46,13 @@ Namespace DownloadObjects
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(434, 61)
|
||||
Me.Controls.Add(Me.TP_MAIN)
|
||||
Me.Icon = Global.SCrawler.My.Resources.ArrowDownIcon_Blue_24
|
||||
Me.Icon = Global.SCrawler.My.Resources.Resources.ArrowDownIcon_Blue_24
|
||||
Me.KeyPreview = True
|
||||
Me.MinimumSize = New System.Drawing.Size(450, 100)
|
||||
Me.Name = "ActiveDownloadingProgress"
|
||||
Me.Text = "Active downloading progress"
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
Private WithEvents TP_MAIN As TableLayoutPanel
|
||||
End Class
|
||||
|
||||
@@ -42,6 +42,7 @@ Namespace DownloadObjects
|
||||
End Sub
|
||||
Private Sub Downloader_Reconfigured()
|
||||
Const RowHeight% = 30
|
||||
Const LowestValue% = 39
|
||||
Dim a As Action = Sub()
|
||||
With TP_MAIN
|
||||
If .Controls.Count > 0 Then
|
||||
@@ -65,13 +66,18 @@ Namespace DownloadObjects
|
||||
.Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1)
|
||||
End With
|
||||
Next
|
||||
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Percent, 100))
|
||||
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.AutoSize))
|
||||
TP_MAIN.RowCount += 1
|
||||
|
||||
Dim s As Size = Size
|
||||
Dim ss As Size = Screen.PrimaryScreen.WorkingArea.Size
|
||||
Dim c% = TP_MAIN.RowStyles.Count - 1
|
||||
s.Height = c * RowHeight + LowestValue + (PaddingE.GetOf({TP_MAIN}).Vertical(c) / c).RoundDown - c
|
||||
If s.Height > ss.Height Then s.Height = ss.Height
|
||||
MinimumSize = Nothing
|
||||
Size = s
|
||||
MinimumSize = New Size(MinWidth, s.Height)
|
||||
End If
|
||||
Dim s As Size = Size
|
||||
s.Height = TP_MAIN.RowStyles.Count * RowHeight + PaddingE.GetOf({TP_MAIN}).Vertical(TP_MAIN.RowStyles.Count) - TP_MAIN.RowStyles.Count * 2
|
||||
MinimumSize = New Size(MinWidth, s.Height)
|
||||
Size = s
|
||||
End With
|
||||
TP_MAIN.Refresh()
|
||||
End Sub
|
||||
|
||||
@@ -7,7 +7,6 @@
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Threading
|
||||
Imports SCrawler.API
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.DownloadObjects.Groups
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
@@ -15,7 +14,7 @@ Imports PersonalUtilities.Functions.XML.Base
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Tools.Notifications
|
||||
Namespace DownloadObjects
|
||||
Friend Class AutoDownloader : Inherits GroupParameters : Implements IEContainerProvider
|
||||
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider
|
||||
Friend Event PauseDisabled()
|
||||
Private Shared ReadOnly Property CachePath As SFile
|
||||
Get
|
||||
@@ -135,8 +134,9 @@ Namespace DownloadObjects
|
||||
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[AutoDownloader.NotifiedUser.ShowNotification]")
|
||||
If Not User Is Nothing Then
|
||||
MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader,
|
||||
$"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos",
|
||||
User.ToString, IIf(User.HasError, ToolTipIcon.Warning, ToolTipIcon.Info))
|
||||
User.ToString & vbNewLine &
|
||||
$"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos" &
|
||||
If(User.HasError, vbNewLine & "With errors", String.Empty))
|
||||
End If
|
||||
End Try
|
||||
End Sub
|
||||
@@ -182,7 +182,6 @@ Namespace DownloadObjects
|
||||
#Region "XML Names"
|
||||
Private Const Name_Mode As String = "Mode"
|
||||
Private Const Name_Groups As String = "Groups"
|
||||
Private Const Name_Labels As String = "Labels"
|
||||
Private Const Name_Timer As String = "Timer"
|
||||
Private Const Name_StartupDelay As String = "StartupDelay"
|
||||
Private Const Name_LastDownloadDate As String = "LastDownloadDate"
|
||||
@@ -205,11 +204,16 @@ Namespace DownloadObjects
|
||||
End Property
|
||||
Friend ReadOnly Property Groups As List(Of String)
|
||||
Friend Property Timer As Integer = DefaultTimer
|
||||
Friend Property StartupDelay As Integer = 0
|
||||
Friend Property StartupDelay As Integer = 1
|
||||
Friend Property ShowNotifications As Boolean = True
|
||||
Friend Property ShowPictureDownloaded As Boolean = True
|
||||
Friend Property ShowPictureUser As Boolean = True
|
||||
Friend Property ShowSimpleNotification As Boolean = False
|
||||
Private Property Index As Integer = -1 Implements IIndexable.Index
|
||||
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex
|
||||
DirectCast(Obj, AutoDownloader).Index = Index
|
||||
Return Obj
|
||||
End Function
|
||||
#Region "Date"
|
||||
Private ReadOnly LastDownloadDateXML As Date? = Nothing
|
||||
Private _LastDownloadDate As Date = Now.AddYears(-1)
|
||||
@@ -223,20 +227,25 @@ Namespace DownloadObjects
|
||||
If Not Initialization Then _LastDownloadDateChanged = True
|
||||
End Set
|
||||
End Property
|
||||
Private ReadOnly Property NextExecutionDate As Date
|
||||
Get
|
||||
If _PauseValue.HasValue Then
|
||||
Return {LastDownloadDate.AddMinutes(Timer), _StartTime.AddMinutes(StartupDelay), _PauseValue.Value}.Max
|
||||
Else
|
||||
Return {LastDownloadDate.AddMinutes(Timer), _StartTime.AddMinutes(StartupDelay)}.Max
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
|
||||
Private Function GetLastDateString() As String
|
||||
If LastDownloadDateXML.HasValue Or _LastDownloadDateChanged Then
|
||||
Return LastDownloadDate.ToStringDate(ADateTime.Formats.BaseDateTime)
|
||||
Return LastDownloadDate.ToStringDate(DateProvider)
|
||||
Else
|
||||
Return "never"
|
||||
End If
|
||||
End Function
|
||||
Private Function GetNextDateString() As String
|
||||
If _LastDownloadDateChanged Then
|
||||
Return LastDownloadDate.AddMinutes(Timer).ToStringDate(ADateTime.Formats.BaseDateTime)
|
||||
Else
|
||||
Return _StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)
|
||||
End If
|
||||
Return NextExecutionDate.ToStringDate(DateProvider)
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Information"
|
||||
@@ -287,14 +296,11 @@ Namespace DownloadObjects
|
||||
End Sub
|
||||
Friend Sub New(ByVal x As EContainer)
|
||||
Me.New
|
||||
Name = x.Value(Name_Name).FromXML(Of String)("Default")
|
||||
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
|
||||
Import(x)
|
||||
If Name.IsEmptyString Then Name = "Default"
|
||||
Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly)
|
||||
Labels.ListAddList(x.Value(Name_Labels).StringToList(Of String)("|"), LAP.NotContainsOnly)
|
||||
Temporary = x.Value(Name_Temporary).FromXML(Of Integer)(CheckState.Indeterminate)
|
||||
Favorite = x.Value(Name_Favorite).FromXML(Of Integer)(CheckState.Indeterminate)
|
||||
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
|
||||
ReadyForDownloadIgnore = x.Value(Name_ReadyForDownloadIgnore).FromXML(Of Boolean)(False)
|
||||
|
||||
Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer)
|
||||
If Timer <= 0 Then Timer = DefaultTimer
|
||||
StartupDelay = x.Value(Name_StartupDelay).FromXML(Of Integer)(0)
|
||||
@@ -331,24 +337,18 @@ Namespace DownloadObjects
|
||||
If Not Source Is Nothing Then Source.Update()
|
||||
End Sub
|
||||
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
|
||||
Return New EContainer(Scheduler.Name_Plan, String.Empty) From {
|
||||
New EContainer(Name_Name, Name),
|
||||
New EContainer(Name_Mode, CInt(Mode)),
|
||||
New EContainer(Name_Groups, Groups.ListToString("|")),
|
||||
New EContainer(Name_Labels, Labels.ListToString("|")),
|
||||
New EContainer(Name_Temporary, CInt(Temporary)),
|
||||
New EContainer(Name_Favorite, CInt(Favorite)),
|
||||
New EContainer(Name_ReadyForDownload, ReadyForDownload.BoolToInteger),
|
||||
New EContainer(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger),
|
||||
New EContainer(Name_Timer, Timer),
|
||||
New EContainer(Name_StartupDelay, StartupDelay),
|
||||
New EContainer(Name_ShowNotifications, ShowNotifications.BoolToInteger),
|
||||
New EContainer(Name_ShowPictureDown, ShowPictureDownloaded.BoolToInteger),
|
||||
New EContainer(Name_ShowPictureUser, ShowPictureUser.BoolToInteger),
|
||||
New EContainer(Name_ShowSimpleNotification, ShowSimpleNotification.BoolToInteger),
|
||||
New EContainer(Name_LastDownloadDate, CStr(AConvert(Of String)(If(LastDownloadDateXML.HasValue Or _LastDownloadDateChanged,
|
||||
CObj(LastDownloadDate), Nothing), DateProvider, String.Empty)))
|
||||
}
|
||||
Return Export(New EContainer(Scheduler.Name_Plan, String.Empty) From {
|
||||
New EContainer(Name_Mode, CInt(Mode)),
|
||||
New EContainer(Name_Groups, Groups.ListToString("|")),
|
||||
New EContainer(Name_Timer, Timer),
|
||||
New EContainer(Name_StartupDelay, StartupDelay),
|
||||
New EContainer(Name_ShowNotifications, ShowNotifications.BoolToInteger),
|
||||
New EContainer(Name_ShowPictureDown, ShowPictureDownloaded.BoolToInteger),
|
||||
New EContainer(Name_ShowPictureUser, ShowPictureUser.BoolToInteger),
|
||||
New EContainer(Name_ShowSimpleNotification, ShowSimpleNotification.BoolToInteger),
|
||||
New EContainer(Name_LastDownloadDate, CStr(AConvert(Of String)(If(LastDownloadDateXML.HasValue Or _LastDownloadDateChanged,
|
||||
CObj(LastDownloadDate), Nothing), DateProvider, String.Empty)))
|
||||
})
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Execution"
|
||||
@@ -420,11 +420,33 @@ Namespace DownloadObjects
|
||||
LastDownloadDate = LastDownloadDate.AddMinutes(Timer)
|
||||
End If
|
||||
End Sub
|
||||
Private _SpecialDelayUse As Boolean = False
|
||||
Private _SpecialDelayTime As Date? = Nothing
|
||||
Private Sub Checker()
|
||||
Try
|
||||
Dim _StartDownload As Boolean
|
||||
While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None
|
||||
If LastDownloadDate.AddMinutes(Timer) < Now And _StartTime.AddMinutes(StartupDelay) < Now And
|
||||
Not Downloader.Working And Not IsPaused And Not _StopRequested And Not Mode = Modes.None Then Download()
|
||||
Not IsPaused And Not _StopRequested And Not Mode = Modes.None Then
|
||||
If Downloader.Working Then
|
||||
_SpecialDelayUse = True
|
||||
Else
|
||||
If _SpecialDelayUse And Not _SpecialDelayTime.HasValue Then _SpecialDelayTime = Now.AddSeconds(10)
|
||||
If Not _SpecialDelayUse OrElse (_SpecialDelayTime.HasValue AndAlso _SpecialDelayTime.Value < Now) Then
|
||||
_SpecialDelayUse = False
|
||||
_SpecialDelayTime = Nothing
|
||||
_StartDownload = False
|
||||
If Settings.Automation.Count = 1 Then
|
||||
_StartDownload = True
|
||||
ElseIf Index = -1 Then
|
||||
_StartDownload = True
|
||||
Else
|
||||
_StartDownload = NextExecutionDate.AddMilliseconds(1000 * (Index + 1)).Ticks <= Now.Ticks
|
||||
End If
|
||||
If _StartDownload Then Download()
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Thread.Sleep(500)
|
||||
End While
|
||||
Catch ex As Exception
|
||||
@@ -447,7 +469,6 @@ Namespace DownloadObjects
|
||||
Dim GName$
|
||||
Dim i%
|
||||
Dim DownloadedUsersCount% = 0
|
||||
Dim l As New ListAddParams(LAP.IgnoreICopier + LAP.NotContainsOnly)
|
||||
Dim simple As Boolean = ShowSimpleNotification And ShowNotifications
|
||||
Dim notify As Action = Sub()
|
||||
With Downloader.Downloaded
|
||||
@@ -464,7 +485,18 @@ Namespace DownloadObjects
|
||||
End With
|
||||
End Sub
|
||||
Select Case Mode
|
||||
Case Modes.All : users.ListAddList(Settings.Users.Where(Function(u) u.Exists))
|
||||
Case Modes.All
|
||||
Dim CheckLabels As Predicate(Of IUserData) = Function(ByVal u As IUserData) As Boolean
|
||||
If LabelsExcluded.Count = 0 Then
|
||||
Return True
|
||||
ElseIf u.Labels.Count = 0 Then
|
||||
Return True
|
||||
Else
|
||||
Return Not u.Labels.ListContains(LabelsExcluded)
|
||||
End If
|
||||
End Function
|
||||
Dim CheckSites As Predicate(Of IUserData) = Function(u) SitesExcluded.Count = 0 OrElse Not SitesExcluded.Contains(u.Site)
|
||||
users.ListAddList(Settings.GetUsers(Function(u) UserExistsPredicate(u) And CheckLabels.Invoke(u) And CheckSites.Invoke(u)))
|
||||
Case Modes.Default
|
||||
Using g As New GroupParameters : users.ListAddList(DownloadGroup.GetUsers(g, True)) : End Using
|
||||
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me, True))
|
||||
@@ -472,24 +504,12 @@ Namespace DownloadObjects
|
||||
If Groups.Count > 0 And Settings.Groups.Count > 0 Then
|
||||
For Each GName In Groups
|
||||
i = Settings.Groups.IndexOf(GName)
|
||||
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, l)
|
||||
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, LAP.IgnoreICopier, LAP.NotContainsOnly)
|
||||
Next
|
||||
End If
|
||||
End Select
|
||||
If users.Count > 0 Then
|
||||
Keys.ListAddList(users.SelectMany(Of String)(Function(ByVal user As IUserData) As IEnumerable(Of String)
|
||||
If user.IsCollection Then
|
||||
With DirectCast(user, UserDataBind)
|
||||
If .Count > 0 Then
|
||||
Return .Collections.Select(Function(u) u.Key)
|
||||
Else
|
||||
Return New String() {}
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
Return {user.Key}
|
||||
End If
|
||||
End Function))
|
||||
Keys.ListAddList(users.Select(Function(u) u.Key))
|
||||
With Downloader
|
||||
.AutoDownloaderWorking = True
|
||||
If .Downloaded.Count > 0 Then .Downloaded.RemoveAll(Function(u) Keys.Contains(u.Key)) : .InvokeDownloadsChangeEvent()
|
||||
@@ -499,7 +519,7 @@ Namespace DownloadObjects
|
||||
notify.Invoke
|
||||
If simple And DownloadedUsersCount > 0 Then _
|
||||
MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader,
|
||||
$"{DownloadedUsersCount} user(s) downloaded with scheduler plan '{Name}'", $"Scheduler plan '{Name}'")
|
||||
$"{DownloadedUsersCount} user(s) downloaded with scheduler plan '{Name}'")
|
||||
End With
|
||||
End If
|
||||
Catch ex As Exception
|
||||
|
||||
@@ -66,13 +66,13 @@ Namespace DownloadObjects
|
||||
'CONTAINER_MAIN.ContentPanel
|
||||
'
|
||||
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 276)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 308)
|
||||
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
CONTAINER_MAIN.LeftToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
|
||||
CONTAINER_MAIN.RightToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(476, 301)
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(476, 333)
|
||||
CONTAINER_MAIN.TabIndex = 0
|
||||
CONTAINER_MAIN.TopToolStripPanelVisible = False
|
||||
'
|
||||
@@ -81,29 +81,30 @@ Namespace DownloadObjects
|
||||
Me.DEF_GROUP.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
Me.DEF_GROUP.ColumnCount = 1
|
||||
Me.DEF_GROUP.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.DEF_GROUP.Controls.Add(Me.TXT_GROUPS, 0, 5)
|
||||
Me.DEF_GROUP.Controls.Add(Me.TXT_GROUPS, 0, 6)
|
||||
Me.DEF_GROUP.Controls.Add(TP_MODE, 0, 0)
|
||||
Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 7)
|
||||
Me.DEF_GROUP.Controls.Add(Me.LBL_LAST_TIME_UP, 0, 9)
|
||||
Me.DEF_GROUP.Controls.Add(Me.NUM_DELAY, 0, 8)
|
||||
Me.DEF_GROUP.Controls.Add(TP_NOTIFY, 0, 6)
|
||||
Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 8)
|
||||
Me.DEF_GROUP.Controls.Add(Me.LBL_LAST_TIME_UP, 0, 10)
|
||||
Me.DEF_GROUP.Controls.Add(Me.NUM_DELAY, 0, 9)
|
||||
Me.DEF_GROUP.Controls.Add(TP_NOTIFY, 0, 7)
|
||||
Me.DEF_GROUP.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.DEF_GROUP.Location = New System.Drawing.Point(0, 0)
|
||||
Me.DEF_GROUP.Name = "DEF_GROUP"
|
||||
Me.DEF_GROUP.RowCount = 11
|
||||
Me.DEF_GROUP.RowCount = 12
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
|
||||
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 276)
|
||||
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 308)
|
||||
Me.DEF_GROUP.TabIndex = 0
|
||||
'
|
||||
'TXT_GROUPS
|
||||
@@ -117,10 +118,11 @@ Namespace DownloadObjects
|
||||
Me.TXT_GROUPS.CaptionText = "Groups"
|
||||
Me.TXT_GROUPS.CaptionWidth = 50.0R
|
||||
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 140)
|
||||
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 169)
|
||||
Me.TXT_GROUPS.Name = "TXT_GROUPS"
|
||||
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
|
||||
Me.TXT_GROUPS.TabIndex = 1
|
||||
Me.TXT_GROUPS.TextBoxReadOnly = True
|
||||
'
|
||||
'TP_MODE
|
||||
'
|
||||
@@ -220,7 +222,7 @@ Namespace DownloadObjects
|
||||
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
|
||||
Me.TXT_TIMER.CaptionWidth = 50.0R
|
||||
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 195)
|
||||
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 227)
|
||||
Me.TXT_TIMER.Name = "TXT_TIMER"
|
||||
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22)
|
||||
Me.TXT_TIMER.TabIndex = 3
|
||||
@@ -230,7 +232,7 @@ Namespace DownloadObjects
|
||||
Me.LBL_LAST_TIME_UP.AutoSize = True
|
||||
Me.LBL_LAST_TIME_UP.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.LBL_LAST_TIME_UP.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Italic, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
|
||||
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 250)
|
||||
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 282)
|
||||
Me.LBL_LAST_TIME_UP.Name = "LBL_LAST_TIME_UP"
|
||||
Me.LBL_LAST_TIME_UP.Size = New System.Drawing.Size(468, 25)
|
||||
Me.LBL_LAST_TIME_UP.TabIndex = 5
|
||||
@@ -249,7 +251,7 @@ Namespace DownloadObjects
|
||||
Me.NUM_DELAY.ClearTextByButtonClear = False
|
||||
Me.NUM_DELAY.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
|
||||
Me.NUM_DELAY.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 224)
|
||||
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 256)
|
||||
Me.NUM_DELAY.Name = "NUM_DELAY"
|
||||
Me.NUM_DELAY.NumberMaximum = New Decimal(New Integer() {1440, 0, 0, 0})
|
||||
Me.NUM_DELAY.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
|
||||
@@ -269,12 +271,12 @@ Namespace DownloadObjects
|
||||
TP_NOTIFY.Controls.Add(Me.CH_SHOW_PIC_USER, 3, 0)
|
||||
TP_NOTIFY.Controls.Add(Me.CH_NOTIFY_SIMPLE, 1, 0)
|
||||
TP_NOTIFY.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
TP_NOTIFY.Location = New System.Drawing.Point(1, 166)
|
||||
TP_NOTIFY.Location = New System.Drawing.Point(1, 195)
|
||||
TP_NOTIFY.Margin = New System.Windows.Forms.Padding(0)
|
||||
TP_NOTIFY.Name = "TP_NOTIFY"
|
||||
TP_NOTIFY.RowCount = 1
|
||||
TP_NOTIFY.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_NOTIFY.Size = New System.Drawing.Size(474, 25)
|
||||
TP_NOTIFY.Size = New System.Drawing.Size(474, 28)
|
||||
TP_NOTIFY.TabIndex = 2
|
||||
'
|
||||
'CH_NOTIFY
|
||||
@@ -283,7 +285,7 @@ Namespace DownloadObjects
|
||||
Me.CH_NOTIFY.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_NOTIFY.Location = New System.Drawing.Point(3, 3)
|
||||
Me.CH_NOTIFY.Name = "CH_NOTIFY"
|
||||
Me.CH_NOTIFY.Size = New System.Drawing.Size(112, 19)
|
||||
Me.CH_NOTIFY.Size = New System.Drawing.Size(112, 22)
|
||||
Me.CH_NOTIFY.TabIndex = 0
|
||||
Me.CH_NOTIFY.Text = "Show notifications"
|
||||
TT_MAIN.SetToolTip(Me.CH_NOTIFY, "Show notification when some data has been downloaded")
|
||||
@@ -295,7 +297,7 @@ Namespace DownloadObjects
|
||||
Me.CH_SHOW_PIC.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_SHOW_PIC.Location = New System.Drawing.Point(239, 3)
|
||||
Me.CH_SHOW_PIC.Name = "CH_SHOW_PIC"
|
||||
Me.CH_SHOW_PIC.Size = New System.Drawing.Size(112, 19)
|
||||
Me.CH_SHOW_PIC.Size = New System.Drawing.Size(112, 22)
|
||||
Me.CH_SHOW_PIC.TabIndex = 2
|
||||
Me.CH_SHOW_PIC.Text = "Image"
|
||||
TT_MAIN.SetToolTip(Me.CH_SHOW_PIC, "Show downloaded image in notification")
|
||||
@@ -307,7 +309,7 @@ Namespace DownloadObjects
|
||||
Me.CH_SHOW_PIC_USER.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_SHOW_PIC_USER.Location = New System.Drawing.Point(357, 3)
|
||||
Me.CH_SHOW_PIC_USER.Name = "CH_SHOW_PIC_USER"
|
||||
Me.CH_SHOW_PIC_USER.Size = New System.Drawing.Size(114, 19)
|
||||
Me.CH_SHOW_PIC_USER.Size = New System.Drawing.Size(114, 22)
|
||||
Me.CH_SHOW_PIC_USER.TabIndex = 3
|
||||
Me.CH_SHOW_PIC_USER.Text = "User icon"
|
||||
TT_MAIN.SetToolTip(Me.CH_SHOW_PIC_USER, "Show user image in notification")
|
||||
@@ -319,7 +321,7 @@ Namespace DownloadObjects
|
||||
Me.CH_NOTIFY_SIMPLE.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_NOTIFY_SIMPLE.Location = New System.Drawing.Point(121, 3)
|
||||
Me.CH_NOTIFY_SIMPLE.Name = "CH_NOTIFY_SIMPLE"
|
||||
Me.CH_NOTIFY_SIMPLE.Size = New System.Drawing.Size(112, 19)
|
||||
Me.CH_NOTIFY_SIMPLE.Size = New System.Drawing.Size(112, 22)
|
||||
Me.CH_NOTIFY_SIMPLE.TabIndex = 1
|
||||
Me.CH_NOTIFY_SIMPLE.Text = "Simple"
|
||||
TT_MAIN.SetToolTip(Me.CH_NOTIFY_SIMPLE, resources.GetString("CH_NOTIFY_SIMPLE.ToolTip"))
|
||||
@@ -329,15 +331,15 @@ Namespace DownloadObjects
|
||||
'
|
||||
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(476, 301)
|
||||
Me.ClientSize = New System.Drawing.Size(476, 333)
|
||||
Me.Controls.Add(CONTAINER_MAIN)
|
||||
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
|
||||
Me.Icon = Global.SCrawler.My.Resources.Resources.ArrowDownIcon_Blue_24
|
||||
Me.KeyPreview = True
|
||||
Me.MaximizeBox = False
|
||||
Me.MaximumSize = New System.Drawing.Size(492, 340)
|
||||
Me.MaximumSize = New System.Drawing.Size(492, 372)
|
||||
Me.MinimizeBox = False
|
||||
Me.MinimumSize = New System.Drawing.Size(492, 340)
|
||||
Me.MinimumSize = New System.Drawing.Size(492, 372)
|
||||
Me.Name = "AutoDownloaderEditorForm"
|
||||
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
|
||||
Me.Text = "AutoDownloader settings"
|
||||
|
||||
@@ -101,7 +101,7 @@ Namespace DownloadObjects
|
||||
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GROUPS.ActionOnButtonClick
|
||||
Select Case Sender.DefaultButton
|
||||
Case ActionButton.DefaultButtons.Edit
|
||||
Using f As New LabelsForm(MyGroups, Settings.Groups.Select(Function(g) g.Name)) With {.Text = "Groups"}
|
||||
Using f As New LabelsForm(MyGroups, Settings.Groups.Select(Function(g) g.Name)) With {.Text = "Groups", .Icon = My.Resources.GroupByIcon_16}
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then MyGroups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : TXT_GROUPS.Text = MyGroups.ListToString
|
||||
End Using
|
||||
@@ -111,7 +111,7 @@ Namespace DownloadObjects
|
||||
Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged, OPT_ALL.CheckedChanged, OPT_DEFAULT.CheckedChanged,
|
||||
OPT_SPEC.CheckedChanged, OPT_GROUP.CheckedChanged,
|
||||
CH_NOTIFY.CheckedChanged, CH_NOTIFY_SIMPLE.CheckedChanged
|
||||
DEF_GROUP.Enabled = OPT_SPEC.Checked
|
||||
DEF_GROUP.Enabled(OPT_ALL.Checked Or OPT_DEFAULT.Checked Or OPT_SPEC.Checked) = OPT_SPEC.Checked
|
||||
TXT_GROUPS.Enabled = OPT_GROUP.Checked
|
||||
TXT_TIMER.Enabled = Not OPT_DISABLED.Checked
|
||||
NUM_DELAY.Enabled = Not OPT_DISABLED.Checked
|
||||
|
||||
@@ -178,7 +178,18 @@ Namespace DownloadObjects
|
||||
Private Sub UpdateBaseButton(ByVal Checked As Boolean)
|
||||
With MainFrameObj.MF
|
||||
Select Case Place
|
||||
Case ButtonsPlace.MainFrame : ApplyButtonStyle(.BTT_DOWN_AUTOMATION_PAUSE, Sub() .BTT_DOWN_AUTOMATION_PAUSE.Checked = Checked)
|
||||
Case ButtonsPlace.MainFrame : ApplyButtonStyle(.BTT_DOWN_AUTOMATION_PAUSE, Sub()
|
||||
.BTT_DOWN_AUTOMATION_PAUSE.Checked = Checked
|
||||
With .MENU_DOWN_ALL
|
||||
If Checked Then
|
||||
.BackColor = MyColor.UpdateBack
|
||||
.ForeColor = MyColor.UpdateFore
|
||||
Else
|
||||
.BackColor = Control.DefaultBackColor
|
||||
.ForeColor = Control.DefaultForeColor
|
||||
End If
|
||||
End With
|
||||
End Sub)
|
||||
Case ButtonsPlace.Tray : ApplyButtonStyle(MainFrameObj.MF.BTT_TRAY_PAUSE_AUTOMATION, Sub() MainFrameObj.MF.BTT_TRAY_PAUSE_AUTOMATION.Checked = Checked)
|
||||
End Select
|
||||
End With
|
||||
|
||||
@@ -40,7 +40,7 @@ Namespace DownloadObjects
|
||||
If Plans.Count > 0 Then Plans.ForEach(Sub(p)
|
||||
p.Source = Me
|
||||
AddHandler p.PauseDisabled, AddressOf OnPauseDisabled
|
||||
End Sub)
|
||||
End Sub) : Plans.ListReindex
|
||||
End Sub
|
||||
Default Friend ReadOnly Property Item(ByVal Index As Integer) As AutoDownloader Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorObject
|
||||
Get
|
||||
@@ -59,6 +59,7 @@ Namespace DownloadObjects
|
||||
Plan.Source = Me
|
||||
AddHandler Plan.PauseDisabled, AddressOf OnPauseDisabled
|
||||
Plans.Add(Plan)
|
||||
Plans.ListReindex
|
||||
Update()
|
||||
End Sub
|
||||
Friend Async Function RemoveAt(ByVal Index As Integer) As Task
|
||||
@@ -73,6 +74,7 @@ Namespace DownloadObjects
|
||||
.Dispose()
|
||||
End With
|
||||
Plans.RemoveAt(Index)
|
||||
Plans.ListReindex
|
||||
Update()
|
||||
End If
|
||||
End Function
|
||||
@@ -98,16 +100,18 @@ Namespace DownloadObjects
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Execution"
|
||||
Friend Async Sub Start(ByVal Init As Boolean)
|
||||
If Count > 0 Then
|
||||
If Plans.Exists(PlanDownloading) Then Await Task.Run(Sub() PlansWaiter(PlanDownloading))
|
||||
For Each Plan In Plans
|
||||
Plan.Start(Init)
|
||||
Thread.Sleep(1000)
|
||||
Await Task.Run(Sub() PlansWaiter(PlanDownloading))
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
Friend Async Function Start(ByVal Init As Boolean) As Task
|
||||
Await Task.Run(Sub()
|
||||
If Count > 0 Then
|
||||
If Plans.Exists(PlanDownloading) Then PlansWaiter(PlanDownloading)
|
||||
For Each Plan In Plans
|
||||
Plan.Start(Init)
|
||||
PlansWaiter(PlanDownloading)
|
||||
Thread.Sleep(1000)
|
||||
Next
|
||||
End If
|
||||
End Sub)
|
||||
End Function
|
||||
Friend Sub [Stop]()
|
||||
If Count > 0 Then Plans.ForEach(Sub(p) p.Stop())
|
||||
End Sub
|
||||
|
||||
@@ -157,7 +157,7 @@ Namespace DownloadObjects
|
||||
Using chooser As New SimpleListForm(Of SFile)(fList, Settings.Design) With {
|
||||
.FormText = "Sessions",
|
||||
.Icon = My.Resources.ArrowDownIcon_Blue_24,
|
||||
.Mode = SimpleListForm(Of SFile).Modes.CheckedItems,
|
||||
.Mode = SimpleListFormModes.CheckedItems,
|
||||
.Provider = New CustomProvider(Function(v, d, p, n, ee) DirectCast(v, SFile).File)
|
||||
}
|
||||
chooser.ClearButtons()
|
||||
|
||||
@@ -10,7 +10,7 @@ Imports LibVLCSharp
|
||||
Imports System.Threading
|
||||
Imports System.ComponentModel
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web
|
||||
Imports VLCState = LibVLCSharp.Shared.VLCState
|
||||
Namespace DownloadObjects
|
||||
<ToolboxItem(False), DesignTimeVisible(False)>
|
||||
|
||||
@@ -6,7 +6,6 @@
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports SCrawler.API
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.XML.Base
|
||||
@@ -51,6 +50,7 @@ Namespace DownloadObjects.Groups
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Initializers"
|
||||
Friend ReadOnly NeedToSave As Boolean = False
|
||||
Friend Sub New()
|
||||
BTT_MENU = New ToolStripMenuItem With {
|
||||
.ToolTipText = "Download users of this group",
|
||||
@@ -90,12 +90,18 @@ Namespace DownloadObjects.Groups
|
||||
End Sub
|
||||
Friend Sub New(ByVal e As EContainer)
|
||||
Me.New
|
||||
Name = e.Attribute(Name_Name)
|
||||
Temporary = e.Attribute(Name_Temporary).Value.FromXML(Of Integer)(CInt(CheckState.Indeterminate))
|
||||
Favorite = e.Attribute(Name_Favorite).Value.FromXML(Of Integer)(CInt(CheckState.Indeterminate))
|
||||
ReadyForDownload = e.Attribute(Name_ReadyForDownload).Value.FromXML(Of Boolean)(True)
|
||||
ReadyForDownloadIgnore = e.Attribute(Name_ReadyForDownloadIgnore).Value.FromXML(Of Boolean)(False)
|
||||
If Not e.Value.IsEmptyString Then Labels.ListAddList(e.Value.Split("|"), LAP.NotContainsOnly)
|
||||
If e.Attributes.Contains(New EAttribute(Name_Name)) Then
|
||||
'TODELETE: 2022.10.18.0
|
||||
NeedToSave = True
|
||||
Name = e.Attribute(Name_Name)
|
||||
Temporary = e.Attribute(Name_Temporary).Value.FromXML(Of Integer)(CInt(CheckState.Indeterminate))
|
||||
Favorite = e.Attribute(Name_Favorite).Value.FromXML(Of Integer)(CInt(CheckState.Indeterminate))
|
||||
ReadyForDownload = e.Attribute(Name_ReadyForDownload).Value.FromXML(Of Boolean)(True)
|
||||
ReadyForDownloadIgnore = e.Attribute(Name_ReadyForDownloadIgnore).Value.FromXML(Of Boolean)(False)
|
||||
If Not e.Value.IsEmptyString Then Labels.ListAddList(e.Value.Split("|"), LAP.NotContainsOnly)
|
||||
Else
|
||||
Import(e)
|
||||
End If
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "ToString"
|
||||
@@ -149,19 +155,28 @@ Namespace DownloadObjects.Groups
|
||||
(.Temporary = CheckState.Indeterminate Or user.Temporary = CBool(.Temporary)) And
|
||||
(.Favorite = CheckState.Indeterminate Or (user.Favorite = CBool(.Favorite))) And
|
||||
(Not UseReadyOption Or .ReadyForDownloadIgnore Or user.ReadyForDownload = .ReadyForDownload) And user.Exists
|
||||
Dim f As Func(Of IUserData, IEnumerable(Of IUserData)) = Function(ByVal user As IUserData) As IEnumerable(Of IUserData)
|
||||
If user.IsCollection Then
|
||||
With DirectCast(user, UserDataBind)
|
||||
If .Count > 0 Then Return .Collections.SelectMany(f)
|
||||
End With
|
||||
Else
|
||||
If .Labels.Count = 0 OrElse user.Labels.ListContains(.Labels) Then
|
||||
If CheckParams.Invoke(user) Then Return {user}
|
||||
End If
|
||||
End If
|
||||
Return New IUserData() {}
|
||||
End Function
|
||||
Return Settings.Users.SelectMany(f)
|
||||
Dim CheckLabelsExcluded As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
|
||||
If .LabelsExcluded.Count = 0 Then
|
||||
Return True
|
||||
ElseIf user.Labels.Count = 0 Then
|
||||
Return True
|
||||
Else
|
||||
Return Not user.Labels.ListContains(.LabelsExcluded)
|
||||
End If
|
||||
End Function
|
||||
Dim CheckLabels As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
|
||||
If .Labels.Count = 0 Then
|
||||
Return CheckLabelsExcluded.Invoke(user)
|
||||
ElseIf user.Labels.Count = 0 Then
|
||||
Return False
|
||||
Else
|
||||
Return user.Labels.ListContains(.Labels) And CheckLabelsExcluded.Invoke(user)
|
||||
End If
|
||||
End Function
|
||||
Dim CheckSites As Predicate(Of IUserData) = Function(user) _
|
||||
(.Sites.Count = 0 OrElse .Sites.Contains(user.Site)) AndAlso
|
||||
(.SitesExcluded.Count = 0 OrElse Not .SitesExcluded.Contains(user.Site))
|
||||
Return Settings.GetUsers(Function(user) CheckLabels.Invoke(user) AndAlso CheckSites.Invoke(user) AndAlso CheckParams.Invoke(user))
|
||||
End With
|
||||
Else
|
||||
Return Nothing
|
||||
@@ -189,11 +204,7 @@ Namespace DownloadObjects.Groups
|
||||
#End Region
|
||||
#Region "IEContainerProvider Support"
|
||||
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
|
||||
Return New EContainer("Group", Labels.ListToString("|"), {New EAttribute(Name_Name, Name),
|
||||
New EAttribute(Name_Temporary, CInt(Temporary)),
|
||||
New EAttribute(Name_Favorite, CInt(Favorite)),
|
||||
New EAttribute(Name_ReadyForDownload, ReadyForDownload.BoolToInteger),
|
||||
New EAttribute(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger)})
|
||||
Return Export(New EContainer("Group"))
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IDisposable Support"
|
||||
|
||||
@@ -22,10 +22,15 @@ Namespace DownloadObjects.Groups
|
||||
x.LoadData()
|
||||
If x.Count > 0 Then GroupsList.ListAddList(x, LAP.IgnoreICopier)
|
||||
End Using
|
||||
If GroupsList.Count > 0 Then GroupsList.ForEach(Sub(ByVal g As DownloadGroup)
|
||||
AddHandler g.Deleted, AddressOf OnGroupDeleted
|
||||
AddHandler g.Updated, AddressOf OnGroupUpdated
|
||||
End Sub)
|
||||
With GroupsList
|
||||
If .Count > 0 Then
|
||||
.ForEach(Sub(ByVal g As DownloadGroup)
|
||||
AddHandler g.Deleted, AddressOf OnGroupDeleted
|
||||
AddHandler g.Updated, AddressOf OnGroupUpdated
|
||||
End Sub)
|
||||
If .Exists(Function(g) g.NeedToSave) Then Update()
|
||||
End If
|
||||
End With
|
||||
End If
|
||||
GroupsList.ListReindex
|
||||
End Sub
|
||||
@@ -49,9 +54,9 @@ Namespace DownloadObjects.Groups
|
||||
GroupFile.Delete()
|
||||
End If
|
||||
End Sub
|
||||
Private _GroupAddInProgress As Boolean = False
|
||||
Private Sub OnGroupUpdated(ByVal Sender As DownloadGroup)
|
||||
Update()
|
||||
RaiseEvent Updated(Sender)
|
||||
If Not _GroupAddInProgress Then Update() : RaiseEvent Updated(Sender)
|
||||
End Sub
|
||||
Private Sub OnGroupDeleted(ByVal Sender As DownloadGroup)
|
||||
RaiseEvent Deleted(Sender)
|
||||
@@ -67,10 +72,16 @@ Namespace DownloadObjects.Groups
|
||||
Using f As New GroupEditorForm(Nothing)
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then
|
||||
_GroupAddInProgress = True
|
||||
GroupsList.Add(f.MyGroup)
|
||||
With GroupsList.Last
|
||||
AddHandler .Deleted, AddressOf OnGroupDeleted
|
||||
AddHandler .Updated, AddressOf OnGroupUpdated
|
||||
End With
|
||||
GroupsList.ListReindex
|
||||
RaiseEvent Added(GroupsList.Last)
|
||||
Update()
|
||||
_GroupAddInProgress = False
|
||||
End If
|
||||
End Using
|
||||
End Sub
|
||||
|
||||
@@ -18,28 +18,28 @@ Namespace DownloadObjects.Groups
|
||||
Private ReadOnly CH_READY_FOR_DOWN As CheckBox
|
||||
Private ReadOnly CH_READY_FOR_DOWN_IGNORE As CheckBox
|
||||
Private WithEvents TXT_LABELS As TextBoxExtended
|
||||
Private WithEvents TXT_SITES As TextBoxExtended
|
||||
Friend WithEvents TXT_NAME As TextBoxExtended
|
||||
Private ReadOnly Labels As List(Of String)
|
||||
Private ReadOnly LabelsExcluded As List(Of String)
|
||||
Private ReadOnly Sites As List(Of String)
|
||||
Private ReadOnly SitesExcluded As List(Of String)
|
||||
Public Sub New()
|
||||
Labels = New List(Of String)
|
||||
TXT_LABELS = New TextBoxExtended
|
||||
With TXT_LABELS
|
||||
.BeginInit()
|
||||
.Buttons.AddRange({ADB.Edit, ADB.Clear})
|
||||
.CaptionText = "Labels"
|
||||
.CaptionWidth = 50
|
||||
.Dock = DockStyle.Fill
|
||||
.EndInit()
|
||||
End With
|
||||
TXT_NAME = New TextBoxExtended
|
||||
With TXT_NAME
|
||||
.BeginInit()
|
||||
.Buttons.Add(ADB.Clear)
|
||||
.CaptionText = "Name"
|
||||
.CaptionWidth = 50
|
||||
.Dock = DockStyle.Fill
|
||||
.EndInit()
|
||||
End With
|
||||
LabelsExcluded = New List(Of String)
|
||||
Sites = New List(Of String)
|
||||
SitesExcluded = New List(Of String)
|
||||
|
||||
InitTextBox(TXT_LABELS, "Labels", {New ActionButton(ADB.Edit) With {.ToolTipText = "Edit selected labels"},
|
||||
New ActionButton(ADB.Delete) With {.ToolTipText = "Edit excluded labels"}, ADB.Clear})
|
||||
TXT_LABELS.TextBoxReadOnly = True
|
||||
|
||||
InitTextBox(TXT_SITES, "Sites", {New ActionButton(ADB.Edit) With {.ToolTipText = "Edit selected sites"},
|
||||
New ActionButton(ADB.Delete) With {.ToolTipText = "Edit excluded sites"}, ADB.Clear})
|
||||
TXT_SITES.TextBoxReadOnly = True
|
||||
|
||||
InitTextBox(TXT_NAME, "Name", {ADB.Clear})
|
||||
|
||||
CH_TEMPORARY = New CheckBox With {.Text = "Temporary", .Name = "CH_TEMPORARY", .ThreeState = True, .CheckState = CheckState.Indeterminate, .Dock = DockStyle.Fill}
|
||||
CH_FAV = New CheckBox With {.Text = "Favorite", .Name = "CH_FAV", .ThreeState = True, .CheckState = CheckState.Indeterminate, .Dock = DockStyle.Fill}
|
||||
CH_READY_FOR_DOWN = New CheckBox With {.Text = "Ready for download", .Name = "CH_READY_FOR_DOWN", .Checked = True, .Dock = DockStyle.Fill}
|
||||
@@ -49,6 +49,17 @@ Namespace DownloadObjects.Groups
|
||||
TP_2 = New TableLayoutPanel With {.CellBorderStyle = TableLayoutPanelCellBorderStyle.Single, .Margin = New Padding(0), .Dock = DockStyle.Fill}
|
||||
FillTP(TP_2, CH_READY_FOR_DOWN, CH_READY_FOR_DOWN_IGNORE)
|
||||
End Sub
|
||||
Private Sub InitTextBox(ByRef TXT As TextBoxExtended, ByVal Caption As String, ByVal Buttons As ActionButton())
|
||||
TXT = New TextBoxExtended
|
||||
With TXT
|
||||
.BeginInit()
|
||||
.Buttons.AddRange(Buttons)
|
||||
.CaptionText = Caption
|
||||
.CaptionWidth = 50
|
||||
.Dock = DockStyle.Fill
|
||||
.EndInit()
|
||||
End With
|
||||
End Sub
|
||||
Private Sub FillTP(ByRef TP As TableLayoutPanel, ByVal CNT1 As Control, ByVal CNT2 As Control)
|
||||
With TP
|
||||
.ColumnCount = 2
|
||||
@@ -87,33 +98,63 @@ Namespace DownloadObjects.Groups
|
||||
CellBorderStyle = TableLayoutPanelCellBorderStyle.Single
|
||||
ColumnCount = 1
|
||||
ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100))
|
||||
RowCount = 6
|
||||
RowCount = 7
|
||||
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
|
||||
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
|
||||
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
|
||||
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
RowStyles.Add(New RowStyle(SizeType.Percent, 100))
|
||||
End If
|
||||
Controls.Add(TXT_NAME, 0, 1)
|
||||
Controls.Add(TP_1, 0, 2)
|
||||
Controls.Add(TP_2, 0, 3)
|
||||
Controls.Add(TXT_LABELS, 0, 4)
|
||||
Controls.Add(TXT_SITES, 0, 5)
|
||||
End Sub
|
||||
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_LABELS.ActionOnButtonClick
|
||||
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_LABELS.ActionOnButtonClick
|
||||
Select Case Sender.DefaultButton
|
||||
Case ADB.Edit
|
||||
Using f As New LabelsForm(Labels)
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then
|
||||
Labels.ListAddList(f.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
TXT_LABELS.Clear()
|
||||
TXT_LABELS.Text = Labels.ListToString
|
||||
End If
|
||||
End Using
|
||||
Case ADB.Clear : Labels.Clear()
|
||||
Case ADB.Edit, ADB.Delete
|
||||
With If(Sender.DefaultButton = ADB.Edit, Labels, LabelsExcluded)
|
||||
Using f As New LabelsForm(.ListSelf, True)
|
||||
If Sender.DefaultButton = ADB.Delete Then f.Text &= " excluded"
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then
|
||||
.AsList.ListAddList(f.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
UpdateLabelsText()
|
||||
End If
|
||||
End Using
|
||||
End With
|
||||
Case ADB.Clear : Labels.Clear() : LabelsExcluded.Clear() : TXT_LABELS.Clear() : UpdateLabelsText()
|
||||
End Select
|
||||
End Sub
|
||||
Private Sub TXT_SITES_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_SITES.ActionOnButtonClick
|
||||
Select Case Sender.DefaultButton
|
||||
Case ADB.Edit, ADB.Delete
|
||||
With If(Sender.DefaultButton = ADB.Edit, Sites, SitesExcluded)
|
||||
Using f As New Editors.SiteSelectionForm(.ListSelf)
|
||||
If Sender.DefaultButton = ADB.Delete Then f.Text &= " excluded"
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then
|
||||
.AsList.ListAddList(f.SelectedSites, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
UpdateSitesText()
|
||||
End If
|
||||
End Using
|
||||
End With
|
||||
Case ADB.Clear : Sites.Clear() : SitesExcluded.Clear() : TXT_SITES.Clear() : UpdateSitesText()
|
||||
End Select
|
||||
End Sub
|
||||
Private Sub UpdateLabelsText()
|
||||
TXT_LABELS.Clear()
|
||||
If Not _JustExcludeOptions Then TXT_LABELS.Text = Labels.ListToString
|
||||
If LabelsExcluded.Count > 0 Then TXT_LABELS.Text.StringAppend($"EXCLUDED: {LabelsExcluded.ListToString}", "; ")
|
||||
End Sub
|
||||
Private Sub UpdateSitesText()
|
||||
TXT_SITES.Clear()
|
||||
If Not _JustExcludeOptions Then TXT_SITES.Text = Sites.ListToString
|
||||
If SitesExcluded.Count > 0 Then TXT_SITES.Text.StringAppend($"EXCLUDED: {SitesExcluded.ListToString}", "; ")
|
||||
End Sub
|
||||
Friend Sub [Get](ByRef Instance As IGroup)
|
||||
If Not Instance Is Nothing Then
|
||||
With Instance
|
||||
@@ -124,6 +165,12 @@ Namespace DownloadObjects.Groups
|
||||
.ReadyForDownloadIgnore = CH_READY_FOR_DOWN_IGNORE.Checked
|
||||
.Labels.Clear()
|
||||
.Labels.ListAddList(Labels)
|
||||
.LabelsExcluded.Clear()
|
||||
.LabelsExcluded.ListAddList(LabelsExcluded)
|
||||
.Sites.Clear()
|
||||
.Sites.ListAddList(Sites)
|
||||
.SitesExcluded.Clear()
|
||||
.SitesExcluded.ListAddList(SitesExcluded)
|
||||
End With
|
||||
End If
|
||||
End Sub
|
||||
@@ -135,21 +182,48 @@ Namespace DownloadObjects.Groups
|
||||
CH_FAV.CheckState = .Favorite
|
||||
CH_READY_FOR_DOWN.Checked = .ReadyForDownload
|
||||
CH_READY_FOR_DOWN_IGNORE.Checked = .ReadyForDownloadIgnore
|
||||
|
||||
Labels.ListAddList(.Labels)
|
||||
TXT_LABELS.Text = Labels.ListToString
|
||||
LabelsExcluded.ListAddList(.LabelsExcluded)
|
||||
UpdateLabelsText()
|
||||
|
||||
Sites.ListAddList(.Sites)
|
||||
SitesExcluded.ListAddList(.SitesExcluded)
|
||||
UpdateSitesText()
|
||||
End With
|
||||
End If
|
||||
End Sub
|
||||
Private _Enabled As Boolean = True
|
||||
Friend Shadows Property Enabled As Boolean
|
||||
Private _JustExcludeOptions As Boolean = False
|
||||
Friend Overloads Property Enabled(Optional ByVal LeaveExcludeOptions As Boolean = False) As Boolean
|
||||
Get
|
||||
Return _Enabled
|
||||
End Get
|
||||
Set(ByVal e As Boolean)
|
||||
_Enabled = e
|
||||
_JustExcludeOptions = False
|
||||
TP_1.Enabled = e
|
||||
TP_2.Enabled = e
|
||||
TXT_LABELS.Enabled = e
|
||||
If e Then
|
||||
TXT_LABELS.Enabled = True
|
||||
TXT_SITES.Enabled = True
|
||||
ElseIf LeaveExcludeOptions Then
|
||||
_JustExcludeOptions = True
|
||||
TXT_LABELS.Enabled = True
|
||||
TXT_LABELS.Button(ADB.Edit).Enabled = False
|
||||
TXT_LABELS.Button(ADB.Delete).Enabled = True
|
||||
TXT_LABELS.Button(ADB.Clear).Enabled = False
|
||||
|
||||
TXT_SITES.Enabled = True
|
||||
TXT_SITES.Button(ADB.Edit).Enabled = False
|
||||
TXT_SITES.Button(ADB.Delete).Enabled = True
|
||||
TXT_SITES.Button(ADB.Clear).Enabled = False
|
||||
Else
|
||||
TXT_LABELS.Enabled = False
|
||||
TXT_SITES.Enabled = False
|
||||
End If
|
||||
UpdateLabelsText()
|
||||
UpdateSitesText()
|
||||
End Set
|
||||
End Property
|
||||
End Class
|
||||
|
||||
18
SCrawler/Download/Groups/GroupEditorForm.Designer.vb
generated
@@ -35,13 +35,13 @@ Namespace DownloadObjects.Groups
|
||||
'CONTAINER_MAIN.ContentPanel
|
||||
'
|
||||
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEFS_GROUP)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 109)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 141)
|
||||
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
CONTAINER_MAIN.LeftToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
|
||||
CONTAINER_MAIN.RightToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(476, 134)
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(476, 166)
|
||||
CONTAINER_MAIN.TabIndex = 0
|
||||
CONTAINER_MAIN.TopToolStripPanelVisible = False
|
||||
'
|
||||
@@ -53,29 +53,30 @@ Namespace DownloadObjects.Groups
|
||||
Me.DEFS_GROUP.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.DEFS_GROUP.Location = New System.Drawing.Point(0, 0)
|
||||
Me.DEFS_GROUP.Name = "DEFS_GROUP"
|
||||
Me.DEFS_GROUP.RowCount = 6
|
||||
Me.DEFS_GROUP.RowCount = 7
|
||||
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 0!))
|
||||
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
|
||||
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.DEFS_GROUP.Size = New System.Drawing.Size(476, 109)
|
||||
Me.DEFS_GROUP.TabIndex = 1
|
||||
Me.DEFS_GROUP.Size = New System.Drawing.Size(476, 141)
|
||||
Me.DEFS_GROUP.TabIndex = 0
|
||||
'
|
||||
'GroupEditorForm
|
||||
'
|
||||
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(476, 134)
|
||||
Me.ClientSize = New System.Drawing.Size(476, 166)
|
||||
Me.Controls.Add(CONTAINER_MAIN)
|
||||
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
|
||||
Me.Icon = Global.SCrawler.My.Resources.Resources.GroupByIcon_16
|
||||
Me.KeyPreview = True
|
||||
Me.MaximizeBox = False
|
||||
Me.MaximumSize = New System.Drawing.Size(492, 173)
|
||||
Me.MaximumSize = New System.Drawing.Size(492, 205)
|
||||
Me.MinimizeBox = False
|
||||
Me.MinimumSize = New System.Drawing.Size(492, 173)
|
||||
Me.MinimumSize = New System.Drawing.Size(492, 205)
|
||||
Me.Name = "GroupEditorForm"
|
||||
Me.ShowInTaskbar = False
|
||||
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
|
||||
@@ -86,6 +87,7 @@ Namespace DownloadObjects.Groups
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
|
||||
Private WithEvents DEFS_GROUP As GroupDefaults
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -6,10 +6,14 @@
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Namespace DownloadObjects.Groups
|
||||
Friend Interface IGroup
|
||||
Property Name As String
|
||||
ReadOnly Property Labels As List(Of String)
|
||||
ReadOnly Property LabelsExcluded As List(Of String)
|
||||
ReadOnly Property Sites As List(Of String)
|
||||
ReadOnly Property SitesExcluded As List(Of String)
|
||||
Property Temporary As CheckState
|
||||
Property Favorite As CheckState
|
||||
Property ReadyForDownload As Boolean
|
||||
@@ -21,20 +25,60 @@ Namespace DownloadObjects.Groups
|
||||
Protected Const Name_Favorite As String = "Favorite"
|
||||
Protected Const Name_ReadyForDownload As String = "RFD"
|
||||
Protected Const Name_ReadyForDownloadIgnore As String = "RFDI"
|
||||
Protected Const Name_Labels As String = "Labels"
|
||||
Protected Const Name_Labels_Excluded As String = "LabelsExcluded"
|
||||
Protected Const Name_Sites As String = "Sites"
|
||||
Protected Const Name_Sites_Excluded As String = "SitesExcluded"
|
||||
Friend Property Name As String Implements IGroup.Name
|
||||
Friend ReadOnly Property Labels As List(Of String) Implements IGroup.Labels
|
||||
Friend ReadOnly Property LabelsExcluded As List(Of String) Implements IGroup.LabelsExcluded
|
||||
Friend ReadOnly Property Sites As List(Of String) Implements IGroup.Sites
|
||||
Friend ReadOnly Property SitesExcluded As List(Of String) Implements IGroup.SitesExcluded
|
||||
Friend Property Temporary As CheckState = CheckState.Indeterminate Implements IGroup.Temporary
|
||||
Friend Property Favorite As CheckState = CheckState.Indeterminate Implements IGroup.Favorite
|
||||
Friend Property ReadyForDownload As Boolean = True Implements IGroup.ReadyForDownload
|
||||
Friend Property ReadyForDownloadIgnore As Boolean = False Implements IGroup.ReadyForDownloadIgnore
|
||||
Friend Sub New()
|
||||
Labels = New List(Of String)
|
||||
LabelsExcluded = New List(Of String)
|
||||
Sites = New List(Of String)
|
||||
SitesExcluded = New List(Of String)
|
||||
End Sub
|
||||
Protected Sub Import(ByVal e As EContainer)
|
||||
Name = e.Value(Name_Name)
|
||||
Temporary = e.Value(Name_Temporary).FromXML(Of Integer)(CInt(CheckState.Indeterminate))
|
||||
Favorite = e.Value(Name_Favorite).FromXML(Of Integer)(CInt(CheckState.Indeterminate))
|
||||
ReadyForDownload = e.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
|
||||
ReadyForDownloadIgnore = e.Value(Name_ReadyForDownloadIgnore).FromXML(Of Boolean)(False)
|
||||
|
||||
Dim l As New ListAddParams(LAP.NotContainsOnly)
|
||||
If Not e.Value(Name_Labels).IsEmptyString Then Labels.ListAddList(e.Value(Name_Labels).Split("|"), l)
|
||||
If Not e.Value(Name_Labels_Excluded).IsEmptyString Then LabelsExcluded.ListAddList(e.Value(Name_Labels_Excluded).Split("|"), l)
|
||||
If Not e.Value(Name_Sites).IsEmptyString Then Sites.ListAddList(e.Value(Name_Sites).Split("|"), l)
|
||||
If Not e.Value(Name_Sites_Excluded).IsEmptyString Then SitesExcluded.ListAddList(e.Value(Name_Sites_Excluded).Split("|"), l)
|
||||
End Sub
|
||||
Protected Function Export(ByVal e As EContainer) As EContainer
|
||||
e.AddRange({New EContainer(Name_Name, Name),
|
||||
New EContainer(Name_Temporary, CInt(Temporary)),
|
||||
New EContainer(Name_Favorite, CInt(Favorite)),
|
||||
New EContainer(Name_ReadyForDownload, ReadyForDownload.BoolToInteger),
|
||||
New EContainer(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger),
|
||||
New EContainer(Name_Labels, Labels.ListToString("|")),
|
||||
New EContainer(Name_Labels_Excluded, LabelsExcluded.ListToString("|")),
|
||||
New EContainer(Name_Sites, Sites.ListToString("|")),
|
||||
New EContainer(Name_Sites_Excluded, SitesExcluded.ListToString("|"))})
|
||||
Return e
|
||||
End Function
|
||||
#Region "IDisposable Support"
|
||||
Protected disposedValue As Boolean = False
|
||||
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue Then
|
||||
If disposing Then Labels.Clear()
|
||||
If disposing Then
|
||||
Labels.Clear()
|
||||
LabelsExcluded.Clear()
|
||||
Sites.Clear()
|
||||
SitesExcluded.Clear()
|
||||
End If
|
||||
disposedValue = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -138,6 +138,7 @@ Namespace DownloadObjects
|
||||
Return If(Pool.Count = 0, 0, Pool.Sum(Function(j) j.Count))
|
||||
End Get
|
||||
End Property
|
||||
Friend Property Suspended As Boolean = False
|
||||
#End Region
|
||||
#Region "Automation Support"
|
||||
Private _AutoDownloaderTasks As Integer = 0
|
||||
@@ -166,9 +167,10 @@ Namespace DownloadObjects
|
||||
End Property
|
||||
Friend ReadOnly Property Name As String
|
||||
Get
|
||||
Return Hosts(0).Name
|
||||
If Not GroupName.IsEmptyString Then Return GroupName Else Return Hosts(0).Name
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property GroupName As String
|
||||
Friend ReadOnly Property TaskCount As Integer
|
||||
Get
|
||||
Return Hosts(0).TaskCount
|
||||
@@ -190,6 +192,10 @@ Namespace DownloadObjects
|
||||
Keys = New List(Of String)
|
||||
[Type] = JobType
|
||||
End Sub
|
||||
Friend Sub New(ByVal JobType As Download, ByVal GroupName As String)
|
||||
Me.New(JobType)
|
||||
Me.GroupName = GroupName
|
||||
End Sub
|
||||
Public Overloads Function Add(ByVal User As IUserData, ByVal _IncludedInTheFeed As Boolean) As Boolean
|
||||
With DirectCast(User, UserDataBase)
|
||||
If Keys.Count > 0 Then
|
||||
@@ -274,6 +280,7 @@ Namespace DownloadObjects
|
||||
#Region "Pool"
|
||||
Friend Sub ReconfPool()
|
||||
If Pool.Count = 0 OrElse Not Pool.Exists(Function(j) j.Working Or j.Count > 0) Then
|
||||
Dim i%
|
||||
Pool.ListClearDispose
|
||||
If Settings.Plugins.Count > 0 Then
|
||||
Pool.Add(New Job(Download.Main))
|
||||
@@ -281,6 +288,15 @@ Namespace DownloadObjects
|
||||
If p.Settings.IsSeparatedTasks Then
|
||||
Pool.Add(New Job(Download.Main))
|
||||
Pool.Last.AddHost(p.Settings)
|
||||
ElseIf Not p.Settings.TaskGroupName.IsEmptyString Then
|
||||
i = -1
|
||||
If Pool.Count > 0 Then i = Pool.FindIndex(Function(pt) pt.GroupName = p.Settings.TaskGroupName)
|
||||
If i >= 0 Then
|
||||
Pool(i).AddHost(p.Settings)
|
||||
Else
|
||||
Pool.Add(New Job(Download.Main, p.Settings.TaskGroupName))
|
||||
Pool.Last.AddHost(p.Settings)
|
||||
End If
|
||||
Else
|
||||
Pool(0).AddHost(p.Settings)
|
||||
End If
|
||||
@@ -315,7 +331,7 @@ Namespace DownloadObjects
|
||||
MyProgressForm.DisableProgressChange = False
|
||||
Do While Pool.Exists(Function(p) p.Count > 0 Or p.Working)
|
||||
For Each j As Job In Pool
|
||||
If j.Count > 0 And Not j.Working Then j.Start(New ThreadStart(Sub() StartDownloading(j)))
|
||||
If j.Count > 0 And Not j.Working And Not Suspended Then j.Start(New ThreadStart(Sub() StartDownloading(j)))
|
||||
Next
|
||||
Thread.Sleep(200)
|
||||
Loop
|
||||
|
||||
50
SCrawler/Download/WebClient2.vb
Normal file
@@ -0,0 +1,50 @@
|
||||
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
|
||||
' This program is free software: you can redistribute it and/or modify
|
||||
' it under the terms of the GNU General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version.
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Net
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace DownloadObjects
|
||||
Friend Class WebClient2 : Implements IDisposable
|
||||
Protected WC As WebClient
|
||||
Protected RC As Response
|
||||
Private ReadOnly RCERROR As New ErrorsDescriber(EDP.ThrowException)
|
||||
Protected UseResponserClient As Boolean
|
||||
Friend Sub New()
|
||||
End Sub
|
||||
Friend Sub New(ByVal Responser As Response)
|
||||
If Not Responser Is Nothing Then
|
||||
RC = Responser
|
||||
UseResponserClient = True
|
||||
Else
|
||||
WC = New WebClient
|
||||
End If
|
||||
End Sub
|
||||
Friend Sub DownloadFile(ByVal URL As String, ByVal File As String)
|
||||
If UseResponserClient Then
|
||||
RC.DownloadFile(URL, File, RCERROR)
|
||||
Else
|
||||
WC.DownloadFile(URL, File)
|
||||
End If
|
||||
End Sub
|
||||
#Region "IDisposable Support"
|
||||
Private disposedValue As Boolean = False
|
||||
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue And disposing And Not WC Is Nothing Then WC.Dispose()
|
||||
disposedValue = True
|
||||
End Sub
|
||||
Protected Overrides Sub Finalize()
|
||||
Dispose(False)
|
||||
MyBase.Finalize()
|
||||
End Sub
|
||||
Friend Sub Dispose() Implements IDisposable.Dispose
|
||||
Dispose(True)
|
||||
GC.SuppressFinalize(Me)
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -24,8 +24,9 @@ Namespace Editors
|
||||
.MyViewInitialize()
|
||||
.AddOkCancelToolbar()
|
||||
Collections.ListAddList(Settings.LastCollections)
|
||||
Collections.ListAddList((From c In Settings.Users Where c.IsCollection Select c.CollectionName), LAP.NotContainsOnly, EDP.ThrowException)
|
||||
If Collections.ListExists Then Collections.Sort() : CMB_COLLECTIONS.Items.AddRange(From c In Collections Select New ListItem(c))
|
||||
Dim ecol As List(Of String) = ListAddList(Nothing, (From c In Settings.Users Where c.IsCollection Select c.CollectionName), LAP.NotContainsOnly)
|
||||
If ecol.ListExists Then ecol.Sort() : Collections.ListAddList(ecol, LAP.NotContainsOnly) : ecol.Clear()
|
||||
If Collections.Count > 0 Then CMB_COLLECTIONS.Items.AddRange(Collections.Select(Function(c) New ListItem(c)))
|
||||
If Not Collection.IsEmptyString And Collections.Contains(Collection) Then CMB_COLLECTIONS.SelectedIndex = Collections.IndexOf(Collection)
|
||||
.DelegateClosingChecker = False
|
||||
.EndLoaderOperations()
|
||||
@@ -55,8 +56,8 @@ Namespace Editors
|
||||
Private Sub CMB_COLLECTIONS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles CMB_COLLECTIONS.ActionOnButtonClick
|
||||
If Sender.DefaultButton = ActionButton.DefaultButtons.Add Then AddNewCollection()
|
||||
End Sub
|
||||
Private Sub CMB_COLLECTIONS_ActionOnListDoubleClick(ByVal _Item As ListViewItem) Handles CMB_COLLECTIONS.ActionOnListDoubleClick
|
||||
_Item.Selected = True
|
||||
Private Sub CMB_COLLECTIONS_ActionOnListDoubleClick(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles CMB_COLLECTIONS.ActionOnListDoubleClick
|
||||
Item.Selected = True
|
||||
MyDefs_ButtonOkClick()
|
||||
End Sub
|
||||
Private Sub AddNewCollection()
|
||||
|
||||
@@ -221,7 +221,7 @@ Namespace Editors
|
||||
End Sub
|
||||
Private Sub TXT_GLOBAL_PATH_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GLOBAL_PATH.ActionOnButtonClick
|
||||
If Sender.DefaultButton = ADB.Open Then
|
||||
Dim f As SFile = SFile.SelectPath(Settings.GlobalPath.Value)
|
||||
Dim f As SFile = SFile.SelectPath(Settings.GlobalPath.Value).IfNullOrEmpty(Settings.GlobalPath.Value)
|
||||
If Not f.IsEmptyString Then TXT_GLOBAL_PATH.Text = f
|
||||
End If
|
||||
End Sub
|
||||
|
||||
2
SCrawler/Editors/LabelsForm.Designer.vb
generated
@@ -79,11 +79,11 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(374, 421)
|
||||
Me.Controls.Add(CONTAINER_MAIN)
|
||||
Me.Icon = Global.SCrawler.My.Resources.Resources.TagIcon_32
|
||||
Me.KeyPreview = True
|
||||
Me.MinimizeBox = False
|
||||
Me.MinimumSize = New System.Drawing.Size(390, 460)
|
||||
Me.Name = "LabelsForm"
|
||||
Me.ShowIcon = False
|
||||
Me.ShowInTaskbar = False
|
||||
Me.Text = "Labels"
|
||||
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
|
||||
|
||||
@@ -9,7 +9,6 @@
|
||||
Imports PersonalUtilities.Forms
|
||||
Imports PersonalUtilities.Forms.Controls
|
||||
Imports PersonalUtilities.Forms.Controls.Base
|
||||
Imports PersonalUtilities.Functions.Messaging
|
||||
Friend Class LabelsForm
|
||||
Private WithEvents MyDefs As DefaultFormOptions
|
||||
Friend ReadOnly Property LabelsList As List(Of String)
|
||||
@@ -18,17 +17,19 @@ Friend Class LabelsForm
|
||||
Get
|
||||
If Not _Source Is Nothing Then
|
||||
Return _Source
|
||||
ElseIf AddNoParsed Then
|
||||
Return ListAddList(Nothing, Settings.Labels).ListAddValue(LabelsKeeper.NoParsedUser, LAP.NotContainsOnly)
|
||||
Else
|
||||
Return Settings.Labels
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Private _AnyLabelAdd As Boolean = False
|
||||
Friend Property MultiUser As Boolean = False
|
||||
Friend Property MultiUserClearExists As Boolean = False
|
||||
Friend Property WithDeleteButton As Boolean = False
|
||||
Friend Sub New(ByVal LabelsArr As IEnumerable(Of String))
|
||||
Private ReadOnly AddNoParsed As Boolean = False
|
||||
Friend Sub New(ByVal LabelsArr As IEnumerable(Of String), Optional ByVal AddNoParsed As Boolean = False)
|
||||
InitializeComponent()
|
||||
Me.AddNoParsed = AddNoParsed
|
||||
LabelsList = New List(Of String)
|
||||
LabelsList.ListAddList(LabelsArr)
|
||||
MyDefs = New DefaultFormOptions(Me, Settings.Design)
|
||||
@@ -43,12 +44,14 @@ Friend Class LabelsForm
|
||||
.MyViewInitialize()
|
||||
.AddOkCancelToolbar()
|
||||
.MyOkCancel.BTT_DELETE.Visible = WithDeleteButton
|
||||
If Source.Count > 0 Then
|
||||
Dim s As List(Of String) = ListAddList(Nothing, Source).ListAddList(LabelsList, LAP.NotContainsOnly)
|
||||
If s.ListExists Then
|
||||
Dim items As New List(Of Integer)
|
||||
s.Sort()
|
||||
CMB_LABELS.BeginUpdate()
|
||||
For i% = 0 To Source.Count - 1
|
||||
If LabelsList.Contains(Source(i)) Then items.Add(i)
|
||||
CMB_LABELS.Items.Add(Source(i))
|
||||
For i% = 0 To s.Count - 1
|
||||
If LabelsList.Contains(s(i)) Then items.Add(i)
|
||||
CMB_LABELS.Items.Add(s(i))
|
||||
Next
|
||||
If Not _Source Is Nothing Then CMB_LABELS.Buttons.Clear()
|
||||
CMB_LABELS.EndUpdate()
|
||||
@@ -68,24 +71,11 @@ Friend Class LabelsForm
|
||||
End Sub
|
||||
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
|
||||
Try
|
||||
If MultiUser Then
|
||||
Dim m As New MMessage("You are changing labels for more one user" & vbNewLine & "What do you want to do?",
|
||||
"MultiUser labels changing",
|
||||
{New MsgBoxButton("Replace exists") With {.ToolTip = "Per user: all existing labels will be removed and replaced with these labels"},
|
||||
New MsgBoxButton("Add to exists") With {.ToolTip = "Per user: these labels will be add to existing labels"},
|
||||
New MsgBoxButton("Cancel")},
|
||||
MsgBoxStyle.Exclamation)
|
||||
Select Case MsgBoxE(m).Index
|
||||
Case 0 : MultiUserClearExists = True
|
||||
Case 1 : MultiUserClearExists = False
|
||||
Case 2 : Exit Sub
|
||||
End Select
|
||||
End If
|
||||
LabelsList.ListAddList(CMB_LABELS.Items.CheckedItems.Select(Function(l) CStr(l.Value(0))), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
|
||||
If _AnyLabelAdd And _Source Is Nothing Then Settings.Labels.Update()
|
||||
MyDefs.CloseForm()
|
||||
Catch ex As Exception
|
||||
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Choosing labels")
|
||||
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Label selection")
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub MyDefs_ButtonDeleteClickOC(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonDeleteClickOC
|
||||
|
||||
@@ -11,8 +11,8 @@ Imports SCrawler.Plugin.Hosts
|
||||
Imports PersonalUtilities.Forms
|
||||
Imports PersonalUtilities.Forms.Controls
|
||||
Imports PersonalUtilities.Forms.Controls.Base
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports CookieControl = PersonalUtilities.Tools.WEB.CookieListForm.CookieControl
|
||||
Imports PersonalUtilities.Tools.Web.Cookies
|
||||
Imports CookieControl = PersonalUtilities.Tools.Web.Cookies.CookieListForm.CookieControl
|
||||
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
|
||||
Namespace Editors
|
||||
Friend Class SiteEditorForm
|
||||
@@ -205,7 +205,7 @@ Namespace Editors
|
||||
End Sub
|
||||
Private Sub ChangePath(ByVal Sender As ActionButton, ByVal PathValue As SFile, ByRef CNT As TextBoxExtended)
|
||||
If Sender.DefaultButton = ADB.Open Then
|
||||
Dim f As SFile = SFile.SelectPath(PathValue)
|
||||
Dim f As SFile = SFile.SelectPath(PathValue).IfNullOrEmpty(PathValue)
|
||||
If Not f.IsEmptyString Then CNT.Text = f
|
||||
End If
|
||||
End Sub
|
||||
|
||||
2
SCrawler/Editors/SiteSelectionForm.Designer.vb
generated
@@ -87,7 +87,7 @@ Namespace Editors
|
||||
Me.ShowIcon = False
|
||||
Me.ShowInTaskbar = False
|
||||
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
|
||||
Me.Text = "Select Site"
|
||||
Me.Text = "Sites"
|
||||
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
|
||||
CONTAINER_MAIN.ResumeLayout(False)
|
||||
CONTAINER_MAIN.PerformLayout()
|
||||
|
||||
374
SCrawler/Editors/UserCreatorForm.Designer.vb
generated
@@ -23,99 +23,147 @@ Namespace Editors
|
||||
<System.Diagnostics.DebuggerStepThrough()>
|
||||
Private Sub InitializeComponent()
|
||||
Me.components = New System.ComponentModel.Container()
|
||||
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
|
||||
Dim TP_SITE As System.Windows.Forms.TableLayoutPanel
|
||||
Dim TT_MAIN As System.Windows.Forms.ToolTip
|
||||
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
|
||||
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(UserCreatorForm))
|
||||
Dim ListColumn1 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
|
||||
Dim ListColumn2 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
|
||||
Dim TP_PARAMS As System.Windows.Forms.TableLayoutPanel
|
||||
Dim TP_OTHER As System.Windows.Forms.TableLayoutPanel
|
||||
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim TP_DOWN_OPTIONS As System.Windows.Forms.TableLayoutPanel
|
||||
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim ActionButton6 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim ActionButton8 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
|
||||
Dim TT_MAIN As System.Windows.Forms.ToolTip
|
||||
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
|
||||
Me.TXT_USER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
|
||||
Me.CH_IS_CHANNEL = New System.Windows.Forms.CheckBox()
|
||||
Me.CMB_SITE = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
|
||||
Me.BTT_OTHER_SETTINGS = New System.Windows.Forms.Button()
|
||||
Me.CH_TEMP = New System.Windows.Forms.CheckBox()
|
||||
Me.CH_FAV = New System.Windows.Forms.CheckBox()
|
||||
Me.CH_PARSE_USER_MEDIA = New System.Windows.Forms.CheckBox()
|
||||
Me.CH_READY_FOR_DOWN = New System.Windows.Forms.CheckBox()
|
||||
Me.BTT_OTHER_SETTINGS = New System.Windows.Forms.Button()
|
||||
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
|
||||
Me.TXT_USER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
|
||||
Me.TP_SITE = New System.Windows.Forms.TableLayoutPanel()
|
||||
Me.CH_IS_CHANNEL = New System.Windows.Forms.CheckBox()
|
||||
Me.CMB_SITE = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
|
||||
Me.TP_TEMP_FAV = New System.Windows.Forms.TableLayoutPanel()
|
||||
Me.CH_TEMP = New System.Windows.Forms.CheckBox()
|
||||
Me.CH_FAV = New System.Windows.Forms.CheckBox()
|
||||
Me.TP_READY_USERMEDIA = New System.Windows.Forms.TableLayoutPanel()
|
||||
Me.TXT_DESCR = New PersonalUtilities.Forms.Controls.TextBoxExtended()
|
||||
Me.TXT_USER_FRIENDLY = New PersonalUtilities.Forms.Controls.TextBoxExtended()
|
||||
Me.TP_ADD_BY_LIST = New System.Windows.Forms.TableLayoutPanel()
|
||||
Me.CH_ADD_BY_LIST = New System.Windows.Forms.CheckBox()
|
||||
Me.CH_AUTO_DETECT_SITE = New System.Windows.Forms.CheckBox()
|
||||
Me.TXT_LABELS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
|
||||
Me.TP_DOWN_IMG_VID = New System.Windows.Forms.TableLayoutPanel()
|
||||
Me.CH_DOWN_IMAGES = New System.Windows.Forms.CheckBox()
|
||||
Me.CH_DOWN_VIDEOS = New System.Windows.Forms.CheckBox()
|
||||
Me.TXT_SPEC_FOLDER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
|
||||
Me.TXT_SCRIPT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
|
||||
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
|
||||
TP_SITE = New System.Windows.Forms.TableLayoutPanel()
|
||||
TP_PARAMS = New System.Windows.Forms.TableLayoutPanel()
|
||||
TP_OTHER = New System.Windows.Forms.TableLayoutPanel()
|
||||
TP_DOWN_OPTIONS = New System.Windows.Forms.TableLayoutPanel()
|
||||
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
|
||||
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
|
||||
TP_MAIN.SuspendLayout()
|
||||
CONTAINER_MAIN.ContentPanel.SuspendLayout()
|
||||
CONTAINER_MAIN.SuspendLayout()
|
||||
Me.TP_MAIN.SuspendLayout()
|
||||
CType(Me.TXT_USER, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
TP_SITE.SuspendLayout()
|
||||
Me.TP_SITE.SuspendLayout()
|
||||
CType(Me.CMB_SITE, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
TP_PARAMS.SuspendLayout()
|
||||
TP_OTHER.SuspendLayout()
|
||||
Me.TP_TEMP_FAV.SuspendLayout()
|
||||
Me.TP_READY_USERMEDIA.SuspendLayout()
|
||||
CType(Me.TXT_DESCR, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
CType(Me.TXT_USER_FRIENDLY, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
Me.TP_ADD_BY_LIST.SuspendLayout()
|
||||
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
TP_DOWN_OPTIONS.SuspendLayout()
|
||||
Me.TP_DOWN_IMG_VID.SuspendLayout()
|
||||
CType(Me.TXT_SPEC_FOLDER, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
CType(Me.TXT_SCRIPT, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
CONTAINER_MAIN.ContentPanel.SuspendLayout()
|
||||
CONTAINER_MAIN.SuspendLayout()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'CH_PARSE_USER_MEDIA
|
||||
'
|
||||
Me.CH_PARSE_USER_MEDIA.AutoSize = True
|
||||
Me.CH_PARSE_USER_MEDIA.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_PARSE_USER_MEDIA.Location = New System.Drawing.Point(229, 4)
|
||||
Me.CH_PARSE_USER_MEDIA.Name = "CH_PARSE_USER_MEDIA"
|
||||
Me.CH_PARSE_USER_MEDIA.Size = New System.Drawing.Size(219, 20)
|
||||
Me.CH_PARSE_USER_MEDIA.TabIndex = 0
|
||||
Me.CH_PARSE_USER_MEDIA.Text = "Get user media only"
|
||||
TT_MAIN.SetToolTip(Me.CH_PARSE_USER_MEDIA, "For twitter only!" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "If checked then user media only will be downloaded." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Otherwise" &
|
||||
" all media (include comments and retwits) will be downloaded.")
|
||||
Me.CH_PARSE_USER_MEDIA.UseVisualStyleBackColor = True
|
||||
'
|
||||
'CH_READY_FOR_DOWN
|
||||
'
|
||||
Me.CH_READY_FOR_DOWN.AutoSize = True
|
||||
Me.CH_READY_FOR_DOWN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_READY_FOR_DOWN.Location = New System.Drawing.Point(4, 4)
|
||||
Me.CH_READY_FOR_DOWN.Name = "CH_READY_FOR_DOWN"
|
||||
Me.CH_READY_FOR_DOWN.Size = New System.Drawing.Size(218, 20)
|
||||
Me.CH_READY_FOR_DOWN.TabIndex = 1
|
||||
Me.CH_READY_FOR_DOWN.Text = "Ready for download"
|
||||
TT_MAIN.SetToolTip(Me.CH_READY_FOR_DOWN, "Can be downloaded by [Download All]")
|
||||
Me.CH_READY_FOR_DOWN.UseVisualStyleBackColor = True
|
||||
'
|
||||
'BTT_OTHER_SETTINGS
|
||||
'
|
||||
Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(330, 2)
|
||||
Me.BTT_OTHER_SETTINGS.Margin = New System.Windows.Forms.Padding(1)
|
||||
Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS"
|
||||
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(120, 24)
|
||||
Me.BTT_OTHER_SETTINGS.TabIndex = 2
|
||||
Me.BTT_OTHER_SETTINGS.Text = "Options (F2)"
|
||||
TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings")
|
||||
Me.BTT_OTHER_SETTINGS.UseVisualStyleBackColor = True
|
||||
'
|
||||
'CONTAINER_MAIN
|
||||
'
|
||||
'
|
||||
'CONTAINER_MAIN.ContentPanel
|
||||
'
|
||||
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TP_MAIN)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(454, 436)
|
||||
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
CONTAINER_MAIN.LeftToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
|
||||
CONTAINER_MAIN.RightToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(454, 461)
|
||||
CONTAINER_MAIN.TabIndex = 0
|
||||
CONTAINER_MAIN.TopToolStripPanelVisible = False
|
||||
'
|
||||
'TP_MAIN
|
||||
'
|
||||
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
TP_MAIN.ColumnCount = 1
|
||||
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_MAIN.Controls.Add(Me.TXT_USER, 0, 0)
|
||||
TP_MAIN.Controls.Add(TP_SITE, 0, 3)
|
||||
TP_MAIN.Controls.Add(TP_PARAMS, 0, 4)
|
||||
TP_MAIN.Controls.Add(TP_OTHER, 0, 6)
|
||||
TP_MAIN.Controls.Add(Me.TXT_DESCR, 0, 10)
|
||||
TP_MAIN.Controls.Add(Me.TXT_USER_FRIENDLY, 0, 1)
|
||||
TP_MAIN.Controls.Add(Me.TP_ADD_BY_LIST, 0, 7)
|
||||
TP_MAIN.Controls.Add(Me.TXT_LABELS, 0, 8)
|
||||
TP_MAIN.Controls.Add(TP_DOWN_OPTIONS, 0, 5)
|
||||
TP_MAIN.Controls.Add(Me.TXT_SPEC_FOLDER, 0, 2)
|
||||
TP_MAIN.Controls.Add(Me.TXT_SCRIPT, 0, 9)
|
||||
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
TP_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
TP_MAIN.Name = "TP_MAIN"
|
||||
TP_MAIN.RowCount = 11
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 26.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 26.0!))
|
||||
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_MAIN.Size = New System.Drawing.Size(454, 461)
|
||||
TP_MAIN.TabIndex = 0
|
||||
Me.TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
Me.TP_MAIN.ColumnCount = 1
|
||||
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.TP_MAIN.Controls.Add(Me.TXT_USER, 0, 0)
|
||||
Me.TP_MAIN.Controls.Add(Me.TP_SITE, 0, 3)
|
||||
Me.TP_MAIN.Controls.Add(Me.TP_TEMP_FAV, 0, 4)
|
||||
Me.TP_MAIN.Controls.Add(Me.TP_READY_USERMEDIA, 0, 6)
|
||||
Me.TP_MAIN.Controls.Add(Me.TXT_DESCR, 0, 10)
|
||||
Me.TP_MAIN.Controls.Add(Me.TXT_USER_FRIENDLY, 0, 1)
|
||||
Me.TP_MAIN.Controls.Add(Me.TP_ADD_BY_LIST, 0, 7)
|
||||
Me.TP_MAIN.Controls.Add(Me.TXT_LABELS, 0, 8)
|
||||
Me.TP_MAIN.Controls.Add(Me.TP_DOWN_IMG_VID, 0, 5)
|
||||
Me.TP_MAIN.Controls.Add(Me.TXT_SPEC_FOLDER, 0, 2)
|
||||
Me.TP_MAIN.Controls.Add(Me.TXT_SCRIPT, 0, 9)
|
||||
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
Me.TP_MAIN.Name = "TP_MAIN"
|
||||
Me.TP_MAIN.RowCount = 11
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 26.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 26.0!))
|
||||
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.TP_MAIN.Size = New System.Drawing.Size(454, 436)
|
||||
Me.TP_MAIN.TabIndex = 0
|
||||
'
|
||||
'TXT_USER
|
||||
'
|
||||
@@ -130,22 +178,22 @@ Namespace Editors
|
||||
'
|
||||
'TP_SITE
|
||||
'
|
||||
TP_SITE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
TP_SITE.ColumnCount = 3
|
||||
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 79.0!))
|
||||
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 104.0!))
|
||||
TP_SITE.Controls.Add(Me.CH_IS_CHANNEL, 0, 0)
|
||||
TP_SITE.Controls.Add(Me.CMB_SITE, 1, 0)
|
||||
TP_SITE.Controls.Add(Me.BTT_OTHER_SETTINGS, 2, 0)
|
||||
TP_SITE.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
TP_SITE.Location = New System.Drawing.Point(1, 88)
|
||||
TP_SITE.Margin = New System.Windows.Forms.Padding(0)
|
||||
TP_SITE.Name = "TP_SITE"
|
||||
TP_SITE.RowCount = 1
|
||||
TP_SITE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_SITE.Size = New System.Drawing.Size(452, 28)
|
||||
TP_SITE.TabIndex = 3
|
||||
Me.TP_SITE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
Me.TP_SITE.ColumnCount = 3
|
||||
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 79.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.Absolute, 122.0!))
|
||||
Me.TP_SITE.Controls.Add(Me.CH_IS_CHANNEL, 0, 0)
|
||||
Me.TP_SITE.Controls.Add(Me.CMB_SITE, 1, 0)
|
||||
Me.TP_SITE.Controls.Add(Me.BTT_OTHER_SETTINGS, 2, 0)
|
||||
Me.TP_SITE.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TP_SITE.Location = New System.Drawing.Point(1, 88)
|
||||
Me.TP_SITE.Margin = New System.Windows.Forms.Padding(0)
|
||||
Me.TP_SITE.Name = "TP_SITE"
|
||||
Me.TP_SITE.RowCount = 1
|
||||
Me.TP_SITE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.TP_SITE.Size = New System.Drawing.Size(452, 28)
|
||||
Me.TP_SITE.TabIndex = 3
|
||||
'
|
||||
'CH_IS_CHANNEL
|
||||
'
|
||||
@@ -177,39 +225,27 @@ Namespace Editors
|
||||
Me.CMB_SITE.Location = New System.Drawing.Point(84, 3)
|
||||
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3)
|
||||
Me.CMB_SITE.Name = "CMB_SITE"
|
||||
Me.CMB_SITE.Size = New System.Drawing.Size(259, 22)
|
||||
Me.CMB_SITE.Size = New System.Drawing.Size(241, 22)
|
||||
Me.CMB_SITE.TabIndex = 1
|
||||
Me.CMB_SITE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
|
||||
'
|
||||
'BTT_OTHER_SETTINGS
|
||||
'TP_TEMP_FAV
|
||||
'
|
||||
Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(348, 2)
|
||||
Me.BTT_OTHER_SETTINGS.Margin = New System.Windows.Forms.Padding(1)
|
||||
Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS"
|
||||
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(102, 24)
|
||||
Me.BTT_OTHER_SETTINGS.TabIndex = 2
|
||||
Me.BTT_OTHER_SETTINGS.Text = "Options (F2)"
|
||||
TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings")
|
||||
Me.BTT_OTHER_SETTINGS.UseVisualStyleBackColor = True
|
||||
'
|
||||
'TP_PARAMS
|
||||
'
|
||||
TP_PARAMS.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
TP_PARAMS.ColumnCount = 2
|
||||
TP_PARAMS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
TP_PARAMS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
TP_PARAMS.Controls.Add(Me.CH_TEMP, 0, 0)
|
||||
TP_PARAMS.Controls.Add(Me.CH_FAV, 1, 0)
|
||||
TP_PARAMS.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
TP_PARAMS.Location = New System.Drawing.Point(1, 117)
|
||||
TP_PARAMS.Margin = New System.Windows.Forms.Padding(0)
|
||||
TP_PARAMS.Name = "TP_PARAMS"
|
||||
TP_PARAMS.RowCount = 1
|
||||
TP_PARAMS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_PARAMS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 27.0!))
|
||||
TP_PARAMS.Size = New System.Drawing.Size(452, 28)
|
||||
TP_PARAMS.TabIndex = 4
|
||||
Me.TP_TEMP_FAV.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
Me.TP_TEMP_FAV.ColumnCount = 2
|
||||
Me.TP_TEMP_FAV.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
Me.TP_TEMP_FAV.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
Me.TP_TEMP_FAV.Controls.Add(Me.CH_TEMP, 0, 0)
|
||||
Me.TP_TEMP_FAV.Controls.Add(Me.CH_FAV, 1, 0)
|
||||
Me.TP_TEMP_FAV.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TP_TEMP_FAV.Location = New System.Drawing.Point(1, 117)
|
||||
Me.TP_TEMP_FAV.Margin = New System.Windows.Forms.Padding(0)
|
||||
Me.TP_TEMP_FAV.Name = "TP_TEMP_FAV"
|
||||
Me.TP_TEMP_FAV.RowCount = 1
|
||||
Me.TP_TEMP_FAV.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.TP_TEMP_FAV.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 27.0!))
|
||||
Me.TP_TEMP_FAV.Size = New System.Drawing.Size(452, 28)
|
||||
Me.TP_TEMP_FAV.TabIndex = 4
|
||||
'
|
||||
'CH_TEMP
|
||||
'
|
||||
@@ -233,48 +269,23 @@ Namespace Editors
|
||||
Me.CH_FAV.Text = "Favorite"
|
||||
Me.CH_FAV.UseVisualStyleBackColor = True
|
||||
'
|
||||
'TP_OTHER
|
||||
'TP_READY_USERMEDIA
|
||||
'
|
||||
TP_OTHER.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
TP_OTHER.ColumnCount = 2
|
||||
TP_OTHER.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
TP_OTHER.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
TP_OTHER.Controls.Add(Me.CH_PARSE_USER_MEDIA, 1, 0)
|
||||
TP_OTHER.Controls.Add(Me.CH_READY_FOR_DOWN, 0, 0)
|
||||
TP_OTHER.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
TP_OTHER.Location = New System.Drawing.Point(1, 175)
|
||||
TP_OTHER.Margin = New System.Windows.Forms.Padding(0)
|
||||
TP_OTHER.Name = "TP_OTHER"
|
||||
TP_OTHER.RowCount = 1
|
||||
TP_OTHER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_OTHER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 27.0!))
|
||||
TP_OTHER.Size = New System.Drawing.Size(452, 28)
|
||||
TP_OTHER.TabIndex = 6
|
||||
'
|
||||
'CH_PARSE_USER_MEDIA
|
||||
'
|
||||
Me.CH_PARSE_USER_MEDIA.AutoSize = True
|
||||
Me.CH_PARSE_USER_MEDIA.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_PARSE_USER_MEDIA.Location = New System.Drawing.Point(229, 4)
|
||||
Me.CH_PARSE_USER_MEDIA.Name = "CH_PARSE_USER_MEDIA"
|
||||
Me.CH_PARSE_USER_MEDIA.Size = New System.Drawing.Size(219, 20)
|
||||
Me.CH_PARSE_USER_MEDIA.TabIndex = 0
|
||||
Me.CH_PARSE_USER_MEDIA.Text = "Get user media only"
|
||||
TT_MAIN.SetToolTip(Me.CH_PARSE_USER_MEDIA, "For twitter only!" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "If checked then user media only will be downloaded." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Otherwise" &
|
||||
" all media (include comments and retwits) will be downloaded.")
|
||||
Me.CH_PARSE_USER_MEDIA.UseVisualStyleBackColor = True
|
||||
'
|
||||
'CH_READY_FOR_DOWN
|
||||
'
|
||||
Me.CH_READY_FOR_DOWN.AutoSize = True
|
||||
Me.CH_READY_FOR_DOWN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.CH_READY_FOR_DOWN.Location = New System.Drawing.Point(4, 4)
|
||||
Me.CH_READY_FOR_DOWN.Name = "CH_READY_FOR_DOWN"
|
||||
Me.CH_READY_FOR_DOWN.Size = New System.Drawing.Size(218, 20)
|
||||
Me.CH_READY_FOR_DOWN.TabIndex = 1
|
||||
Me.CH_READY_FOR_DOWN.Text = "Ready for download"
|
||||
TT_MAIN.SetToolTip(Me.CH_READY_FOR_DOWN, "Can be downloaded by [Download All]")
|
||||
Me.CH_READY_FOR_DOWN.UseVisualStyleBackColor = True
|
||||
Me.TP_READY_USERMEDIA.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
Me.TP_READY_USERMEDIA.ColumnCount = 2
|
||||
Me.TP_READY_USERMEDIA.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
Me.TP_READY_USERMEDIA.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
Me.TP_READY_USERMEDIA.Controls.Add(Me.CH_PARSE_USER_MEDIA, 1, 0)
|
||||
Me.TP_READY_USERMEDIA.Controls.Add(Me.CH_READY_FOR_DOWN, 0, 0)
|
||||
Me.TP_READY_USERMEDIA.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TP_READY_USERMEDIA.Location = New System.Drawing.Point(1, 175)
|
||||
Me.TP_READY_USERMEDIA.Margin = New System.Windows.Forms.Padding(0)
|
||||
Me.TP_READY_USERMEDIA.Name = "TP_READY_USERMEDIA"
|
||||
Me.TP_READY_USERMEDIA.RowCount = 1
|
||||
Me.TP_READY_USERMEDIA.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.TP_READY_USERMEDIA.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 27.0!))
|
||||
Me.TP_READY_USERMEDIA.Size = New System.Drawing.Size(452, 28)
|
||||
Me.TP_READY_USERMEDIA.TabIndex = 6
|
||||
'
|
||||
'TXT_DESCR
|
||||
'
|
||||
@@ -291,7 +302,7 @@ Namespace Editors
|
||||
Me.TXT_DESCR.Location = New System.Drawing.Point(4, 290)
|
||||
Me.TXT_DESCR.Multiline = True
|
||||
Me.TXT_DESCR.Name = "TXT_DESCR"
|
||||
Me.TXT_DESCR.Size = New System.Drawing.Size(446, 167)
|
||||
Me.TXT_DESCR.Size = New System.Drawing.Size(446, 142)
|
||||
Me.TXT_DESCR.TabIndex = 10
|
||||
'
|
||||
'TXT_USER_FRIENDLY
|
||||
@@ -361,23 +372,23 @@ Namespace Editors
|
||||
Me.TXT_LABELS.TabIndex = 8
|
||||
Me.TXT_LABELS.TextBoxReadOnly = True
|
||||
'
|
||||
'TP_DOWN_OPTIONS
|
||||
'TP_DOWN_IMG_VID
|
||||
'
|
||||
TP_DOWN_OPTIONS.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
TP_DOWN_OPTIONS.ColumnCount = 2
|
||||
TP_DOWN_OPTIONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
TP_DOWN_OPTIONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
TP_DOWN_OPTIONS.Controls.Add(Me.CH_DOWN_IMAGES, 0, 0)
|
||||
TP_DOWN_OPTIONS.Controls.Add(Me.CH_DOWN_VIDEOS, 1, 0)
|
||||
TP_DOWN_OPTIONS.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
TP_DOWN_OPTIONS.Location = New System.Drawing.Point(1, 146)
|
||||
TP_DOWN_OPTIONS.Margin = New System.Windows.Forms.Padding(0)
|
||||
TP_DOWN_OPTIONS.Name = "TP_DOWN_OPTIONS"
|
||||
TP_DOWN_OPTIONS.RowCount = 1
|
||||
TP_DOWN_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
TP_DOWN_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 27.0!))
|
||||
TP_DOWN_OPTIONS.Size = New System.Drawing.Size(452, 28)
|
||||
TP_DOWN_OPTIONS.TabIndex = 5
|
||||
Me.TP_DOWN_IMG_VID.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
|
||||
Me.TP_DOWN_IMG_VID.ColumnCount = 2
|
||||
Me.TP_DOWN_IMG_VID.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
Me.TP_DOWN_IMG_VID.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
|
||||
Me.TP_DOWN_IMG_VID.Controls.Add(Me.CH_DOWN_IMAGES, 0, 0)
|
||||
Me.TP_DOWN_IMG_VID.Controls.Add(Me.CH_DOWN_VIDEOS, 1, 0)
|
||||
Me.TP_DOWN_IMG_VID.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TP_DOWN_IMG_VID.Location = New System.Drawing.Point(1, 146)
|
||||
Me.TP_DOWN_IMG_VID.Margin = New System.Windows.Forms.Padding(0)
|
||||
Me.TP_DOWN_IMG_VID.Name = "TP_DOWN_IMG_VID"
|
||||
Me.TP_DOWN_IMG_VID.RowCount = 1
|
||||
Me.TP_DOWN_IMG_VID.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
|
||||
Me.TP_DOWN_IMG_VID.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 27.0!))
|
||||
Me.TP_DOWN_IMG_VID.Size = New System.Drawing.Size(452, 28)
|
||||
Me.TP_DOWN_IMG_VID.TabIndex = 5
|
||||
'
|
||||
'CH_DOWN_IMAGES
|
||||
'
|
||||
@@ -442,22 +453,6 @@ Namespace Editors
|
||||
Me.TXT_SCRIPT.Size = New System.Drawing.Size(446, 22)
|
||||
Me.TXT_SCRIPT.TabIndex = 9
|
||||
'
|
||||
'CONTAINER_MAIN
|
||||
'
|
||||
'
|
||||
'CONTAINER_MAIN.ContentPanel
|
||||
'
|
||||
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
|
||||
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(454, 461)
|
||||
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
CONTAINER_MAIN.LeftToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
|
||||
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
|
||||
CONTAINER_MAIN.RightToolStripPanelVisible = False
|
||||
CONTAINER_MAIN.Size = New System.Drawing.Size(454, 461)
|
||||
CONTAINER_MAIN.TabIndex = 0
|
||||
CONTAINER_MAIN.TopToolStripPanelVisible = False
|
||||
'
|
||||
'UserCreatorForm
|
||||
'
|
||||
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
|
||||
@@ -475,27 +470,27 @@ Namespace Editors
|
||||
Me.ShowInTaskbar = False
|
||||
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
|
||||
Me.Text = "Create User"
|
||||
TP_MAIN.ResumeLayout(False)
|
||||
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
|
||||
CONTAINER_MAIN.ResumeLayout(False)
|
||||
CONTAINER_MAIN.PerformLayout()
|
||||
Me.TP_MAIN.ResumeLayout(False)
|
||||
CType(Me.TXT_USER, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
TP_SITE.ResumeLayout(False)
|
||||
TP_SITE.PerformLayout()
|
||||
Me.TP_SITE.ResumeLayout(False)
|
||||
Me.TP_SITE.PerformLayout()
|
||||
CType(Me.CMB_SITE, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
TP_PARAMS.ResumeLayout(False)
|
||||
TP_PARAMS.PerformLayout()
|
||||
TP_OTHER.ResumeLayout(False)
|
||||
TP_OTHER.PerformLayout()
|
||||
Me.TP_TEMP_FAV.ResumeLayout(False)
|
||||
Me.TP_TEMP_FAV.PerformLayout()
|
||||
Me.TP_READY_USERMEDIA.ResumeLayout(False)
|
||||
Me.TP_READY_USERMEDIA.PerformLayout()
|
||||
CType(Me.TXT_DESCR, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
CType(Me.TXT_USER_FRIENDLY, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
Me.TP_ADD_BY_LIST.ResumeLayout(False)
|
||||
Me.TP_ADD_BY_LIST.PerformLayout()
|
||||
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
TP_DOWN_OPTIONS.ResumeLayout(False)
|
||||
TP_DOWN_OPTIONS.PerformLayout()
|
||||
Me.TP_DOWN_IMG_VID.ResumeLayout(False)
|
||||
Me.TP_DOWN_IMG_VID.PerformLayout()
|
||||
CType(Me.TXT_SPEC_FOLDER, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
CType(Me.TXT_SCRIPT, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
|
||||
CONTAINER_MAIN.ResumeLayout(False)
|
||||
CONTAINER_MAIN.PerformLayout()
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
@@ -517,5 +512,10 @@ Namespace Editors
|
||||
Private WithEvents CMB_SITE As PersonalUtilities.Forms.Controls.ComboBoxExtended
|
||||
Private WithEvents BTT_OTHER_SETTINGS As Button
|
||||
Private WithEvents TXT_SCRIPT As PersonalUtilities.Forms.Controls.TextBoxExtended
|
||||
Private WithEvents TP_SITE As TableLayoutPanel
|
||||
Private WithEvents TP_MAIN As TableLayoutPanel
|
||||
Private WithEvents TP_TEMP_FAV As TableLayoutPanel
|
||||
Private WithEvents TP_READY_USERMEDIA As TableLayoutPanel
|
||||
Private WithEvents TP_DOWN_IMG_VID As TableLayoutPanel
|
||||
End Class
|
||||
End Namespace
|
||||
@@ -117,10 +117,13 @@
|
||||
<resheader name="writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
<metadata name="TP_SITE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>17, 17</value>
|
||||
</metadata>
|
||||
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
|
||||
@@ -214,18 +217,6 @@
|
||||
AAAASUVORK5CYII=
|
||||
</value>
|
||||
</data>
|
||||
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>17, 17</value>
|
||||
</metadata>
|
||||
<metadata name="TP_PARAMS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
<metadata name="TP_OTHER.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
<value>
|
||||
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
|
||||
@@ -253,9 +244,6 @@
|
||||
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
|
||||
</value>
|
||||
</data>
|
||||
<metadata name="TP_DOWN_OPTIONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
<value>
|
||||
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
|
||||
@@ -294,7 +282,4 @@
|
||||
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
|
||||
</value>
|
||||
</data>
|
||||
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</metadata>
|
||||
</root>
|
||||
@@ -10,6 +10,8 @@ Imports PersonalUtilities.Forms
|
||||
Imports PersonalUtilities.Forms.Controls
|
||||
Imports PersonalUtilities.Forms.Controls.Base
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports SCrawler.API
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.Plugin
|
||||
Imports SCrawler.Plugin.Hosts
|
||||
@@ -19,7 +21,10 @@ Namespace Editors
|
||||
Private WithEvents MyDef As DefaultFormOptions
|
||||
Friend Property User As UserInfo
|
||||
Private Property UserInstance As IUserData
|
||||
Private ReadOnly UserIsCollection As Boolean = False
|
||||
#Region "User options"
|
||||
''' <summary>COLLECTION EDITING ONLY</summary>
|
||||
Friend Property CollectionName As String = String.Empty
|
||||
Friend Property StartIndex As Integer = -1
|
||||
Friend ReadOnly Property UserTemporary As Boolean
|
||||
Get
|
||||
@@ -107,10 +112,36 @@ Namespace Editors
|
||||
If Not _Instance Is Nothing Then
|
||||
UserInstance = _Instance
|
||||
User = DirectCast(UserInstance, UserDataBase).User
|
||||
UserIsCollection = TypeOf UserInstance Is UserDataBind
|
||||
If UserIsCollection Then
|
||||
With DirectCast(UserInstance, UserDataBind) : .CurrentlyEdited = True : CollectionName = .CollectionName : End With
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Form handlers"
|
||||
Private Class CollectionNameFieldProvider : Implements IFieldsCheckerProvider
|
||||
Private Property ErrorMessage As String Implements IFieldsCheckerProvider.ErrorMessage
|
||||
Private Property Name As String Implements IFieldsCheckerProvider.Name
|
||||
Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError
|
||||
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
|
||||
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
|
||||
If ACheck(Value) Then
|
||||
If Settings.Users.Exists(Function(u) u.IsCollection AndAlso u.CollectionName = CStr(Value) AndAlso
|
||||
Not DirectCast(u, UserDataBind).CurrentlyEdited) Then
|
||||
ErrorMessage = $"A collection named [{Value}] already exist"
|
||||
Return Nothing
|
||||
Else
|
||||
Return Value
|
||||
End If
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
End Function
|
||||
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
|
||||
Throw New NotImplementedException("[GetFormat] is not available in the 'CollectionNameFieldProvider'")
|
||||
End Function
|
||||
End Class
|
||||
Private Sub UserCreatorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
|
||||
Try
|
||||
With MyDef
|
||||
@@ -122,52 +153,123 @@ Namespace Editors
|
||||
.Items.AddRange(Settings.Plugins.Select(Function(p) New ListItem({p.Key, p.Name})))
|
||||
.EndUpdate(True)
|
||||
End With
|
||||
If User.Name.IsEmptyString Then
|
||||
CH_READY_FOR_DOWN.Checked = True
|
||||
CH_TEMP.Checked = Settings.DefaultTemporary
|
||||
CH_DOWN_IMAGES.Checked = Settings.DefaultDownloadImages
|
||||
CH_DOWN_VIDEOS.Checked = Settings.DefaultDownloadVideos
|
||||
TXT_SCRIPT.Checked = Settings.ScriptData.Attribute
|
||||
SetParamsBySite()
|
||||
Else
|
||||
TP_ADD_BY_LIST.Enabled = False
|
||||
TXT_USER.Text = User.Name
|
||||
TXT_SPEC_FOLDER.Text = User.SpecialPath
|
||||
Dim i% = Settings.Plugins.FindIndex(Function(p) p.Key = User.Plugin)
|
||||
If i >= 0 Then CMB_SITE.SelectedIndex = i
|
||||
SetParamsBySite()
|
||||
CH_IS_CHANNEL.Enabled = False
|
||||
CMB_SITE.Enabled = False
|
||||
CH_IS_CHANNEL.Checked = User.IsChannel
|
||||
If Not UserInstance Is Nothing Then
|
||||
TXT_USER.Enabled = False
|
||||
TXT_SPEC_FOLDER.TextBoxReadOnly = True
|
||||
TXT_SPEC_FOLDER.Buttons.Clear()
|
||||
TXT_SPEC_FOLDER.Buttons.UpdateButtonsPositions()
|
||||
With UserInstance
|
||||
TXT_USER_FRIENDLY.Text = .FriendlyName
|
||||
CH_FAV.Checked = .Favorite
|
||||
CH_TEMP.Checked = .Temporary
|
||||
CH_PARSE_USER_MEDIA.Checked = .ParseUserMediaOnly
|
||||
CH_READY_FOR_DOWN.Checked = .ReadyForDownload
|
||||
CH_DOWN_IMAGES.Checked = .DownloadImages
|
||||
CH_DOWN_VIDEOS.Checked = .DownloadVideos
|
||||
TXT_SCRIPT.Checked = .ScriptUse
|
||||
TXT_SCRIPT.Text = .ScriptData
|
||||
TXT_DESCR.Text = .Description.StringFormatLines
|
||||
UserLabels.ListAddList(.Labels)
|
||||
If UserLabels.ListExists Then TXT_LABELS.Text = UserLabels.ListToString
|
||||
|
||||
Dim NameFieldProvider As IFormatProvider = Nothing
|
||||
|
||||
If UserIsCollection Then
|
||||
Icon = If(ImageRenderer.GetIcon(My.Resources.DBPic_32, EDP.ReturnValue), Icon)
|
||||
Text = $"Collection: {UserInstance.CollectionName}"
|
||||
|
||||
TXT_USER.CaptionText = "Collection name"
|
||||
TXT_USER.Text = UserInstance.CollectionName
|
||||
TXT_USER.Buttons.AddRange({ADB.Refresh, ADB.Clear})
|
||||
TXT_USER.Buttons.UpdateButtonsPositions()
|
||||
TXT_SPEC_FOLDER.Buttons.Clear()
|
||||
TXT_SPEC_FOLDER.TextBoxReadOnly = True
|
||||
TXT_SPEC_FOLDER.Buttons.UpdateButtonsPositions()
|
||||
|
||||
With TP_MAIN
|
||||
.Controls.Clear()
|
||||
.RowStyles.Clear()
|
||||
.RowCount = 0
|
||||
With .RowStyles
|
||||
.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
.Add(New RowStyle(SizeType.Absolute, 28))
|
||||
.Add(New RowStyle(SizeType.Absolute, 26))
|
||||
.Add(New RowStyle(SizeType.Percent, 100))
|
||||
End With
|
||||
CH_ADD_BY_LIST.Enabled = False
|
||||
Else
|
||||
.RowCount = .RowStyles.Count
|
||||
With .Controls
|
||||
.Add(TXT_USER, 0, 0)
|
||||
.Add(TXT_SPEC_FOLDER, 0, 1)
|
||||
.Add(TP_TEMP_FAV, 0, 2)
|
||||
.Add(TP_DOWN_IMG_VID, 0, 3)
|
||||
.Add(TP_READY_USERMEDIA, 0, 4)
|
||||
.Add(TXT_LABELS, 0, 5)
|
||||
.Add(TXT_DESCR, 0, 6)
|
||||
End With
|
||||
.Refresh()
|
||||
.Update()
|
||||
End With
|
||||
|
||||
TXT_DESCR.TextBoxReadOnly = True
|
||||
TXT_DESCR.Buttons.Clear()
|
||||
TXT_DESCR.Buttons.UpdateButtonsPositions()
|
||||
|
||||
CH_TEMP.ThreeState = True
|
||||
CH_FAV.ThreeState = True
|
||||
CH_DOWN_IMAGES.ThreeState = True
|
||||
CH_DOWN_VIDEOS.ThreeState = True
|
||||
CH_READY_FOR_DOWN.ThreeState = True
|
||||
CH_PARSE_USER_MEDIA.ThreeState = True
|
||||
|
||||
With DirectCast(UserInstance, UserDataBind)
|
||||
Dim state As Func(Of Boolean, Func(Of IUserData, Boolean, Boolean), CheckState) =
|
||||
Function(v, p) If(.All(Function(pp) p.Invoke(pp, v)), If(v, CheckState.Checked, CheckState.Unchecked), CheckState.Indeterminate)
|
||||
TXT_SPEC_FOLDER.Text = DirectCast(.Item(0), UserDataBase).User.SpecialCollectionPath.ToString
|
||||
CH_TEMP.CheckState = state(.Item(0).Temporary, Function(p, v) p.Temporary = v)
|
||||
CH_FAV.CheckState = state(.Item(0).Favorite, Function(p, v) p.Favorite = v)
|
||||
CH_DOWN_IMAGES.CheckState = state(.Item(0).DownloadImages, Function(p, v) p.DownloadImages = v)
|
||||
CH_DOWN_VIDEOS.CheckState = state(.Item(0).DownloadVideos, Function(p, v) p.DownloadVideos = v)
|
||||
CH_READY_FOR_DOWN.CheckState = state(.Item(0).ReadyForDownload, Function(p, v) p.ReadyForDownload = v)
|
||||
CH_PARSE_USER_MEDIA.CheckState = state(.Item(0).ParseUserMediaOnly, Function(p, v) p.ParseUserMediaOnly = v)
|
||||
TXT_DESCR.Text = .GetUserInformation.StringFormatLines
|
||||
UserLabels.ListAddList(.Labels)
|
||||
If UserLabels.ListExists Then TXT_LABELS.Text = UserLabels.ListToString
|
||||
End With
|
||||
|
||||
NameFieldProvider = New CollectionNameFieldProvider
|
||||
Else
|
||||
If User.Name.IsEmptyString Then
|
||||
CH_READY_FOR_DOWN.Checked = True
|
||||
CH_TEMP.Checked = Settings.DefaultTemporary
|
||||
CH_READY_FOR_DOWN.Checked = Not Settings.DefaultTemporary
|
||||
CH_DOWN_IMAGES.Checked = Settings.DefaultDownloadImages
|
||||
CH_DOWN_VIDEOS.Checked = Settings.DefaultDownloadVideos
|
||||
TXT_SCRIPT.Checked = Settings.ScriptData.Attribute
|
||||
SetParamsBySite()
|
||||
Else
|
||||
TP_ADD_BY_LIST.Enabled = False
|
||||
TXT_USER.Text = User.Name
|
||||
TXT_SPEC_FOLDER.Text = User.SpecialPath
|
||||
Dim i% = Settings.Plugins.FindIndex(Function(p) p.Key = User.Plugin)
|
||||
If i >= 0 Then CMB_SITE.SelectedIndex = i
|
||||
SetParamsBySite()
|
||||
CH_IS_CHANNEL.Enabled = False
|
||||
CMB_SITE.Enabled = False
|
||||
CH_IS_CHANNEL.Checked = User.IsChannel
|
||||
If Not UserInstance Is Nothing Then
|
||||
TXT_USER.Enabled = False
|
||||
TXT_SPEC_FOLDER.TextBoxReadOnly = True
|
||||
TXT_SPEC_FOLDER.Buttons.Clear()
|
||||
TXT_SPEC_FOLDER.Buttons.UpdateButtonsPositions()
|
||||
With UserInstance
|
||||
TXT_USER_FRIENDLY.Text = .FriendlyName
|
||||
CH_FAV.Checked = .Favorite
|
||||
CH_TEMP.Checked = .Temporary
|
||||
CH_PARSE_USER_MEDIA.Checked = .ParseUserMediaOnly
|
||||
CH_READY_FOR_DOWN.Checked = .ReadyForDownload
|
||||
CH_DOWN_IMAGES.Checked = .DownloadImages
|
||||
CH_DOWN_VIDEOS.Checked = .DownloadVideos
|
||||
TXT_SCRIPT.Checked = .ScriptUse
|
||||
TXT_SCRIPT.Text = .ScriptData
|
||||
TXT_DESCR.Text = .Description.StringFormatLines
|
||||
UserLabels.ListAddList(.Labels)
|
||||
If UserLabels.ListExists Then TXT_LABELS.Text = UserLabels.ListToString
|
||||
End With
|
||||
CH_ADD_BY_LIST.Enabled = False
|
||||
Else
|
||||
CH_TEMP.Checked = Settings.DefaultTemporary
|
||||
CH_READY_FOR_DOWN.Checked = Not Settings.DefaultTemporary
|
||||
CH_DOWN_IMAGES.Checked = Settings.DefaultDownloadImages
|
||||
CH_DOWN_VIDEOS.Checked = Settings.DefaultDownloadVideos
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
.MyFieldsChecker = New FieldsChecker
|
||||
.MyFieldsCheckerE.AddControl(Of String)(TXT_USER, TXT_USER.CaptionText)
|
||||
.MyFieldsCheckerE.AddControl(Of String)(TXT_USER, TXT_USER.CaptionText,, NameFieldProvider)
|
||||
.MyFieldsChecker.EndLoaderOperations()
|
||||
.EndLoaderOperations()
|
||||
End With
|
||||
@@ -186,64 +288,82 @@ Namespace Editors
|
||||
End Sub
|
||||
Private Sub UserCreatorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
|
||||
UserLabels.Clear()
|
||||
If UserIsCollection And Not UserInstance Is Nothing Then DirectCast(UserInstance, UserDataBind).CurrentlyEdited = False
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Ok, Cancel"
|
||||
Private Sub MyDef_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDef.ButtonOkClick
|
||||
If Not CH_ADD_BY_LIST.Checked Then
|
||||
If UserIsCollection Then
|
||||
If MyDef.MyFieldsChecker.AllParamsOK Then
|
||||
Dim s As SettingsHost = GetSiteByCheckers()
|
||||
If Not s Is Nothing Then
|
||||
Dim tmpUser As UserInfo = User.Clone
|
||||
With tmpUser
|
||||
.Name = TXT_USER.Text
|
||||
.SpecialPath = SpecialPath(s)
|
||||
.Site = s.Name
|
||||
.Plugin = s.Key
|
||||
.IsChannel = CH_IS_CHANNEL.Checked
|
||||
.UpdateUserFile()
|
||||
End With
|
||||
User = tmpUser
|
||||
Dim ScriptText$ = TXT_SCRIPT.Text
|
||||
If Not ScriptText.IsEmptyString Then
|
||||
Dim f As SFile = ScriptText
|
||||
If Not SFile.IsDirectory(ScriptText) And Not UserInstance Is Nothing Then
|
||||
With DirectCast(UserInstance, UserDataBase) : f.Path = .MyFile.Path : End With
|
||||
End If
|
||||
TXT_SCRIPT.Text = f
|
||||
End If
|
||||
If Not UserInstance Is Nothing Then
|
||||
With DirectCast(UserInstance, UserDataBase)
|
||||
.User = User
|
||||
.FriendlyName = TXT_USER_FRIENDLY.Text
|
||||
.Favorite = CH_FAV.Checked
|
||||
.Temporary = CH_TEMP.Checked
|
||||
.ReadyForDownload = CH_READY_FOR_DOWN.Checked
|
||||
.DownloadImages = CH_DOWN_IMAGES.Checked
|
||||
.DownloadVideos = CH_DOWN_VIDEOS.Checked
|
||||
.UserDescription = TXT_DESCR.Text
|
||||
If Not MyExchangeOptions Is Nothing Then .ExchangeOptionsSet(MyExchangeOptions)
|
||||
Dim l As New ListAddParams(LAP.NotContainsOnly + LAP.ClearBeforeAdd)
|
||||
If .IsCollection Then
|
||||
With DirectCast(UserInstance, API.UserDataBind)
|
||||
If .Count > 0 Then .Collections.ForEach(Sub(c) c.Labels.ListAddList(UserLabels, l))
|
||||
End With
|
||||
Else
|
||||
.Labels.ListAddList(UserLabels, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
End If
|
||||
.ParseUserMediaOnly = CH_PARSE_USER_MEDIA.Checked
|
||||
.ScriptUse = TXT_SCRIPT.Checked
|
||||
.ScriptData = TXT_SCRIPT.Text
|
||||
.UpdateUserInformation()
|
||||
End With
|
||||
End If
|
||||
GoTo CloseForm
|
||||
Else
|
||||
MsgBoxE("User site not selected", MsgBoxStyle.Exclamation)
|
||||
End If
|
||||
With UserInstance
|
||||
If Not CH_TEMP.CheckState = CheckState.Indeterminate Then .Temporary = CH_TEMP.Checked
|
||||
If Not CH_FAV.CheckState = CheckState.Indeterminate Then .Favorite = CH_FAV.Checked
|
||||
If Not CH_DOWN_IMAGES.CheckState = CheckState.Indeterminate Then .DownloadImages = CH_DOWN_IMAGES.Checked
|
||||
If Not CH_DOWN_VIDEOS.CheckState = CheckState.Indeterminate Then .DownloadVideos = CH_DOWN_VIDEOS.Checked
|
||||
If Not CH_READY_FOR_DOWN.CheckState = CheckState.Indeterminate Then .ReadyForDownload = CH_READY_FOR_DOWN.Checked
|
||||
If Not CH_PARSE_USER_MEDIA.CheckState = CheckState.Indeterminate Then .ParseUserMediaOnly = CH_PARSE_USER_MEDIA.Checked
|
||||
DirectCast(UserInstance, UserDataBind).Collections.ForEach(Sub(u) u.Labels.ListAddList(UserLabels, LAP.ClearBeforeAdd, LAP.NotContainsOnly))
|
||||
CollectionName = TXT_USER.Text
|
||||
.UpdateUserInformation()
|
||||
End With
|
||||
GoTo CloseForm
|
||||
End If
|
||||
Else
|
||||
If CreateUsersByList() Then GoTo CloseForm
|
||||
If Not CH_ADD_BY_LIST.Checked Then
|
||||
If MyDef.MyFieldsChecker.AllParamsOK Then
|
||||
Dim s As SettingsHost = GetSiteByCheckers()
|
||||
If Not s Is Nothing Then
|
||||
Dim tmpUser As UserInfo = User.Clone
|
||||
With tmpUser
|
||||
.Name = TXT_USER.Text
|
||||
.SpecialPath = SpecialPath(s)
|
||||
.Site = s.Name
|
||||
.Plugin = s.Key
|
||||
.IsChannel = CH_IS_CHANNEL.Checked
|
||||
.UpdateUserFile()
|
||||
End With
|
||||
User = tmpUser
|
||||
Dim ScriptText$ = TXT_SCRIPT.Text
|
||||
If Not ScriptText.IsEmptyString Then
|
||||
Dim f As SFile = ScriptText
|
||||
If Not SFile.IsDirectory(ScriptText) And Not UserInstance Is Nothing Then
|
||||
With DirectCast(UserInstance, UserDataBase) : f.Path = .MyFile.Path : End With
|
||||
End If
|
||||
TXT_SCRIPT.Text = f
|
||||
End If
|
||||
If Not UserInstance Is Nothing Then
|
||||
With DirectCast(UserInstance, UserDataBase)
|
||||
.User = User
|
||||
.FriendlyName = TXT_USER_FRIENDLY.Text
|
||||
.Favorite = CH_FAV.Checked
|
||||
.Temporary = CH_TEMP.Checked
|
||||
.ReadyForDownload = CH_READY_FOR_DOWN.Checked
|
||||
.DownloadImages = CH_DOWN_IMAGES.Checked
|
||||
.DownloadVideos = CH_DOWN_VIDEOS.Checked
|
||||
.UserDescription = TXT_DESCR.Text
|
||||
If Not MyExchangeOptions Is Nothing Then .ExchangeOptionsSet(MyExchangeOptions)
|
||||
Dim l As New ListAddParams(LAP.NotContainsOnly + LAP.ClearBeforeAdd)
|
||||
If .IsCollection Then
|
||||
With DirectCast(UserInstance, API.UserDataBind)
|
||||
If .Count > 0 Then .Collections.ForEach(Sub(c) c.Labels.ListAddList(UserLabels, l))
|
||||
End With
|
||||
Else
|
||||
.Labels.ListAddList(UserLabels, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
End If
|
||||
.ParseUserMediaOnly = CH_PARSE_USER_MEDIA.Checked
|
||||
.ScriptUse = TXT_SCRIPT.Checked
|
||||
.ScriptData = TXT_SCRIPT.Text
|
||||
.UpdateUserInformation()
|
||||
End With
|
||||
End If
|
||||
GoTo CloseForm
|
||||
Else
|
||||
MsgBoxE("User site not selected", MsgBoxStyle.Exclamation)
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If CreateUsersByList() Then GoTo CloseForm
|
||||
End If
|
||||
End If
|
||||
Exit Sub
|
||||
CloseForm:
|
||||
@@ -257,7 +377,7 @@ CloseForm:
|
||||
Private _TextChangeInvoked As Boolean = False
|
||||
Private Sub TXT_USER_ActionOnTextChanged(ByVal Sender As Object, ByVal e As EventArgs) Handles TXT_USER.ActionOnTextChanged
|
||||
Try
|
||||
If Not _TextChangeInvoked Then
|
||||
If Not _TextChangeInvoked And Not UserIsCollection Then
|
||||
_TextChangeInvoked = True
|
||||
If Not CH_ADD_BY_LIST.Checked Then
|
||||
Dim s As ExchangeOptions = GetSiteByText(TXT_USER.Text)
|
||||
@@ -282,7 +402,10 @@ CloseForm:
|
||||
Catch
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub CMB_SITE_ActionSelectedItemChanged(ByVal Item As ListViewItem) Handles CMB_SITE.ActionSelectedItemChanged
|
||||
Private Sub TXT_USER_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_USER.ActionOnButtonClick
|
||||
If UserIsCollection AndAlso Sender.DefaultButton = ADB.Refresh Then TXT_USER.Text = UserInstance.CollectionName
|
||||
End Sub
|
||||
Private Sub CMB_SITE_ActionSelectedItemChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles CMB_SITE.ActionSelectedItemChanged
|
||||
CH_IS_CHANNEL.Checked = False
|
||||
MyExchangeOptions = Nothing
|
||||
SetParamsBySite()
|
||||
@@ -299,7 +422,7 @@ CloseForm:
|
||||
If Sender.DefaultButton = ADB.Open Then
|
||||
Dim f As SFile = Nothing
|
||||
If Not TXT_SPEC_FOLDER.Text.IsEmptyString Then f = $"{TXT_SPEC_FOLDER.Text}\"
|
||||
f = SFile.SelectPath(f, True)
|
||||
f = SFile.SelectPath(f)
|
||||
If Not f.IsEmptyString Then TXT_SPEC_FOLDER.Text = f.PathWithSeparator
|
||||
End If
|
||||
End Sub
|
||||
@@ -382,7 +505,8 @@ CloseForm:
|
||||
End If
|
||||
|
||||
If Not s Is Nothing Then
|
||||
tmpUser = New UserInfo(uu, s,,, __sf(uu, s)) With {.IsChannel = _IsChannel}
|
||||
tmpUser = New UserInfo(uu, s) With {.SpecialPath = __sf(uu, s), .IsChannel = _IsChannel}
|
||||
tmpUser.UpdateUserFile()
|
||||
uid = -1
|
||||
If Settings.UsersList.Count > 0 Then uid = Settings.UsersList.IndexOf(tmpUser)
|
||||
If uid < 0 And Not UsersForCreate.Contains(tmpUser) Then
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
'
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web.Clients
|
||||
Namespace EncryptCookies
|
||||
Friend Module EncryptFunction
|
||||
Friend CookiesEncrypted As Boolean = False
|
||||
|
||||
2
SCrawler/MainFrame.Designer.vb
generated
@@ -910,7 +910,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
|
||||
Private WithEvents BTT_ADD_USER As ToolStripButton
|
||||
Private WithEvents BTT_DELETE_USER As ToolStripButton
|
||||
Private WithEvents BTT_DOWN_SELECTED As ToolStripKeyMenuItem
|
||||
Private WithEvents MENU_DOWN_ALL As ToolStripDropDownButton
|
||||
Private WithEvents Toolbar_BOTTOM As StatusStrip
|
||||
Private WithEvents PR_MAIN As ToolStripProgressBar
|
||||
Private WithEvents LBL_STATUS As ToolStripStatusLabel
|
||||
@@ -986,4 +985,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
|
||||
Private WithEvents BTT_SILENT_MODE As ToolStripMenuItem
|
||||
Friend WithEvents BTT_DOWN_AUTOMATION_PAUSE As ToolStripMenuItem
|
||||
Private WithEvents BTT_TRAY_FEED_SHOW As ToolStripMenuItem
|
||||
Friend WithEvents MENU_DOWN_ALL As ToolStripDropDownButton
|
||||
End Class
|
||||
@@ -7,7 +7,6 @@
|
||||
' This program is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY
|
||||
Imports System.Threading
|
||||
Imports System.Globalization
|
||||
Imports System.ComponentModel
|
||||
Imports PersonalUtilities.Forms
|
||||
Imports PersonalUtilities.Functions.Messaging
|
||||
@@ -21,9 +20,10 @@ Public Class MainFrame
|
||||
#Region "Declarations"
|
||||
Private MyView As FormView
|
||||
Private WithEvents MyActivator As FormActivator
|
||||
Private WithEvents BTT_IMPORT_USERS As ToolStripMenuItem
|
||||
Private ReadOnly _VideoDownloadingMode As Boolean = False
|
||||
Private MyChannels As ChannelViewForm
|
||||
Private MySavedPosts As DownloadSavedPostsForm
|
||||
Friend MyChannels As ChannelViewForm
|
||||
Friend MySavedPosts As DownloadSavedPostsForm
|
||||
Private MyMissingPosts As MissingPostsForm
|
||||
Private MyFeed As DownloadFeedForm
|
||||
Private MySearch As UserSearchForm
|
||||
@@ -32,10 +32,6 @@ Public Class MainFrame
|
||||
#Region "Initializer"
|
||||
Public Sub New()
|
||||
InitializeComponent()
|
||||
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
|
||||
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"
|
||||
n.TimeSeparator = String.Empty
|
||||
Twitter.DateProvider = New ADateTime(DirectCast(n.Clone, DateTimeFormatInfo)) With {.DateTimeStyle = DateTimeStyles.AssumeUniversal}
|
||||
Settings = New SettingsCLS
|
||||
With Settings.Plugins
|
||||
If .Count > 0 Then
|
||||
@@ -44,6 +40,8 @@ Public Class MainFrame
|
||||
Next
|
||||
End If
|
||||
End With
|
||||
BTT_IMPORT_USERS = New ToolStripMenuItem With {.Text = "Import", .Image = My.Resources.UsersIcon_32.ToBitmap}
|
||||
MENU_SETTINGS.DropDownItems.AddRange({New ToolStripSeparator, BTT_IMPORT_USERS})
|
||||
Dim Args() As String = Environment.GetCommandLineArgs
|
||||
If Args.ListExists(2) AndAlso Args(1) = "v" Then
|
||||
Using f As New VideosDownloaderForm With {.IsStandalone = True} : f.ShowDialog() : End Using
|
||||
@@ -52,7 +50,7 @@ Public Class MainFrame
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Form handlers"
|
||||
Private Sub MainFrame_Load(sender As Object, e As EventArgs) Handles Me.Load
|
||||
Private Async Sub MainFrame_Load(sender As Object, e As EventArgs) Handles Me.Load
|
||||
If _VideoDownloadingMode Then GoTo FormClosingInvoker
|
||||
If Now.Month.ValueBetween(6, 8) Then Text = "SCrawler: Happy LGBT Pride Month! :-)"
|
||||
Settings.DeleteCachePath()
|
||||
@@ -115,7 +113,7 @@ Public Class MainFrame
|
||||
AddHandler Settings.Groups.Deleted, AddressOf Settings.Automation.GROUPS_Deleted
|
||||
AddHandler Settings.Automation.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons
|
||||
_UFinit = False
|
||||
Settings.Automation.Start(True)
|
||||
Await Settings.Automation.Start(True)
|
||||
UpdatePauseButtonsVisibility()
|
||||
GoTo EndFunction
|
||||
FormClosingInvoker:
|
||||
@@ -278,6 +276,35 @@ CloseResume:
|
||||
End Using
|
||||
End With
|
||||
End Sub
|
||||
Private Sub BTT_IMPORT_USERS_Click(sender As Object, e As EventArgs) Handles BTT_IMPORT_USERS.Click
|
||||
Const MsgTitle$ = "Import users"
|
||||
Try
|
||||
Dim file As SFile = Nothing
|
||||
Dim _OriginalLocations As Boolean = False
|
||||
Select Case MsgBoxE({"Where do you want to import users from?" & vbCr & vbCr &
|
||||
"This feature is not for importing users from the site. It's more like searching for missing users.", MsgTitle}, vbQuestion,,,
|
||||
{"Select path", New MsgBoxButton("Current", "All plugin paths will be checked"), "Cancel"}).Index
|
||||
Case 0 : file = SFile.SelectPath
|
||||
Case 1 : _OriginalLocations = True
|
||||
Case Else : MsgBoxE({"Operation canceled", MsgTitle}) : Exit Sub
|
||||
End Select
|
||||
If Not file.IsEmptyString Or _OriginalLocations Then
|
||||
Using import As New UserFinder(file)
|
||||
With import
|
||||
.Find(_OriginalLocations)
|
||||
If .Count > 0 Then
|
||||
.Verify()
|
||||
.Dialog()
|
||||
Else
|
||||
MsgBoxE({"No users found", MsgTitle})
|
||||
End If
|
||||
End With
|
||||
End Using
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, MsgTitle)
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Add, Edit, Delete, Refresh"
|
||||
Private Sub OnUsersAddedHandler(ByVal StartIndex As Integer)
|
||||
@@ -376,13 +403,13 @@ CloseResume:
|
||||
DownloadSelectedUser(DownUserLimits.None, e.IncludeInTheFeed)
|
||||
End Sub
|
||||
Private Sub BTT_DOWN_ALL_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_ALL.KeyClick
|
||||
Downloader.AddRange(Settings.Users.Where(Function(u) u.ReadyForDownload And u.Exists), e.IncludeInTheFeed)
|
||||
Downloader.AddRange(Settings.GetUsers(Function(u) u.ReadyForDownload And u.Exists), e.IncludeInTheFeed)
|
||||
End Sub
|
||||
Private Sub BTT_DOWN_SITE_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_SITE.KeyClick
|
||||
DownloadSiteFull(True, e.IncludeInTheFeed)
|
||||
End Sub
|
||||
Private Sub BTT_DOWN_ALL_FULL_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_ALL_FULL.KeyClick
|
||||
Downloader.AddRange(Settings.Users.Where(Function(u) u.Exists), e.IncludeInTheFeed)
|
||||
Downloader.AddRange(Settings.GetUsers(UserExistsPredicate), e.IncludeInTheFeed)
|
||||
End Sub
|
||||
Private Sub BTT_DOWN_SITE_FULL_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_SITE_FULL.KeyClick
|
||||
DownloadSiteFull(False, e.IncludeInTheFeed)
|
||||
@@ -395,18 +422,8 @@ CloseResume:
|
||||
Settings.LatestDownloadedSites.AddRange(f.SelectedSites)
|
||||
Settings.LatestDownloadedSites.Update()
|
||||
If f.SelectedSites.Count > 0 Then
|
||||
Downloader.AddRange(Settings.Users.SelectMany(Function(ByVal u As IUserData) As IEnumerable(Of IUserData)
|
||||
If u.IsCollection Then
|
||||
Return DirectCast(u, UserDataBind).Collections.
|
||||
Where(Function(uu) f.SelectedSites.Contains(uu.Site) And u.Exists And
|
||||
(Not ReadyForDownloadOnly Or uu.ReadyForDownload))
|
||||
ElseIf f.SelectedSites.Contains(u.Site) And u.Exists And
|
||||
(Not ReadyForDownloadOnly Or u.ReadyForDownload) Then
|
||||
Return {u}
|
||||
Else
|
||||
Return New IUserData() {}
|
||||
End If
|
||||
End Function), IncludeInTheFeed)
|
||||
Downloader.AddRange(Settings.GetUsers(Function(u) f.SelectedSites.Contains(u.Site) And u.Exists And
|
||||
(Not ReadyForDownloadOnly Or u.ReadyForDownload)), IncludeInTheFeed)
|
||||
End If
|
||||
End If
|
||||
End Using
|
||||
@@ -421,7 +438,7 @@ CloseResume:
|
||||
End Sub
|
||||
Private Sub GROUPS_Updated(ByVal Sender As Groups.DownloadGroup)
|
||||
Dim i% = MENU_DOWN_ALL.DropDownItems.IndexOf(Sender.GetControl)
|
||||
ControlInvoke(Toolbar_TOP, MENU_DOWN_ALL, Sub() MENU_DOWN_ALL.DropDownItems(i).Text = Sender.ToString)
|
||||
If i >= 0 Then ControlInvoke(Toolbar_TOP, MENU_DOWN_ALL, Sub() MENU_DOWN_ALL.DropDownItems(i).Text = Sender.ToString)
|
||||
End Sub
|
||||
Private Sub GROUPS_Deleted(ByVal Sender As Groups.DownloadGroup)
|
||||
MENU_DOWN_ALL.DropDownItems.Remove(Sender.GetControl)
|
||||
@@ -442,9 +459,9 @@ CloseResume:
|
||||
ControlInvokeFast(Toolbar_TOP, BTT_DOWN_AUTOMATION_PAUSE, Sub() BTT_DOWN_AUTOMATION_PAUSE.Visible = b)
|
||||
ControlInvokeFast(Me, Sub() BTT_TRAY_PAUSE_AUTOMATION.Visible = b)
|
||||
End Sub
|
||||
Private Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click
|
||||
Private Async Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click
|
||||
Using f As New SchedulerEditorForm : f.ShowDialog() : End Using
|
||||
Settings.Automation.Start(False)
|
||||
Await Settings.Automation.Start(False)
|
||||
UpdatePauseButtonsVisibility()
|
||||
MainFrameObj.PauseButtons.UpdatePauseButtons()
|
||||
End Sub
|
||||
@@ -728,23 +745,47 @@ CloseResume:
|
||||
End If
|
||||
End Sub
|
||||
Private Sub BTT_CONTEXT_GROUPS_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_GROUPS.Click
|
||||
Const MsgTitle$ = "Label change"
|
||||
Try
|
||||
Dim users As List(Of IUserData) = GetSelectedUserArray()
|
||||
If users.ListExists Then
|
||||
Dim l As List(Of String) = ListAddList(Nothing, users.SelectMany(Function(u) u.Labels), LAP.NotContainsOnly)
|
||||
Using f As New LabelsForm(l) With {.MultiUser = True}
|
||||
Using f As New LabelsForm(l) With {.WithDeleteButton = l.Count > 0}
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then
|
||||
Dim _lp As LAP = LAP.NotContainsOnly
|
||||
If f.MultiUserClearExists Then _lp += LAP.ClearBeforeAdd
|
||||
Dim lp As New ListAddParams(_lp)
|
||||
Dim labels As List(Of String) = f.LabelsList
|
||||
Dim lp As New ListAddParams(LAP.NotContainsOnly)
|
||||
Dim a As Action(Of IUserData) = Sub(u) u.Labels.ListAddList(labels, lp)
|
||||
Dim cMsg As New MMessage("Operation canceled", MsgTitle)
|
||||
If labels.ListExists Then
|
||||
Select Case MsgBoxE(New MMessage($"What do you want to do with the selected labels?{vbCr}Selected labels:{vbCr}{labels.ListToString(vbCr)}",
|
||||
MsgTitle,
|
||||
{
|
||||
New MsgBoxButton("Replace", "All existing labels will be removed and replaced with these labels"),
|
||||
New MsgBoxButton("Add", "These labels will be added to the existing ones"),
|
||||
New MsgBoxButton("Remove", "These labels will be removed from the existing ones"),
|
||||
"Cancel"
|
||||
}, vbExclamation) With {.ButtonsPerRow = 2}).Index
|
||||
Case 0 : lp.ClearBeforeAdd = True
|
||||
Case 1 : lp.ClearBeforeAdd = False
|
||||
Case 2 : a = Sub(u) u.Labels.ListDisposeRemove(labels)
|
||||
Case Else : cMsg.Show() : Exit Sub
|
||||
End Select
|
||||
Else
|
||||
If MsgBoxE({"Are you sure you want to remove all labels?", MsgTitle}, vbExclamation + vbYesNo) = vbYes Then
|
||||
a = Sub(u) u.Labels.Clear()
|
||||
Else
|
||||
cMsg.Show()
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
users.ForEach(Sub(ByVal u As IUserData)
|
||||
If u.IsCollection Then
|
||||
With DirectCast(u, UserDataBind)
|
||||
If .Count > 0 Then .Collections.ForEach(Sub(uu) uu.Labels.ListAddList(f.LabelsList, lp))
|
||||
If .Count > 0 Then .Collections.ForEach(a)
|
||||
End With
|
||||
Else
|
||||
u.Labels.ListAddList(f.LabelsList, lp)
|
||||
a.Invoke(u)
|
||||
End If
|
||||
u.UpdateUserInformation()
|
||||
End Sub)
|
||||
@@ -828,11 +869,48 @@ CloseResume:
|
||||
MainFrameObj.CollectionHandler(DirectCast(.Users.Last, UserDataBind))
|
||||
userCollection = .Users.Last
|
||||
End If
|
||||
|
||||
Dim __modelUser As UsageModel = -1
|
||||
Dim __modelCollection As UsageModel = -1
|
||||
Dim __ModelAskForDecision As Boolean = False
|
||||
If Not Added Then __modelCollection = userCollection.CollectionModel
|
||||
If Added Then
|
||||
__ModelAskForDecision = True
|
||||
ElseIf userCollection.CollectionModel = UsageModel.Virtual Then
|
||||
__modelUser = UsageModel.Virtual
|
||||
__modelCollection = UsageModel.Virtual
|
||||
Else
|
||||
__ModelAskForDecision = True
|
||||
End If
|
||||
If __ModelAskForDecision Then
|
||||
Select Case MsgBoxE({"How do you want to add users to the collection?", MsgTitle}, vbQuestion,,,
|
||||
{
|
||||
New MsgBoxButton("Default", "User files will be moved to the collection") With {.KeyCode = Keys.Enter},
|
||||
New MsgBoxButton("Virtual", "The user will be included in the collection, but user files will not be moved") With {
|
||||
.KeyCode = New ButtonKey(Keys.Enter, True)}
|
||||
}).Index
|
||||
Case 0
|
||||
__modelUser = UsageModel.Default
|
||||
If __modelCollection = -1 Then __modelCollection = UsageModel.Default
|
||||
Case 1
|
||||
__modelUser = UsageModel.Virtual
|
||||
If __modelCollection = -1 Then __modelCollection = UsageModel.Virtual
|
||||
End Select
|
||||
End If
|
||||
If __modelUser = -1 Or __modelCollection = -1 Then
|
||||
MsgBoxE({$"Some parameters cannot be processed:{vbCr}" &
|
||||
$"UserModel: {CInt(__modelUser)}{vbCr}CollectionModel: {CInt(__modelCollection)}{vbCr}" &
|
||||
"Operation canceled", MsgTitle}, vbCritical)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim __added_users As New List(Of IUserData)
|
||||
Dim __added_users_not As New List(Of IUserData)
|
||||
For Each user As IUserData In users
|
||||
For Each user As UserDataBase In users
|
||||
If Not user.IsCollection Then
|
||||
Try
|
||||
user.User.UserModel = __modelUser
|
||||
user.User.CollectionModel = __modelCollection
|
||||
userCollection.Add(user)
|
||||
RemoveUserFromList(user)
|
||||
UserListUpdate(userCollection, Added)
|
||||
@@ -872,15 +950,17 @@ CloseResume:
|
||||
End If
|
||||
End Sub
|
||||
Private Sub BTT_CONTEXT_COL_MERGE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_COL_MERGE.Click
|
||||
Const MsgTitle$ = "Merging files"
|
||||
Dim user As IUserData = GetSelectedUser()
|
||||
If Not user Is Nothing Then
|
||||
If user.IsCollection Then
|
||||
If DirectCast(user, UserDataBind).DataMerging Then
|
||||
MsgBoxE("Collection files are already merged")
|
||||
MsgBoxE({"Collection files are already merged", MsgTitle})
|
||||
ElseIf user.IsVirtual Then
|
||||
MsgBoxE({"The action cannot be performed. This is a virtual collection.", MsgTitle}, vbCritical)
|
||||
Else
|
||||
If MsgBoxE({"Do you really want to merge collection files into one folder?" & vbNewLine &
|
||||
"This action is not turnable!", "Merging files"},
|
||||
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
|
||||
If MsgBoxE({"Are you sure you want to merge the collection files into one folder?" & vbNewLine &
|
||||
"This action is not turnable!", MsgTitle}, vbExclamation + vbYesNo) = vbYes Then
|
||||
DirectCast(user, UserDataBind).DataMerging = True
|
||||
End If
|
||||
End If
|
||||
@@ -890,83 +970,118 @@ CloseResume:
|
||||
End If
|
||||
End Sub
|
||||
Private Sub BTT_CONTEXT_CHANGE_FOLDER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_CHANGE_FOLDER.Click
|
||||
Const MsgTitle$ = "Change user folder"
|
||||
Try
|
||||
If Downloader.Working Then
|
||||
MsgBoxE({"Some users are currently downloading." & vbCr &
|
||||
"You cannot change paths while downloading." & vbCr &
|
||||
"Wait until the download is complete.", MsgTitle}, vbCritical)
|
||||
Exit Sub
|
||||
Else
|
||||
Downloader.Suspended = True
|
||||
End If
|
||||
Dim users As List(Of IUserData) = GetSelectedUserArray()
|
||||
If users.ListExists Then
|
||||
If users.Count = 1 Then
|
||||
Dim CutOption% = 1
|
||||
Dim _IsCollection As Boolean = False
|
||||
Dim CurrDir As SFile
|
||||
Dim colName$ = String.Empty
|
||||
With users(0)
|
||||
If .IsCollection Then
|
||||
_IsCollection = True
|
||||
With DirectCast(.Self, UserDataBind)
|
||||
If .Count = 0 Then
|
||||
Throw New ArgumentOutOfRangeException("Collection", "Collection is empty")
|
||||
ElseIf .IsVirtual Then
|
||||
MsgBoxE({"This is a virtual collection." & vbCr &
|
||||
"The virtual collection path cannot be changed." & vbCr &
|
||||
"To change the paths of users included in a virtual collection, " &
|
||||
"you must split the collection and then change the user paths.", MsgTitle}, vbCritical)
|
||||
Exit Sub
|
||||
Else
|
||||
With DirectCast(.Collections(0), UserDataBase)
|
||||
If Not .User.Merged Then CutOption = 2
|
||||
End With
|
||||
CurrDir = .GetRealUserFile
|
||||
If CurrDir.IsEmptyString Then
|
||||
MsgBoxE({"Non-virtual users not found", MsgTitle}, vbCritical)
|
||||
Exit Sub
|
||||
End If
|
||||
CurrDir = CurrDir.CutPath(IIf(.DataMerging, 3, 2))
|
||||
colName = CurrDir.PathFolders.LastOrDefault
|
||||
Dim vu As IEnumerable(Of IUserData) = .Where(Function(vuu) vuu.UserModel = UsageModel.Virtual)
|
||||
If vu.ListExists Then
|
||||
If MsgBoxE({"This collection contains virtual users." & vbCr &
|
||||
"If you continue, the virtual user paths will not be changed." & vbCr &
|
||||
"The following users have been added to the collection in virtual mode:" & vbCr &
|
||||
vu.ListToStringE(vbCr, GetUserListProvider(False)), MsgTitle},
|
||||
vbExclamation,,, {"Continue", "Cancel"}) = 1 Then MsgBoxE({"Operation canceled", MsgTitle}) : Exit Sub
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
CurrDir = .Self.File.CutPath(1)
|
||||
End If
|
||||
End With
|
||||
|
||||
Dim CurrDir As SFile = users(0).File.CutPath(CutOption)
|
||||
Dim NewDest As SFile = SFile.GetPath(InputBoxE($"Enter a new destination for user [{users(0)}]", "Change user folder", CurrDir.Path))
|
||||
If Not NewDest.IsEmptyString Then
|
||||
If MsgBoxE({$"You are changing the user's [{users(0)}] destination" & vbCr &
|
||||
$"Current destination: {CurrDir.PathNoSeparator}" & vbCr &
|
||||
$"New destination: {NewDest.Path}",
|
||||
"Changing user destination"}, MsgBoxStyle.Exclamation,,, {"Confirm", "Cancel"}) = 0 Then
|
||||
If Not NewDest.IsEmptyString AndAlso
|
||||
(Not NewDest.Exists(SFO.Path, False) OrElse
|
||||
(
|
||||
SFile.GetFiles(NewDest,, IO.SearchOption.AllDirectories, EDP.ThrowException).ListIfNothing.Count = 0 AndAlso
|
||||
NewDest.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException) AndAlso
|
||||
Not NewDest.Exists(SFO.Path, False)
|
||||
)
|
||||
) Then
|
||||
NewDest.CutPath.Exists(SFO.Path)
|
||||
IO.Directory.Move(CurrDir.Path, NewDest.Path)
|
||||
Dim ApplyChanges As Action(Of IUserData) = Sub(ByVal __user As IUserData)
|
||||
With DirectCast(__user, UserDataBase)
|
||||
Dim u As UserInfo = .User.Clone
|
||||
Settings.UsersList.Remove(u)
|
||||
Dim d As SFile = Nothing
|
||||
If _IsCollection Then d = SFile.GetPath($"{NewDest.PathWithSeparator}{u.File.PathFolders(1).LastOrDefault}")
|
||||
If d.IsEmptyString Then d = NewDest
|
||||
u.SpecialPath = d.PathWithSeparator
|
||||
u.UpdateUserFile()
|
||||
Settings.UpdateUsersList(u)
|
||||
.User = u.Clone
|
||||
.UpdateUserInformation()
|
||||
End With
|
||||
End Sub
|
||||
If users(0).IsCollection Then
|
||||
With DirectCast(users(0), UserDataBind)
|
||||
For Each user In .Collections : ApplyChanges(user) : Next
|
||||
End With
|
||||
Dim NewDest As SFile = SFile.SelectPath(CurrDir, $"Select a new destination for {IIf(_IsCollection, "collection", "user")} [{ .Self}]")
|
||||
If Not NewDest.IsEmptyString Then
|
||||
NewDest = $"{NewDest.PathWithSeparator}{colName}\"
|
||||
If MsgBoxE({$"You are changing the user's [{ .Self}] destination" & vbCr &
|
||||
$"Current destination: {CurrDir.PathNoSeparator}" & vbCr &
|
||||
$"New destination: {NewDest.PathNoSeparator}",
|
||||
MsgTitle}, MsgBoxStyle.Exclamation,,, {"Confirm", "Cancel"}) = 0 Then
|
||||
If Not NewDest.IsEmptyString AndAlso
|
||||
(Not NewDest.Exists(SFO.Path, False) OrElse
|
||||
(
|
||||
SFile.GetFiles(NewDest,, IO.SearchOption.AllDirectories, EDP.ThrowException).ListIfNothing.Count = 0 AndAlso
|
||||
NewDest.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException) AndAlso
|
||||
Not NewDest.Exists(SFO.Path, False)
|
||||
)
|
||||
) Then
|
||||
If SFile.Move(CurrDir, NewDest, SFO.Path,,, EDP.ShowMainMsg + EDP.ReturnValue) Then
|
||||
Dim ApplyChanges As Action(Of IUserData) = Sub(ByVal __user As IUserData)
|
||||
With DirectCast(__user, UserDataBase)
|
||||
Dim u As UserInfo = .User
|
||||
Settings.UsersList.Remove(u)
|
||||
If _IsCollection Then
|
||||
u.SpecialCollectionPath = NewDest
|
||||
Else
|
||||
u.SpecialPath = NewDest
|
||||
End If
|
||||
u.UpdateUserFile()
|
||||
Settings.UsersList.Add(u)
|
||||
.User = u
|
||||
.UpdateUserInformation()
|
||||
End With
|
||||
End Sub
|
||||
If .Self.IsCollection Then
|
||||
With DirectCast(.Self, UserDataBind)
|
||||
For Each user In .Collections : ApplyChanges(user) : Next
|
||||
End With
|
||||
Else
|
||||
ApplyChanges(.Self)
|
||||
End If
|
||||
Settings.UpdateUsersList()
|
||||
MsgBoxE({"User data has been moved", MsgTitle})
|
||||
End If
|
||||
Else
|
||||
ApplyChanges(users(0))
|
||||
MsgBoxE({$"Unable to move user data to new destination [{NewDest}]{vbCr}Operation canceled", MsgTitle}, MsgBoxStyle.Critical)
|
||||
End If
|
||||
MsgBoxE($"User data has been moved")
|
||||
Else
|
||||
MsgBoxE($"Unable to move user data to new destination [{NewDest}]{vbCr}Operation canceled", MsgBoxStyle.Critical)
|
||||
MsgBoxE({"Operation canceled", MsgTitle})
|
||||
End If
|
||||
Else
|
||||
MsgBoxE("Operation canceled")
|
||||
MsgBoxE({$"You have not entered a new destination{vbCr}Operation canceled", MsgTitle}, MsgBoxStyle.Exclamation)
|
||||
End If
|
||||
Else
|
||||
MsgBoxE("You have not entered a new destination" & vbCr & "Operation canceled", MsgBoxStyle.Exclamation)
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
MsgBoxE("You have selected multiple users. You can change the folder only for one user!", MsgBoxStyle.Critical)
|
||||
MsgBoxE({"You have selected multiple users. You can change the folder only for one user!", MsgTitle}, MsgBoxStyle.Critical)
|
||||
End If
|
||||
Else
|
||||
MsgBoxE("No one user selected", MsgBoxStyle.Exclamation)
|
||||
MsgBoxE({"No one user selected", MsgTitle}, MsgBoxStyle.Exclamation)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ErrorsDescriber.Execute(EDP.ShowAllMsg, ex, "Error while moving user")
|
||||
Finally
|
||||
Downloader.Suspended = False
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
@@ -997,7 +1112,7 @@ CloseResume:
|
||||
#Region "6 - information"
|
||||
Private Sub BTT_CONTEXT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_INFO.Click
|
||||
Dim user As IUserData = GetSelectedUser()
|
||||
If Not user Is Nothing Then MsgBoxE(DirectCast(user, UserDataBase).GetUserInformation())
|
||||
If Not user Is Nothing Then MsgBoxE(New MMessage(DirectCast(user, UserDataBase).GetUserInformation(), "User information") With {.Editable = True})
|
||||
End Sub
|
||||
#End Region
|
||||
Private Sub USER_CONTEXT_VisibleChanged(sender As Object, e As EventArgs) Handles USER_CONTEXT.VisibleChanged
|
||||
@@ -1179,7 +1294,7 @@ CancelDownloadingOperation:
|
||||
Exit Sub
|
||||
ResumeDownloadingOperation:
|
||||
Dim uStr$ = If(users.Count = 1, String.Empty, users.ListToStringE(vbNewLine, GetUserListProvider(True)))
|
||||
Dim fStr$ = $"({IIf(IncludeInTheFeed, "included in", "excluded from")} the feed)"
|
||||
Dim fStr$ = $" ({IIf(IncludeInTheFeed, "included in", "excluded from")} the feed)"
|
||||
If users.Count = 1 OrElse MsgBoxE({$"You have selected {users.Count} user profiles" & vbCr &
|
||||
$"Do you want to download them all{fStr}?{vbNewLine.StringDup(2)}" &
|
||||
$"Selected users:{vbNewLine}{uStr}", "Multiple users selected"},
|
||||
@@ -1194,16 +1309,61 @@ ResumeDownloadingOperation:
|
||||
End If
|
||||
End Sub
|
||||
Private Sub EditSelectedUser()
|
||||
Const MsgTitle$ = "User update"
|
||||
Dim user As IUserData = GetSelectedUser()
|
||||
If Not user Is Nothing Then
|
||||
On Error Resume Next
|
||||
If user.IsCollection Then
|
||||
If USER_CONTEXT.Visible Then USER_CONTEXT.Hide()
|
||||
MsgBoxE($"This is collection!{vbNewLine}Collection editing not allowed!", vbExclamation)
|
||||
Else
|
||||
If Not user.IsCollection OrElse DirectCast(user, UserDataBind).Count > 0 Then
|
||||
If user.IsCollection And USER_CONTEXT.Visible Then USER_CONTEXT.Hide()
|
||||
Using f As New UserCreatorForm(user)
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then UserListUpdate(user, False)
|
||||
If f.DialogResult = DialogResult.OK Then
|
||||
Dim NeedToUpdate As Boolean = True
|
||||
If user.IsCollection Then
|
||||
If user.IsCollection And Not user.CollectionName = f.CollectionName Then
|
||||
If Not user.IsVirtual AndAlso Downloader.Working Then
|
||||
MsgBoxE({"Some users are currently downloading." & vbCr &
|
||||
"You cannot change collection name while downloading." & vbCr &
|
||||
"Wait until the download is complete.", MsgTitle}, vbCritical)
|
||||
Exit Sub
|
||||
Else
|
||||
If Not user.IsVirtual Then
|
||||
Dim colFile As SFile = DirectCast(user, UserDataBind).GetRealUserFile
|
||||
If Not colFile.IsEmptyString Then
|
||||
colFile = colFile.CutPath(IIf(DirectCast(user, UserDataBind).DataMerging, 1, 2))
|
||||
If Not colFile.IsEmptyString Then
|
||||
Dim nf As SFile = $"{colFile.CutPath(1).PathWithSeparator}{f.CollectionName}".CSFilePS
|
||||
If Not SFile.Rename(colFile, New SFile With {.Path = f.CollectionName}, SFO.Path,
|
||||
New ErrorsDescriber(True, False, False, New SFile)).IsEmptyString Then
|
||||
RemoveUserFromList(user)
|
||||
Dim __user As UserInfo
|
||||
For Each ColUser As UserDataBase In DirectCast(user, UserDataBind).Collections
|
||||
__user = ColUser.User
|
||||
Settings.UsersList.Remove(__user)
|
||||
__user.CollectionName = f.CollectionName
|
||||
If Not __user.SpecialCollectionPath.IsEmptyString Then __user.SpecialCollectionPath = nf
|
||||
__user.UpdateUserFile()
|
||||
ColUser.User = __user
|
||||
Settings.UsersList.Add(__user)
|
||||
Next
|
||||
user.UpdateUserInformation()
|
||||
UserListUpdate(user, True)
|
||||
NeedToUpdate = False
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
RemoveUserFromList(user)
|
||||
user.CollectionName = f.CollectionName
|
||||
user.UpdateUserInformation()
|
||||
UserListUpdate(user, True)
|
||||
NeedToUpdate = False
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
If NeedToUpdate Then UserListUpdate(user, False)
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
End If
|
||||
@@ -1216,19 +1376,26 @@ ResumeDownloadingOperation:
|
||||
Dim userProvider As IFormatProvider = GetUserListProvider(True)
|
||||
Dim ugn As Func(Of IUserData, String) = Function(u) AConvert(Of String)(u, userProvider)
|
||||
Dim m As New MMessage(users.ListToStringE(vbNewLine, userProvider), "Users deleting",
|
||||
{New MsgBoxButton("Delete and ban") With {.ToolTip = "Users and their data will be deleted and added to the blacklist"},
|
||||
{New MsgBoxButton("Delete and ban") With {
|
||||
.ToolTip = "Users and their data will be deleted and added to the blacklist",
|
||||
.KeyCode = Keys.Enter},
|
||||
New MsgBoxButton("Delete user only and ban") With {
|
||||
.ToolTip = "Users will be deleted and added to the blacklist (user data will not be deleted)"},
|
||||
New MsgBoxButton("Delete and ban with reason") With {
|
||||
.ToolTip = "Users and their data will be deleted and added to the blacklist with set a reason to delete"},
|
||||
.ToolTip = "Users and their data will be deleted and added to the blacklist with set a reason to delete",
|
||||
.KeyCode = New ButtonKey(Keys.Enter,, True)},
|
||||
New MsgBoxButton("Delete user only and ban with reason") With {
|
||||
.ToolTip = "Users will be deleted and added to the blacklist with set a reason to delete (user data will not be deleted)"},
|
||||
New MsgBoxButton("Delete") With {.ToolTip = "Delete users and their data"},
|
||||
New MsgBoxButton("Delete") With {
|
||||
.ToolTip = "Delete users and their data",
|
||||
.KeyCode = New ButtonKey(Keys.Enter, True)},
|
||||
New MsgBoxButton("Delete user only") With {.ToolTip = "Delete users but keep data"}, "Cancel"},
|
||||
MsgBoxStyle.Exclamation) With {.ButtonsPerRow = 2, .ButtonsPlacing = MMessage.ButtonsPlacings.StartToEnd}
|
||||
m.Text = $"The following users ({users.Count}) will be deleted:{vbNewLine}{m.Text}"
|
||||
Dim result% = MsgBoxE(m)
|
||||
If result < 6 Then
|
||||
Dim collectionResult% = -1
|
||||
Dim tmpResult%
|
||||
Dim IsMultiple As Boolean = users.Count > 1
|
||||
Dim removedUsers As New List(Of String)
|
||||
Dim keepData As Boolean = Not (result Mod 2) = 0
|
||||
@@ -1263,7 +1430,9 @@ ResumeDownloadingOperation:
|
||||
removedUsers.Add(ugn(user))
|
||||
user.Dispose()
|
||||
Else
|
||||
If user.Delete(IsMultiple) > 0 Then
|
||||
tmpResult = user.Delete(IsMultiple, collectionResult)
|
||||
If user.IsCollection And collectionResult = -1 Then collectionResult = tmpResult
|
||||
If tmpResult > 0 Then
|
||||
If banUser Then Settings.BlackList.ListAddValue(New UserBan(user.Name, reason), l) : b = True
|
||||
RemoveUserFromList(user)
|
||||
removedUsers.Add(ugn(user))
|
||||
@@ -1304,7 +1473,7 @@ ResumeDownloadingOperation:
|
||||
If users.ListExists Then
|
||||
Dim f As SFile = Settings.LastCopyPath
|
||||
Dim _select_path As Func(Of Boolean) = Function() As Boolean
|
||||
f = SFile.SelectPath(f, True)
|
||||
f = SFile.SelectPath(f)
|
||||
If f.Exists(SFO.Path, False) Then
|
||||
Return MsgBoxE({$"Are you sure you want to copy the data to the selected folder?{vbCr}{f}",
|
||||
MsgTitle}, vbQuestion + vbYesNo) = vbYes
|
||||
@@ -1438,21 +1607,14 @@ ResumeDownloadingOperation:
|
||||
Friend Sub User_OnUserUpdated(ByVal User As IUserData)
|
||||
UserListUpdate(User, False)
|
||||
End Sub
|
||||
Private _LogColorChanged As Boolean = False
|
||||
Private Sub Downloader_UpdateJobsCount(ByVal TotalCount As Integer)
|
||||
Dim a As Action = Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]")
|
||||
If Toolbar_BOTTOM.InvokeRequired Then Toolbar_BOTTOM.Invoke(a) Else a.Invoke
|
||||
If Not _LogColorChanged AndAlso Not MyMainLOG.IsEmptyString Then
|
||||
MainFrameObj.UpdateLogButton()
|
||||
_LogColorChanged = True
|
||||
ElseIf _LogColorChanged And MyMainLOG.IsEmptyString Then
|
||||
MainFrameObj.UpdateLogButton()
|
||||
_LogColorChanged = False
|
||||
End If
|
||||
ControlInvokeFast(Toolbar_BOTTOM, LBL_JOBS_COUNT, Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]"))
|
||||
MainFrameObj.UpdateLogButton()
|
||||
End Sub
|
||||
Private Sub Downloader_Downloading(ByVal Value As Boolean)
|
||||
Dim a As Action = Sub() BTT_DOWN_STOP.Enabled = Value Or Downloader.Working
|
||||
If Toolbar_TOP.InvokeRequired Then Toolbar_TOP.Invoke(a) Else a.Invoke
|
||||
Dim __isDownloading As Boolean = Value Or Downloader.Working
|
||||
ControlInvokeFast(Toolbar_TOP, BTT_DOWN_STOP, Sub() BTT_DOWN_STOP.Enabled = __isDownloading)
|
||||
ControlInvokeFast(Me, Sub() TrayIcon.Icon = If(__isDownloading, My.Resources.ArrowDownIcon_Blue_24, My.Resources.RainbowIcon_48))
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
@@ -9,6 +9,7 @@
|
||||
Imports SCrawler.API
|
||||
Imports SCrawler.API.Base
|
||||
Imports PersonalUtilities.Tools.Notifications
|
||||
Imports NotifyObj = SCrawler.SettingsCLS.NotificationObjects
|
||||
Friend Class MainFrameObjects
|
||||
Friend ReadOnly Property MF As MainFrame
|
||||
Private WithEvents Notificator As NotificationsManager
|
||||
@@ -48,34 +49,42 @@ Friend Class MainFrameObjects
|
||||
#End Region
|
||||
#Region "Form functions"
|
||||
Friend Sub Focus(Optional ByVal Show As Boolean = False)
|
||||
If Not MF.Visible And Show Then MF.Show()
|
||||
If MF.Visible Then MF.BringToFront() : MF.Activate()
|
||||
ControlInvokeFast(MF, Sub()
|
||||
If Not MF.Visible And Show Then MF.Show()
|
||||
If MF.Visible Then MF.BringToFront() : MF.Activate()
|
||||
End Sub)
|
||||
End Sub
|
||||
Friend Sub ChangeCloseVisible()
|
||||
Dim a As Action = Sub() MF.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = Settings.ClosingCommand.Attribute And Not Settings.ClosingCommand.IsEmptyString
|
||||
If MF.TRAY_CONTEXT.InvokeRequired Then MF.TRAY_CONTEXT.Invoke(a) Else a.Invoke
|
||||
ControlInvokeFast(MF.TRAY_CONTEXT, Sub() MF.BTT_TRAY_CLOSE_NO_SCRIPT.Visible =
|
||||
Settings.ClosingCommand.Attribute And Not Settings.ClosingCommand.IsEmptyString)
|
||||
End Sub
|
||||
Friend Sub UpdateLogButton()
|
||||
MyMainLOG_UpdateLogButton(MF.BTT_LOG, MF.Toolbar_TOP)
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Notifications"
|
||||
Friend Overloads Sub ShowNotification(ByVal Sender As SettingsCLS.NotificationObjects, ByVal Message As String)
|
||||
If Settings.ProcessNotification(Sender) Then MF.TrayIcon.ShowBalloonTip(2000, MF.TrayIcon.BalloonTipTitle, Message, ToolTipIcon.Info)
|
||||
End Sub
|
||||
Friend Overloads Sub ShowNotification(ByVal Sender As SettingsCLS.NotificationObjects, ByVal Message As String, ByVal Title As String)
|
||||
If Settings.ProcessNotification(Sender) Then MF.TrayIcon.ShowBalloonTip(2000, Title, Message, ToolTipIcon.Info)
|
||||
End Sub
|
||||
Friend Overloads Sub ShowNotification(ByVal Sender As SettingsCLS.NotificationObjects, ByVal Message As String, ByVal Title As String, ByVal Icon As ToolTipIcon)
|
||||
If Settings.ProcessNotification(Sender) Then MF.TrayIcon.ShowBalloonTip(2000, Title, Message, Icon)
|
||||
Private Const NotificationInternalKey As String = "NotificationInternalKey"
|
||||
Friend Sub ShowNotification(ByVal Sender As NotifyObj, ByVal Message As String)
|
||||
If Settings.ProcessNotification(Sender) Then
|
||||
Using n As New Notification(Message) With {.Key = $"{NotificationInternalKey}_{Sender}"} : n.Show() : End Using
|
||||
End If
|
||||
End Sub
|
||||
Friend Sub ClearNotifications()
|
||||
Notificator.Clear()
|
||||
End Sub
|
||||
Private Sub Notificator_OnClicked(ByVal Key As String) Handles Notificator.OnClicked
|
||||
If Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key) Then
|
||||
If Not MF.Visible Then MF.Show()
|
||||
Focus()
|
||||
If Not Key.IsEmptyString Then
|
||||
If Key.StartsWith(NotificationInternalKey) Then
|
||||
Select Case Key
|
||||
Case $"{NotificationInternalKey}_{NotifyObj.Channels}" : MF.MyChannels.FormShowS()
|
||||
Case $"{NotificationInternalKey}_{NotifyObj.SavedPosts}" : MF.MySavedPosts.FormShowS()
|
||||
Case Else : Focus(True)
|
||||
End Select
|
||||
ElseIf Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key) Then
|
||||
Focus(True)
|
||||
Else
|
||||
Focus(True)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
#End Region
|
||||
|
||||
@@ -10,7 +10,7 @@ Imports PersonalUtilities.Functions.XML.Base
|
||||
Imports PersonalUtilities.Functions.RegularExpressions
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Imports PersonalUtilities.Tools.Web
|
||||
Imports SCrawler.API
|
||||
Imports SCrawler.API.Base
|
||||
Imports SCrawler.Plugin.Hosts
|
||||
@@ -93,6 +93,10 @@ Friend Module MainMod
|
||||
Replace = 1
|
||||
Add = 2
|
||||
End Enum
|
||||
Friend Enum UsageModel As Integer
|
||||
[Default] = 0
|
||||
Virtual = 1
|
||||
End Enum
|
||||
Friend Downloader As TDownloader
|
||||
Friend InfoForm As DownloadedInfoForm
|
||||
Friend VideoDownloader As VideosDownloaderForm
|
||||
@@ -101,6 +105,7 @@ Friend Module MainMod
|
||||
Friend MainFrameObj As MainFrameObjects
|
||||
Friend ReadOnly ParsersDataDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
|
||||
Friend ReadOnly FeedVideoLengthProvider As New ADateTime("hh\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
|
||||
Friend ReadOnly UserExistsPredicate As New FPredicate(Of IUserData)(Function(u) u.Exists)
|
||||
Friend ReadOnly LogConnector As New LogHost
|
||||
#Region "File name operations"
|
||||
Friend FileDateAppenderProvider As IFormatProvider
|
||||
|
||||
@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
|
||||
' by using the '*' as shown below:
|
||||
' <Assembly: AssemblyVersion("1.0.*")>
|
||||
|
||||
<Assembly: AssemblyVersion("2022.10.18.0")>
|
||||
<Assembly: AssemblyFileVersion("2022.10.18.0")>
|
||||
<Assembly: AssemblyVersion("2022.11.16.0")>
|
||||
<Assembly: AssemblyFileVersion("2022.11.16.0")>
|
||||
<Assembly: NeutralResourcesLanguage("en")>
|
||||
|
||||
10
SCrawler/My Project/Resources.Designer.vb
generated
@@ -360,6 +360,16 @@ Namespace My.Resources
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
|
||||
'''</summary>
|
||||
Friend ReadOnly Property TagIcon_32() As System.Drawing.Icon
|
||||
Get
|
||||
Dim obj As Object = ResourceManager.GetObject("TagIcon_32", resourceCulture)
|
||||
Return CType(obj,System.Drawing.Icon)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'''<summary>
|
||||
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
|
||||
'''</summary>
|
||||
|
||||
@@ -211,4 +211,7 @@
|
||||
<data name="PinPic_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Content\Pictures\PinPic_32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
|
||||
</data>
|
||||
<data name="TagIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
|
||||
<value>..\Content\Icons\TagIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
|
||||
</data>
|
||||
</root>
|
||||
@@ -81,6 +81,8 @@ Namespace Plugin.Hosts
|
||||
New PluginHost(New API.RedGifs.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
|
||||
New PluginHost(New API.TikTok.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
|
||||
New PluginHost(New API.LPSG.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
|
||||
New PluginHost(New API.PornHub.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
|
||||
New PluginHost(New API.Xhamster.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
|
||||
New PluginHost(New API.XVIDEOS.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)}
|
||||
End Function
|
||||
Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
|
||||
|
||||