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

2022.11.16.0

Browse Source 
Add sites: PornHub, XHamster
Add saved xvideos posts downloading
PluginProvider: added TaskGroup attribute; added IUserMedia inteface; changed PluginUserMedia to IUserMedia in interface declarations; changed 'User' String to IPluginContentProvider in ISiteSettings sinterface
Added update the 'LOG' button at the end of the ProfileSaved download function
API.Base: added 'IUserMedia' compatibility for 'UserMedia'; moved 'GetImage' from 'UserPost' to 'ChannelsViewForm'; update constants in UserDataBase; updated UserDataBase to new UserInfo environment.
API.Instagram.UserData: fixed date issue
API.Reddit.SiteSettings: update user patterns
API.Twitter.Declarations: moved provider here from MainFrame
UserDataBind: updated to new UserInfo environment
ActiveDownloadingProgress: updated form rendering
AutoDownloader: added SpecialDelay
TDownloader: added 'Suspended' option; updated for TaskGroups
CollectionEditorForm: fixed order bug
LabelsForm: remove old stuff
UserEditorForm: added collection editing
MainFrame: improve label selection
Add import users
Added the ability to create a virtual collection and add a virtual user to a real collection
SettingsCLS: improve users loading
This commit is contained in:
Andy
2022-11-16 13:41:45 +03:00
parent 7d169acebc
commit bdc7321331
90 changed files with 3831 additions and 1028 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
SCrawler/API/Base/M3U8Base.vb Normal file
View File

@@ -0,0 +1,64 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.Base
Namespace M3U8Declarations
Friend Module M3U8Defaults
Friend ReadOnly TsFilesRegEx As RParams = RParams.DM(".+?\.ts[^\r\n]*", 0, RegexReturn.List)
End Module
End Namespace
Friend NotInheritable Class M3U8Base
Private Sub New()
End Sub
Friend Shared Function CreateUrl(ByVal Appender As String, ByVal File As String) As String
File = File.StringTrimStart("/")
If File.StartsWith("http") Then
Return File
Else
If File.StartsWith("hls/") And Appender.Contains("hls/") Then _
Appender = LinkFormatterSecure(Appender.Replace("https://", String.Empty).Split("/").First)
Return $"{Appender.StringTrimEnd("/")}/{File}"
End If
End Function
Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As 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

3
SCrawler/API/Base/ProfileSaved.vb
View File

@@ -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

17
SCrawler/API/Base/SiteSettingsBase.vb
View File

@@ -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

131
SCrawler/API/Base/Structures.vb
View File

@@ -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

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

@@ -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,7 +854,7 @@ BlockNullPicture:
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response
If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
'TODO: remove
'TODO: UserDataBase remove [Responser.DecodersError]
Responser.DecodersError = New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue) With {
.DeclaredMessage = New MMessage($"SymbolsConverter error: [{ToStringForLog()}]", ToStringForLog())}
@@ -831,6 +868,7 @@ BlockNullPicture:
DownloadedVideos(False) = 0
_TempMediaList.Clear()
_TempPostsList.Clear()
LatestData.Clear()
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
LoadContentInformation()
@@ -862,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)
@@ -887,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
@@ -926,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
@@ -939,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
@@ -1068,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
@@ -1078,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
@@ -1124,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)
@@ -1138,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()
@@ -1411,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
@@ -1433,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
@@ -1464,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
@@ -1488,4 +1517,5 @@ BlockNullPicture:
Property SkipExistsUsers As Boolean
Property SaveToCache As Boolean
End Interface
#End Region
End Namespace