Files
SCrawler/SCrawler/API/Base/UserDataBase.vb
Andy 46372ec9fb 2024.4.13.0
YT
Add subtitles to information about downloaded files

PluginProvider
IPluginContentProvider: add 'ResetHistoryData' function

SCrawler
UserDataBase: call 'UpdateUsersList' when 'UpdateUserInformation' with argument 'OnlyDiff'; implement 'ResetHistoryData' function; set 'LastUpdated' to null and 'UpdateUserInformation' when erasing history data
API.Instagram: set 'FirstLoadingDone' to false when erasing history data; fix broken saved posts downloading
API.TikTok: set 'LastDownloadDate' to null when erasing history data
API.YouTube: set last download dates to null when erasing history data
GroupUsersViewer: add the number of users, object type and object name to the form title; add 'F1' to help hint; add '(Alt+)F3' to edit user
AutoDownloaderEditorForm, SchedulerEditorForm, GroupEditorForm, GroupListForm: update to 'GroupUsersViewer'
MainFrame: make 'EditSelectedUser' friend
UserDataHost: implement 'ResetHistoryData' function
SettingsCLS: add 'OnlyDiff' to the 'UpdateUsersList' function
UserInfo: add 'ExactEquals' shared function
2024-04-13 10:10:27 +03:00

2252 lines
121 KiB
VB.net

' 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.IO
Imports System.Net
Imports System.Threading
Imports System.ComponentModel
Imports System.Runtime.CompilerServices
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Objects
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.ImageRenderer
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CookieUpdateModes = PersonalUtilities.Tools.Web.Cookies.CookieKeeper.UpdateModes
Namespace API.Base
Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower
Friend Const UserFileAppender As String = "User"
#Region "Events"
Private ReadOnly UserUpdatedEventHandlers As List(Of IUserData.UserUpdatedEventHandler)
Friend Custom Event UserUpdated As IUserData.UserUpdatedEventHandler Implements IUserData.UserUpdated
AddHandler(ByVal e As IUserData.UserUpdatedEventHandler)
If Not UserUpdatedEventHandlers.Contains(e) Then UserUpdatedEventHandlers.Add(e)
End AddHandler
RemoveHandler(ByVal e As IUserData.UserUpdatedEventHandler)
If UserUpdatedEventHandlers.Contains(e) Then UserUpdatedEventHandlers.Remove(e)
End RemoveHandler
RaiseEvent(ByVal User As IUserData)
Try
If UserUpdatedEventHandlers.Count > 0 Then
For i% = 0 To UserUpdatedEventHandlers.Count - 1
Try : UserUpdatedEventHandlers(i).Invoke(User) : Catch : End Try
Next
End If
Catch
End Try
End RaiseEvent
End Event
Protected Sub OnUserUpdated()
RaiseEvent UserUpdated(Me)
End Sub
Friend Sub RemoveUpdateHandlers()
UserUpdatedEventHandlers.Clear()
End Sub
Private ReadOnly UserDownloadStateChangedEventHandlers As List(Of UserDownloadStateChangedEventHandler)
Friend Custom Event UserDownloadStateChanged As UserDownloadStateChangedEventHandler
AddHandler(ByVal h As UserDownloadStateChangedEventHandler)
If Not UserDownloadStateChangedEventHandlers.Contains(h) Then UserDownloadStateChangedEventHandlers.Add(h)
End AddHandler
RemoveHandler(ByVal h As UserDownloadStateChangedEventHandler)
UserDownloadStateChangedEventHandlers.Remove(h)
End RemoveHandler
RaiseEvent(ByVal User As IUserData, ByVal IsDownloading As Boolean)
Try
If UserDownloadStateChangedEventHandlers.Count > 0 Then
For i% = 0 To UserDownloadStateChangedEventHandlers.Count - 1
Try : UserDownloadStateChangedEventHandlers(i).Invoke(User, IsDownloading) : Catch : End Try
Next
End If
Catch
End Try
End RaiseEvent
End Event
Private Sub OnUserDownloadStateChanged(ByVal IsDownloading As Boolean)
RaiseEvent UserDownloadStateChanged(Me, IsDownloading)
End Sub
#End Region
#Region "Collection buttons"
Private _CollectionButtonsExists As Boolean = False
Private _CollectionButtonsColorsSet As Boolean = False
Friend WithEvents BTT_CONTEXT_DOWN As ToolStripKeyMenuItem
Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_ERASE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_PATH As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_SITE As ToolStripMenuItem
Friend Sub CreateButtons()
Dim tn$ = $"[{Site}] - {Name}"
Dim _tn$ = $"{Site}{Name}"
Dim tnn As Func(Of String, String) = Function(Input) $"{Input}{_tn}"
Dim i As Image = Nothing
With HOST.Source
If Not .Icon Is Nothing Then
i = .Icon.ToBitmap
ElseIf Not .Image Is Nothing Then
i = .Image
End If
End With
BTT_CONTEXT_DOWN = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = Me}
BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = Me}
BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = Me}
BTT_CONTEXT_ERASE = New ToolStripMenuItem(tn, i) With {.Name = tnn("ERASE"), .Tag = Me}
BTT_CONTEXT_OPEN_PATH = New ToolStripMenuItem(tn, i) With {.Name = tnn("PATH"), .Tag = Me}
BTT_CONTEXT_OPEN_SITE = New ToolStripMenuItem(tn, i) With {.Name = tnn("SITE"), .Tag = Me}
UpdateButtonsColor()
_CollectionButtonsExists = True
If _UserInformationLoaded Then _CollectionButtonsColorsSet = True
End Sub
Private Sub UpdateButtonsColor()
Dim cb As Color = SystemColors.Control
Dim cf As Color = SystemColors.ControlText
If Not UserExists Then
cb = MyColor.DeleteBack
cf = MyColor.DeleteFore
ElseIf UserSuspended Then
cb = MyColor.EditBack
cf = MyColor.EditFore
End If
For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_ERASE,
BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE}
If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf
Next
If _UserInformationLoaded Then _CollectionButtonsColorsSet = True
End Sub
#End Region
#Region "XML Declarations"
Private Const Name_Site As String = UserInfo.Name_Site
Private Const Name_Plugin As String = UserInfo.Name_Plugin
Private Const Name_AccountName As String = UserInfo.Name_AccountName
Protected Const Name_IsChannel As String = "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"
Protected Const Name_FriendlyName As String = "FriendlyName"
Protected Const Name_UserSiteName As String = "UserSiteName"
Protected Const Name_UserID As String = "UserID"
Protected Const Name_Options As String = "Options"
Protected Const Name_Description As String = "Description"
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Private Const Name_IsSubscription As String = UserInfo.Name_IsSubscription
Private Const Name_Temporary As String = "Temporary"
Private Const Name_Favorite As String = "Favorite"
Private Const Name_BackColor As String = "BackColor"
Private Const Name_ForeColor As String = "ForeColor"
Private Const Name_CreatedByChannel As String = "CreatedByChannel"
Private Const Name_SeparateVideoFolder As String = "SeparateVideoFolder"
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"
Private Const Name_DownloadVideos As String = "DownloadVideos"
Private Const Name_IconBannerDownloaded As String = "IconBannerDownloaded"
Private Const Name_VideoCount As String = "VideoCount"
Private Const Name_PicturesCount As String = "PicturesCount"
Private Const Name_LastUpdated As String = "LastUpdated"
Private Const Name_ScriptUse As String = "ScriptUse"
Private Const Name_ScriptData As String = "ScriptData"
Protected Const Name_UseMD5Comparison As String = "UseMD5Comparison"
Protected Const Name_RemoveExistingDuplicates As String = "RemoveExistingDuplicates"
Protected Const Name_StartMD5Checked As String = "StartMD5Checked"
#Region "Additional names"
Protected Const Name_SiteMode As String = "SiteMode"
Protected Const Name_TrueName As String = "TrueName"
Protected Const Name_Arguments As String = "Arguments"
#End Region
#End Region
#Region "Declarations"
#Region "Host, Site, Progress"
Friend Property HostCollection As SettingsHostCollection
Private Function HostObtainCollection() As Boolean
If HostCollection Is Nothing Then
Dim k$ = If(_HOST?.Key, _HostKey)
If Not k.IsEmptyString Then HostCollection = Settings(k)
End If
Return Not HostCollection Is Nothing
End Function
Private _HOST As SettingsHost
Private _HostKey As String = String.Empty
Private _HostObtained As Boolean = False
Friend Property HOST As SettingsHost Implements IUserData.HOST
Get
If _HostObtained Or HostStatic Then
Return _HOST
ElseIf HostObtainCollection() Then
_HOST = HostCollection(AccountName)
_HostObtained = Not _HOST Is Nothing
Return _HOST
Else
Return Nothing
End If
End Get
Set(ByVal h As SettingsHost)
_HOST = h
If Not h Is Nothing Then _HostKey = h.Key
End Set
End Property
Friend Sub ResetHost()
_HostObtained = False
End Sub
Friend Property HostStatic As Boolean = False Implements IUserData.HostStatic
Private _AccountName As String = String.Empty
Friend Overridable Property AccountName As String Implements IUserData.AccountName, IPluginContentProvider.AccountName
Get
Return _AccountName.IfNullOrEmpty(User.AccountName)
End Get
Set(ByVal name As String)
If Not _AccountName = name Then ResetHost()
_AccountName = name
End Set
End Property
Friend ReadOnly Property Site As String Implements IUserData.Site
Get
Return HOST.Name
End Get
End Property
Private _Progress As MyProgress
Friend Property Progress As MyProgress
Get
Return _Progress
End Get
Set(ByVal p As MyProgress)
_Progress = p
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
ProgressPre = New PreProgress(_Progress)
End Set
End Property
Protected Property ProgressPre As PreProgress = Nothing
#End Region
#Region "User name, ID, exist, suspend, options"
Friend User As UserInfo
Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
Private _UserExists As Boolean = True
Friend Overridable Property UserExists As Boolean Implements IUserData.Exists, IPluginContentProvider.UserExists
Get
Return _UserExists
End Get
Set(ByVal _UserExists As Boolean)
If Not Me._UserExists = _UserExists Then EnvirChanged(_UserExists)
Me._UserExists = _UserExists
End Set
End Property
Private _UserSuspended As Boolean = False
Friend Overridable Property UserSuspended As Boolean Implements IUserData.Suspended, IPluginContentProvider.UserSuspended
Get
Return _UserSuspended
End Get
Set(ByVal _UserSuspended As Boolean)
If Not Me._UserSuspended = _UserSuspended Then EnvirChanged(_UserSuspended)
Me._UserSuspended = _UserSuspended
End Set
End Property
Private Property IPluginContentProvider_Name As String Implements IPluginContentProvider.Name
Get
Return Name
End Get
Set(ByVal NewName As String)
End Set
End Property
Friend Overridable ReadOnly Property Name As String Implements IUserData.Name
Get
Return User.Name
End Get
End Property
Friend Overridable Property ID As String = String.Empty Implements IUserData.ID, IPluginContentProvider.ID
Protected _FriendlyName As String = String.Empty
Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName
Get
If Settings.UserSiteNameAsFriendly Then
Return _FriendlyName.IfNullOrEmpty(UserSiteName)
Else
Return _FriendlyName
End If
End Get
Set(ByVal n As String)
_FriendlyName = n
End Set
End Property
Friend ReadOnly Property FriendlyNameOrig As String
Get
Return _FriendlyName
End Get
End Property
Friend ReadOnly Property FriendlyNameIsSiteName As Boolean
Get
If Settings.UserSiteNameAsFriendly Then
Return Not FriendlyName.IsEmptyString And Not _FriendlyName = UserSiteName And FriendlyName = UserSiteName
Else
Return False
End If
End Get
End Property
Private _UserSiteName As String = String.Empty
Friend Property UserSiteName As String
Get
Return _UserSiteName
End Get
Set(ByVal _UserSiteName As String)
If Not Me._UserSiteName = _UserSiteName Then EnvirChanged(_UserSiteName)
Me._UserSiteName = _UserSiteName
End Set
End Property
Protected Sub UserSiteNameUpdate(ByVal NewName As String)
If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UpdateUserSiteNameEveryTime) Then UserSiteName = NewName
End Sub
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
Friend Property Options As String = String.Empty Implements IUserData.Options, IPluginContentProvider.Options
Friend Overridable ReadOnly Property FeedIsUser As Boolean
Get
Return True
End Get
End Property
#End Region
#Region "Description"
Friend Property UserDescription As String = String.Empty Implements IUserData.Description, IPluginContentProvider.UserDescription
Protected _DescriptionEveryTime As Boolean = False
Protected _DescriptionChecked As Boolean = False
Protected Function UserDescriptionNeedToUpdate() As Boolean
Return (UserDescription.IsEmptyString Or _DescriptionEveryTime) And Not _DescriptionChecked
End Function
Protected Sub UserDescriptionUpdate(ByVal Descr As String)
If UserDescriptionNeedToUpdate() Then
If UserDescription.IsEmptyString Then
UserDescription = Descr
ElseIf Not UserDescription.Contains(Descr) Then
UserDescription &= $"{vbNewLine}----{vbNewLine}{Descr}"
End If
_DescriptionChecked = True
End If
End Sub
#End Region
#Region "Favorite, Temporary, Colors"
Protected _Favorite As Boolean = False
Friend Overridable Property Favorite As Boolean Implements IUserData.Favorite
Get
Return _Favorite
End Get
Set(ByVal Fav As Boolean)
_Favorite = Fav
If _Favorite Then _Temporary = False
End Set
End Property
Protected _Temporary As Boolean = False
Friend Overridable Property Temporary As Boolean Implements IUserData.Temporary
Get
Return _Temporary
End Get
Set(ByVal Temp As Boolean)
_Temporary = Temp
If _Temporary Then _Favorite = False
End Set
End Property
Private _BackColor As Color? = Nothing
Friend Overridable Property BackColor As Color? Implements IUserData.BackColor
Get
Return _BackColor
End Get
Set(ByVal b As Color?)
_BackColor = b
End Set
End Property
Private _ForeColor As Color? = Nothing
Friend Overridable Property ForeColor As Color? Implements IUserData.ForeColor
Get
Return _ForeColor
End Get
Set(ByVal f As Color?)
_ForeColor = f
End Set
End Property
#End Region
#Region "Channel"
Friend Property CreatedByChannel As Boolean = False
#End Region
#Region "Images"
Friend Overridable Function GetUserPicture() As Image Implements IUserData.GetPicture
If Settings.ViewModeIsPicture Then
Return GetPicture(Of Image)()
Else
Return Nothing
End If
End Function
Friend Function GetUserPictureToastAddress() As SFile
Return GetPicture(Of SFile)(False, True)
End Function
Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Try
If f.Exists Then
Using p As New UserImage(f, MyFile) : p.Save() : End Using
End If
Catch
End Try
End Sub
Protected Function GetNullPicture(ByVal MaxHeigh As XMLValue(Of Integer)) As Bitmap
Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value)
End Function
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
Dim DelPath As Boolean = True
BlockPictureFolder:
On Error GoTo BlockPictureScan
f = SFile.GetPath($"{MyFile.PathWithSeparator}Pictures")
If f.Exists(SFO.Path, False) Then
Dim PicList As List(Of SFile) = SFile.GetFiles(f, $"{UserImage.ImagePrefix}*.jpg")
If PicList.ListExists Then
PicList.Sort()
Dim l As SFile, s As SFile
l = PicList.Find(Function(ff) ff.Name.Contains(UserImage.ImagePostfix_Large))
If Not l.IsEmptyString Then PicList.Remove(l)
s = PicList.Find(Function(ff) ff.Name.Contains(UserImage.ImagePostfix_Small))
If Not s.IsEmptyString Then PicList.Remove(s)
If PicList.Count > 0 Then
p = New UserImage(PicList.First, l, s, MyFile)
GoTo BlockReturn
Else
f.Delete(SFO.Path, Settings.DeleteMode, EDP.None)
DelPath = False
End If
End If
End If
BlockPictureScan:
On Error GoTo BlockDeletePictureFolder
Dim NewPicFile As SFile = SFile.GetFiles(MyFile.CutPath, "*.jpg|*.jpeg|*.png",,
New ErrorsDescriber(EDP.ReturnValue) With {
.ReturnValue = New List(Of SFile),
.ReturnValueExists = True}).FirstOrDefault
If NewPicFile.Exists Then
p = New UserImage(NewPicFile, MyFile)
p.Save()
GoTo BlockReturn
End If
BlockDeletePictureFolder:
On Error GoTo BlockReturn
If DelPath Then
f = SFile.GetPath($"{MyFile.PathWithSeparator}Pictures")
If f.Exists(SFO.Path, False) Then f.Delete(SFO.Path, Settings.DeleteMode)
End If
BlockReturn:
On Error GoTo BlockNullPicture
If Not p Is Nothing Then
Dim i As Image = Nothing
Dim a As SFile = Nothing
If rsfile Then
If GetToast Then
a = p.Large.Address
Else
a = p.Address
End If
Else
Select Case Settings.ViewMode.Value
Case View.LargeIcon : i = p.Large.OriginalImage.Clone
Case View.SmallIcon : i = p.Small.OriginalImage.Clone
End Select
End If
p.Dispose()
If rsfile Then Return CObj(a) Else Return CObj(i)
End If
BlockNullPicture:
If ReturnNullImageOnNothing Then
Select Case Settings.ViewMode.Value
Case View.LargeIcon : Return CObj(GetNullPicture(Settings.MaxLargeImageHeight))
Case View.SmallIcon : Return CObj(GetNullPicture(Settings.MaxSmallImageHeight))
End Select
End If
Return Nothing
End Function
#End Region
#Region "Separate folder"
Friend Property SeparateVideoFolder As Boolean?
Protected ReadOnly Property SeparateVideoFolderF As Boolean
Get
Return If(SeparateVideoFolder, Settings.SeparateVideoFolder.Value)
End Get
End Property
#End Region
#Region "Collections"
Protected _IsCollection As Boolean = False
Protected Friend ReadOnly Property IsCollection As Boolean Implements IUserData.IsCollection
Get
Return _IsCollection
End Get
End Property
Friend Overridable ReadOnly Property CollectionName As String Implements IUserData.CollectionName
Get
Return User.CollectionName
End Get
End Property
Friend Overridable ReadOnly Property CollectionPath As SFile Implements IUserData.CollectionPath
Get
Return User.GetCollectionRootPath
End Get
End Property
Friend ReadOnly Property IncludedInCollection As Boolean Implements IUserData.IncludedInCollection
Get
Return User.IncludedInCollection
End Get
End Property
Friend Overridable ReadOnly Property Labels As List(Of String) Implements IUserData.Labels
Protected ReadOnly Property LabelsString As String
Get
Return Labels.ListToString("|", EDP.ReturnValue)
End Get
End Property
Friend Overridable ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return New String() {}
End Get
End Property
''' <summary>
''' 0 add<br/>
''' 1 replace<br/>
''' 2 remove
''' </summary>
''' <returns>true = w/special</returns>
Friend Shared Function UpdateLabelsKeepSpecial(ByVal Mode As Byte) As Boolean
Dim m As New MMessage("", "Update labels",, vbQuestion + vbYesNo) With {.DefaultButton = 0, .CancelButton = 0}
Select Case Mode
Case 0 : m.Text = "Do you want to exclude site-specific labels from adding?"
Case 1, 2 : m.Text = "Do you want to keep site-specific labels?"
Case Else : Return False
End Select
Return m.Show = vbYes
End Function
''' <inheritdoc cref="UpdateLabelsKeepSpecial(Byte)"/>
Friend Shared Sub UpdateLabels(ByVal User As UserDataBase, ByVal NewLabels As IEnumerable(Of String), ByVal Mode As Byte, ByVal KeepSpecial As Boolean)
Try
If User.IsCollection Then
With DirectCast(User, UserDataBind)
If .Count > 0 Then .Collections.ForEach(Sub(u) UpdateLabels(u, NewLabels, Mode, KeepSpecial))
End With
Else
Dim nl As List(Of String)
If NewLabels.ListExists Then nl = NewLabels.ToList Else nl = New List(Of String)
Dim lex As List(Of String) = User.SpecialLabels.ToList
If lex.ListExists Then
If User.Labels.Count = 0 Or Not KeepSpecial Then
lex.Clear()
Else
lex.ListDisposeRemove(Function(l) Not User.Labels.Contains(l))
End If
End If
Select Case Mode
Case 0 'add
If KeepSpecial Then nl.ListAddList(lex, LNC)
User.Labels.ListAddList(nl, LNC)
Case 1 'replace
If KeepSpecial Then
nl.ListAddList(lex, LNC)
Else
nl.ListWithRemove(lex)
End If
User.Labels.Clear()
User.Labels.ListAddList(nl, LNC)
Case 2 'remove
If KeepSpecial Then nl.ListWithRemove(lex)
User.Labels.ListWithRemove(nl)
End Select
If User.Labels.Count > 0 Then User.Labels.Sort()
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[UserDataBase.UpdateLabels]")
End Try
End Sub
#End Region
#Region "Downloading"
Protected _DataLoaded As Boolean = False
Protected _DataParsed As Boolean = False
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly, IPluginContentProvider.ParseUserMediaOnly
Friend Overridable ReadOnly Property IsSubscription As Boolean Implements IUserData.IsSubscription
Get
Return User.IsSubscription
End Get
End Property
Friend Overridable ReadOnly Property IsUser As Boolean Implements IUserData.IsUser
Get
Return True
End Get
End Property
Private Property IPluginContentProvider_IsSubscription As Boolean Implements IPluginContentProvider.IsSubscription
Get
Return IsSubscription
End Get
Set : End Set
End Property
Friend Overridable Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
Friend Property DownloadImages As Boolean = True Implements IUserData.DownloadImages
Friend Property DownloadVideos As Boolean = True Implements IUserData.DownloadVideos
Friend Property DownloadMissingOnly As Boolean = False Implements IUserData.DownloadMissingOnly
Private _IconBannerDownloaded As Boolean = False
Friend WriteOnly Property IconBannerDownloaded As Boolean
Set(ByVal IsDownloaded As Boolean)
If Not _IconBannerDownloaded = IsDownloaded Then _ForceSaveUserInfo = True
_IconBannerDownloaded = IsDownloaded
End Set
End Property
Friend ReadOnly Property DownloadIconBanner As Boolean
Get
Return Not _IconBannerDownloaded Or Settings.UpdateUserIconBannerEveryTime
End Get
End Property
#End Region
#Region "Content"
Protected ReadOnly _ContentList As List(Of UserMedia)
Protected ReadOnly _ContentNew As List(Of UserMedia)
Friend ReadOnly Property LatestData As List(Of UserMedia)
Protected ReadOnly MissingFinder As Predicate(Of UserMedia) = Function(c) c.State = UStates.Missing
Friend ReadOnly Property ContentMissing As List(Of UserMedia)
Get
If _ContentList.Count > 0 Then
Return _ContentList.Where(Function(c) MissingFinder(c)).ListIfNothing
Else
Return New List(Of UserMedia)
End If
End Get
End Property
Friend Overridable ReadOnly Property ContentMissingExists As Boolean
Get
Return _ContentList.Exists(MissingFinder)
End Get
End Property
Friend Sub RemoveMedia(ByVal m As UserMedia, ByVal State As UStates?)
Dim i% = If(State.HasValue, _ContentList.FindIndex(Function(mm) mm.State = State.Value And mm.Equals(m)), _ContentList.IndexOf(m))
If i >= 0 Then _ContentList.RemoveAt(i)
End Sub
Protected ReadOnly _TempMediaList As List(Of UserMedia)
Protected ReadOnly _TempPostsList As List(Of String)
Friend Function GetLastImageAddress() As SFile
If _ContentList.Count > 0 Then
Return _ContentList.LastOrDefault(Function(c) c.Type = UTypes.Picture And Not c.File.IsEmptyString And Not c.File.Extension = "gif").File
Else
Return Nothing
End If
End Function
#End Region
#Region "Files"
Friend Overridable Property MyFile As SFile Implements IUserData.File
Get
If IsSavedPosts Then
Return MyFileSettings
Else
Return User.File
End If
End Get
Set(ByVal f As SFile)
User.File = f
Settings.UpdateUsersList(User)
End Set
End Property
Protected MyFileSettings As SFile
Protected MyFileData As SFile
Protected MyFilePosts As SFile
Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists
Friend Overridable Property DataMerging As Boolean
Get
Return User.Merged
End Get
Set(ByVal IsMerged As Boolean)
If Not User.Merged = IsMerged Then
User.Merged = IsMerged
User.UpdateUserFile()
Settings.UpdateUsersList(User)
End If
End Set
End Property
#End Region
#Region "Information, counters, error, update date"
Friend Overridable Property LastUpdated As Date?
Friend Overridable Property HasError As Boolean = False Implements IUserData.HasError
Private _DownloadedPicturesTotal As Integer = 0
Private _DownloadedPicturesSession As Integer = 0
Friend Property DownloadedPictures(ByVal Total As Boolean) As Integer Implements IUserData.DownloadedPictures
Get
Return IIf(Total, _DownloadedPicturesTotal, _DownloadedPicturesSession)
End Get
Set(ByVal NewValue As Integer)
If Total Then
_DownloadedPicturesTotal = NewValue
Else
_DownloadedPicturesSession = NewValue
End If
End Set
End Property
Private _DownloadedVideosTotal As Integer = 0
Private _DownloadedVideosSession As Integer = 0
Friend Property DownloadedVideos(ByVal Total As Boolean) As Integer Implements IUserData.DownloadedVideos
Get
Return IIf(Total, _DownloadedVideosTotal, _DownloadedVideosSession)
End Get
Set(ByVal NewValue As Integer)
If Total Then
_DownloadedVideosTotal = NewValue
Else
_DownloadedVideosSession = NewValue
End If
End Set
End Property
Friend Overridable ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer Implements IUserData.DownloadedTotal
Get
Return DownloadedPictures(Total) + DownloadedVideos(Total)
End Get
End Property
Friend ReadOnly Property DownloadedInformation As String Implements IUserData.DownloadedInformation
Get
Dim luv$ = String.Empty
If LastUpdated.HasValue Then luv = $"{LastUpdated.Value.ToStringDate(ADateTime.Formats.BaseDateTime)}: "
Return $"{luv}{Name} [{Site}]{IIf(HasError, " (with errors)", String.Empty)}: P - {DownloadedPictures(False)}; V - {DownloadedVideos(False)}" &
$" (P - {DownloadedPictures(True)}; V - {DownloadedVideos(True)})"
End Get
End Property
Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name} (site: {Site}"
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}")
OutStr.StringAppendLine($"Total downloaded ({DownloadedTotal(True).NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {DownloadedPictures(True).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(True).NumToString(ANumbers.Formats.Number, 3)}")
If Not UserDescription.IsEmptyString Then
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine(UserDescription)
End If
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine($"Last updated at: {AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, "not yet")}")
If _DataParsed Then
OutStr.StringAppendLine("Downloaded now:")
OutStr.StringAppendLine($"Pictures: {DownloadedTotal(False).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(False).NumToString(ANumbers.Formats.Number, 3)}")
End If
Return OutStr
End Function
#End Region
#Region "Script"
Friend Overridable Property ScriptUse As Boolean = False Implements IUserData.ScriptUse
Friend Overridable Property ScriptData As String Implements IUserData.ScriptData
#End Region
#End Region
#Region "Plugins Support"
Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged
Protected Event ProgressMaximumChanged As IPluginContentProvider.ProgressMaximumChangedEventHandler Implements IPluginContentProvider.ProgressMaximumChanged
Protected Event ProgressPreChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressPreChanged
Protected Event ProgressPreMaximumChanged As IPluginContentProvider.ProgressMaximumChangedEventHandler Implements IPluginContentProvider.ProgressPreMaximumChanged
Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings
Get
Return HOST.Source
End Get
Set(ByVal s As ISiteSettings)
End Set
End Property
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 IUserMedia) Implements IPluginContentProvider.ExistingContentList
Private Property IPluginContentProvider_TempPostsList As List(Of String) Implements IPluginContentProvider.TempPostsList
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
End Sub
Private Function IPluginContentProvider_XmlFieldsGet() As List(Of KeyValuePair(Of String, String)) Implements IPluginContentProvider.XmlFieldsGet
Return Nothing
End Function
Private Sub IPluginContentProvider_GetMedia(ByVal Token As CancellationToken) Implements IPluginContentProvider.GetMedia
End Sub
Private Sub IPluginContentProvider_Download(ByVal Token As CancellationToken) Implements IPluginContentProvider.Download
End Sub
Private Sub IPluginContentProvider_DownloadSingleObject(ByVal Data As IDownloadableMedia, ByVal Token As CancellationToken) Implements IPluginContentProvider.DownloadSingleObject
End Sub
Friend Overridable Function ExchangeOptionsGet() As Object Implements IPluginContentProvider.ExchangeOptionsGet
Return Nothing
End Function
Friend Overridable Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet
End Sub
#End Region
#Region "IIndexable Support"
Friend Property Index As Integer = 0 Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex
DirectCast(Obj, UserDataBase).Index = Index
Return Obj
End Function
#End Region
#Region "LVI"
Friend ReadOnly Property LVIKey As String Implements IUserData.Key
Get
If Not _IsCollection Then
Return $"{IIf(IsSubscription, "SSSS", String.Empty)}{Site.ToString.ToUpper}_{Name}"
Else
Return $"CCCC_{CollectionName}"
End If
End Get
End Property
Friend Function GetLVI(ByVal Destination As ListView) As ListViewItem Implements IUserData.GetLVI
If Settings.ViewModeIsPicture Then
Return ListImagesLoader.ApplyLVIColor(Me, New ListViewItem(ToString(), LVIKey, GetLVIGroup(Destination)) With {.Name = LVIKey, .Tag = LVIKey}, True)
Else
Return ListImagesLoader.ApplyLVIColor(Me, New ListViewItem(ToString(), GetLVIGroup(Destination)) With {.Name = LVIKey, .Tag = LVIKey}, True)
End If
End Function
Friend Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Implements IUserData.GetLVIGroup
Try
With Settings
If Not .ShowAllUsers.Value AndAlso (.AdvancedFilter.Labels.Count > 0 Or .AdvancedFilter.LabelsNo) AndAlso Not .ShowGroupsInsteadLabels Then
If Labels.Count > 0 And .AdvancedFilter.Labels.Count > 0 Then
For i% = 0 To Labels.Count - 1
If .AdvancedFilter.Labels.Contains(Labels(i)) Then Return Destination.Groups.Item(Labels(i))
Next
End If
ElseIf Settings.GroupUsers Then
Return Destination.Groups.Item(GetLviGroupName(HOST, Temporary, Favorite, IsCollection))
End If
End With
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
Catch ex As Exception
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
End Try
End Function
#End Region
#Region "Initializer"
''' <summary>By using this constructor you must set UserName and MyFile manually</summary>
Friend Sub New(Optional ByVal InvokeImageHandler As Boolean = True)
_ContentList = New List(Of UserMedia)
_ContentNew = New List(Of UserMedia)
LatestData = New List(Of UserMedia)
_TempMediaList = New List(Of UserMedia)
_TempPostsList = New List(Of String)
Labels = New List(Of String)
UserUpdatedEventHandlers = New List(Of IUserData.UserUpdatedEventHandler)
UserDownloadStateChangedEventHandlers = New List(Of UserDownloadStateChangedEventHandler)
If InvokeImageHandler Then MainFrameObj.ImageHandler(Me)
End Sub
Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment
HOST = h
HostObtainCollection()
If AttachUserInfo Then
User = u
If _LoadUserInformation Then LoadUserInformation()
End If
End Sub
''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
If Not u.Plugin.IsEmptyString Then
Return Settings(u.Plugin).Default.GetInstance(ISiteSettings.Download.Main, u, _LoadUserInformation)
Else
Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader")
End If
End Function
Friend Shared Function GetPostUrl(ByVal u As IUserData, ByVal PostData As UserMedia) As String
Dim uName$ = String.Empty
Try
If Not u Is Nothing AndAlso Not u.IsCollection Then
With DirectCast(u, UserDataBase)
If Not .User.Plugin.IsEmptyString Then
uName = .User.Name
Return Settings(.User.Plugin).Default.GetUserPostUrl(.Self, PostData)
End If
End With
End If
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, $"GetPostUrl({uName}, {PostData.Post.ID})", String.Empty)
End Try
End Function
#End Region
#Region "Information & Content data files loader and saver"
#Region "User information"
Private _UserInformationLoaded As Boolean = False
Friend Overridable Sub LoadUserInformation() Implements IUserData.LoadUserInformation
Try
UpdateDataFiles()
If MyFileSettings.Exists Then
FileExists = True
Using x As New XmlFile(MyFileSettings) With {.XmlReadOnly = True}
If User.Name.IsEmptyString Then User.Name = x.Value(Name_UserName)
UserExists = x.Value(Name_UserExists).FromXML(Of Boolean)(True)
UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False)
ID = x.Value(Name_UserID)
Options = x.Value(Name_Options)
_FriendlyName = x.Value(Name_FriendlyName)
UserSiteName = x.Value(Name_UserSiteName)
UserDescription = x.Value(Name_Description)
ParseUserMediaOnly = x.Value(Name_ParseUserMediaOnly).FromXML(Of Boolean)(False)
Temporary = x.Value(Name_Temporary).FromXML(Of Boolean)(False)
Favorite = x.Value(Name_Favorite).FromXML(Of Boolean)(False)
If Not x.Value(Name_BackColor).IsEmptyString Then
BackColor = AConvert(Of Color)(x.Value(Name_BackColor), Nothing, EDP.ReturnValue)
Else
BackColor = Nothing
End If
If Not x.Value(Name_ForeColor).IsEmptyString Then
ForeColor = AConvert(Of Color)(x.Value(Name_ForeColor), Nothing, EDP.ReturnValue)
Else
ForeColor = Nothing
End If
CreatedByChannel = x.Value(Name_CreatedByChannel).FromXML(Of Boolean)(False)
SeparateVideoFolder = AConvert(Of Boolean)(x.Value(Name_SeparateVideoFolder), AModes.Var, Nothing)
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
DownloadImages = x.Value(Name_DownloadImages).FromXML(Of Boolean)(True)
DownloadVideos = x.Value(Name_DownloadVideos).FromXML(Of Boolean)(True)
_IconBannerDownloaded = x.Value(Name_IconBannerDownloaded).FromXML(Of Boolean)(False)
DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
DownloadedPictures(True) = x.Value(Name_PicturesCount).FromXML(Of Integer)(0)
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_Merged).FromXML(Of Boolean)(False)
Labels.ListAddList(x.Value(Name_LabelsName).StringToList(Of String, List(Of String))("|", EDP.ReturnValue), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
LoadUserInformation_OptionalFields(x, True)
End Using
UpdateDataFiles()
_UserInformationLoaded = True
If _CollectionButtonsExists And Not _CollectionButtonsColorsSet And (Not UserExists Or UserSuspended) Then UpdateButtonsColor()
End If
Catch ex As Exception
LogError(ex, "user information loading error")
End Try
End Sub
Friend Overridable Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
Try
UpdateDataFiles()
MyFileSettings.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_AccountName, AccountName)
x.Add(Name_UserName, User.Name)
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)
x.Add(Name_Options, Options)
x.Add(Name_FriendlyName, _FriendlyName)
x.Add(Name_UserSiteName, UserSiteName)
x.Add(Name_Description, UserDescription)
x.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
x.Add(Name_IsSubscription, IsSubscription.BoolToInteger)
x.Add(Name_Temporary, Temporary.BoolToInteger)
x.Add(Name_Favorite, Favorite.BoolToInteger)
x.Add(Name_BackColor, CStr(AConvert(Of String)(BackColor, String.Empty, EDP.ReturnValue)))
x.Add(Name_ForeColor, CStr(AConvert(Of String)(ForeColor, String.Empty, EDP.ReturnValue)))
x.Add(Name_CreatedByChannel, CreatedByChannel.BoolToInteger)
If SeparateVideoFolder.HasValue Then
x.Add(Name_SeparateVideoFolder, SeparateVideoFolder.Value.BoolToInteger)
Else
x.Add(Name_SeparateVideoFolder, String.Empty)
End If
x.Add(Name_ReadyForDownload, ReadyForDownload.BoolToInteger)
x.Add(Name_DownloadImages, DownloadImages.BoolToInteger)
x.Add(Name_DownloadVideos, DownloadVideos.BoolToInteger)
x.Add(Name_IconBannerDownloaded, _IconBannerDownloaded.BoolToInteger)
x.Add(Name_VideoCount, DownloadedVideos(True))
x.Add(Name_PicturesCount, DownloadedPictures(True))
x.Add(Name_LastUpdated, AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, String.Empty))
x.Add(Name_ScriptUse, ScriptUse.BoolToInteger)
x.Add(Name_ScriptData, ScriptData)
x.Add(Name_CollectionName, CollectionName)
x.Add(Name_LabelsName, LabelsString)
x.Add(Name_Merged, DataMerging.BoolToInteger)
LoadUserInformation_OptionalFields(x, False)
x.Save(MyFileSettings)
End Using
If Not IsSavedPosts Then Settings.UpdateUsersList(User, True)
Catch ex As Exception
LogError(ex, "user information saving error")
End Try
End Sub
''' <param name="Loading"><see langword="True"/>: Loading; <see langword="False"/>: Saving</param>
Protected MustOverride Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
#End Region
#Region "User data"
Friend Overridable Overloads Sub LoadContentInformation(Optional ByVal Force As Boolean = False)
Try
UpdateDataFiles()
If Not MyFileData.Exists Or (_DataLoaded And Not Force) Then Exit Sub
Using x As New XmlFile(MyFileData, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData()
If x.Count > 0 Then
For Each v As EContainer In x : _ContentList.Add(New UserMedia(v, Me)) : Next
End If
_DataLoaded = True
End Using
Catch ex As Exception
LogError(ex, "history loading error")
End Try
End Sub
Friend Sub UpdateContentInformation()
Try
UpdateDataFiles()
If MyFileData.IsEmptyString Then Exit Sub
MyFileData.Exists(SFO.Path)
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Data"}
If _ContentList.Count > 0 Then x.AddRange(_ContentList)
x.Save(MyFileData)
End Using
Catch ex As Exception
LogError(ex, "history saving error")
End Try
End Sub
#End Region
#End Region
#Region "Open site, folder"
Friend Overridable Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Implements IUserData.OpenSite
Try
Dim URL$ = HOST.Source.GetUserUrl(Me)
If Not URL.IsEmptyString Then Process.Start(URL)
Catch ex As Exception
If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowAllMsg)
MsgBoxE({$"Error when trying to open [{Site}] page of user [{Name}]", $"User [{ToString()}]"}, MsgBoxStyle.Critical, e, ex)
End Try
End Sub
Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder
If MyFile.IsEmptyString And IsSavedPosts Then UpdateDataFiles()
GlobalOpenPath(MyFile.CutPath)
End Sub
#End Region
#Region "Download limits"
Protected Enum DateResult : [Continue] : [Skip] : [Exit] : End Enum
Friend Overridable Property DownloadTopCount As Integer? = Nothing Implements IUserData.DownloadTopCount, IPluginContentProvider.PostsNumberLimit
Friend Overridable Property IncludeInTheFeed As Boolean = True
Private _DownloadDateFrom As Date? = Nothing
Private _DownloadDateFromF As Date
Friend Overridable Property DownloadDateFrom As Date? Implements IUserData.DownloadDateFrom, IPluginContentProvider.DownloadDateFrom
Get
Return _DownloadDateFrom
End Get
Set(ByVal d As Date?)
_DownloadDateFrom = d
If _DownloadDateFrom.HasValue Then _DownloadDateFromF = _DownloadDateFrom.Value.Date Else _DownloadDateFromF = Date.MinValue.Date
End Set
End Property
Private _DownloadDateTo As Date? = Nothing
Private _DownloadDateToF As Date
Friend Overridable Property DownloadDateTo As Date? Implements IUserData.DownloadDateTo, IPluginContentProvider.DownloadDateTo
Get
Return _DownloadDateTo
End Get
Set(ByVal d As Date?)
_DownloadDateTo = d
If _DownloadDateTo.HasValue Then _DownloadDateToF = _DownloadDateTo.Value Else _DownloadDateToF = Date.MaxValue.Date
End Set
End Property
Protected Function CheckDatesLimit(ByVal DateObj As Object, ByVal DateProvider As IFormatProvider) As DateResult
Try
If (DownloadDateFrom.HasValue Or DownloadDateTo.HasValue) AndAlso ACheck(DateObj) Then
Dim td As Date? = AConvert(DateObj, AModes.Var, GetType(Date),, True, Nothing, DateProvider)
If td.HasValue Then
If td.Value.ValueBetween(_DownloadDateFromF, _DownloadDateToF) Then
Return DateResult.Continue
ElseIf td.Value > _DownloadDateToF Then
Return DateResult.Skip
Else
Return DateResult.Exit
End If
End If
End If
Return DateResult.Continue
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[UserDataBase.CheckDatesLimit({If(TypeOf DateObj Is String, CStr(DateObj), "?")})]", DateResult.Continue)
End Try
End Function
#End Region
#Region "Download functions and options"
Private __DOWNLOAD_IN_PROGRESS As Boolean = False
Friend ReadOnly Property DownloadInProgress As Boolean
Get
Return __DOWNLOAD_IN_PROGRESS
End Get
End Property
Private TokenQueue As CancellationToken
Friend TokenPersonal As CancellationToken
Protected Responser As Responser
Protected UseResponserClient As Boolean = False
Protected UseClientTokens As Boolean = False
Protected _ForceSaveUserData As Boolean = False
Protected _ForceSaveUserInfo As Boolean = False
Private _DownloadInProgress As Boolean = False
Private _EnvirUserExists As Boolean
Private _EnvirUserSuspended As Boolean
Private _EnvirCreatedByChannel As Boolean
Private _EnvirChanged As Boolean = False
Private _PictureExists As Boolean
Private _EnvirInvokeUserUpdated As Boolean = False
Protected _ResponserAutoUpdateCookies As Boolean = False
Protected _ResponserAddResponseReceivedHandler As Boolean = False
Protected Sub EnvirDownloadSet()
TokenPersonal = Nothing
ProgressPre.Reset()
UpdateDataFiles()
_DownloadInProgress = True
_DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
_ForceSaveUserData = False
_ForceSaveUserInfo = False
_EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended
_EnvirCreatedByChannel = CreatedByChannel
_EnvirChanged = False
_EnvirInvokeUserUpdated = False
UserExists = True
UserSuspended = False
DownloadedPictures(False) = 0
DownloadedVideos(False) = 0
_PictureExists = Settings.ViewModeIsPicture AndAlso Not GetPicture(Of Image)(False) Is Nothing
End Sub
Private Sub EnvirChanged(ByVal NewValue As Object, <CallerMemberName> Optional ByVal Caller As String = Nothing)
If _DownloadInProgress Then
Select Case Caller
Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case Else : _EnvirChanged = True
End Select
End If
End Sub
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IUserData.DownloadData
ResetHost()
__DOWNLOAD_IN_PROGRESS = True
OnUserDownloadStateChanged(True)
Dim Canceled As Boolean = False
TokenQueue = Token
Try
If HOST Is Nothing Then Throw New ExitException($"Host '{AccountName}' not found")
EnvirDownloadSet()
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Responser
If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
If Not Responser Is Nothing And (_ResponserAutoUpdateCookies Or _ResponserAddResponseReceivedHandler) Then
If _ResponserAutoUpdateCookies Then
Responser.CookiesUpdateMode = CookieUpdateModes.ReplaceByNameAll
Responser.CookiesExtractMode = Responser.CookiesExtractModes.Any
Responser.CookiesExtractedAutoSave = False
End If
If _ResponserAddResponseReceivedHandler Then AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
End If
Responser.DecodersError = New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue) With {
.DeclaredMessage = New MMessage($"SymbolsConverter error: [{ToStringForLog()}]", ToStringForLog())}
Dim _downContent As Func(Of UserMedia, Boolean) = Function(c) c.State = UStates.Downloaded
_TempMediaList.Clear()
_TempPostsList.Clear()
LatestData.Clear()
Dim __isChannelsSupport As Boolean = CreatedByChannel And Settings.FromChannelDownloadTopUse
LoadContentInformation()
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
If Not DownloadMissingOnly Or IsSubscription Then
ThrowAny(Token)
DownloadDataF(Token)
ProgressPre.Done()
ThrowAny(Token)
If Settings.ReparseMissingInTheRoutine Then ReparseMissing(Token) : ProgressPre.Done() : ThrowAny(Token)
Else
ReparseMissing(Token)
ProgressPre.Done()
End If
If _TempMediaList.Count > 0 Then
If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.GIF Or m.Type = UTypes.Picture)
If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.Video Or
m.Type = UTypes.VideoPre Or m.Type = UTypes.m3u8)
If DownloadMissingOnly Then _TempMediaList.RemoveAll(Function(m) Not m.State = UStates.Missing)
End If
ReparseVideo(Token)
ProgressPre.Done()
ThrowAny(Token)
If UseMD5Comparison And Not IsSubscription Then ValidateMD5(Token) : ProgressPre.Done() : ThrowAny(Token)
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And Not __isChannelsSupport Then
If _TempPostsList.Count > 1000 Then _TempPostsList.ListAddList(_TempPostsList.ListTake(-2, 1000, EDP.ReturnValue).ListReverse, LAP.ClearBeforeAdd)
TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None)
End If
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
If IsSubscription Then
_ContentNew.ListAddList(_ContentNew.ListForEachCopy(Function(ByVal tmpC As UserMedia, ByVal ii As Integer) As UserMedia
tmpC.State = UStates.Downloaded
If tmpC.Type = UTypes.Picture Or tmpC.Type = UTypes.GIF Then
DownloadedPictures(False) += 1
Else
DownloadedVideos(False) += 1
End If
Return tmpC
End Function))
Else
DownloadContent(Token)
ThrowIfDisposed()
End If
CreatedByChannel = False
If IncludeInTheFeed Or IsSubscription Then LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
Dim mcb& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
_ContentList.ListAddList(_ContentNew.Where(Function(c) _downContent(c) Or MissingFinder(c)), LNC)
Dim mca& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
If DownloadedTotal(False) > 0 Or _EnvirChanged Or Not mcb = mca Or _ForceSaveUserData Then
If Not __isChannelsSupport Then
If DownloadedTotal(False) > 0 Then
LastUpdated = Now
RunScript()
End If
DownloadedPictures(True) = SFile.GetFiles(MyFile.CutPath, "*.jpg|*.jpeg|*.png|*.gif|*.webm",, EDP.ReturnValue).Count
DownloadedVideos(True) = SFile.GetFiles(MyFile.CutPath, "*.mp4|*.mkv|*.mov", SearchOption.AllDirectories, EDP.ReturnValue).Count
If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser)
UpdateContentInformation()
Else
DownloadedVideos(False) = 0
DownloadedPictures(False) = 0
_ContentList.Clear()
CreatedByChannel = False
End If
UpdateUserInformation()
If _CollectionButtonsExists AndAlso _EnvirChanged Then UpdateButtonsColor()
ElseIf _ForceSaveUserInfo Or __isChannelsSupport Or Not _EnvirCreatedByChannel = CreatedByChannel Then
UpdateUserInformation()
End If
ThrowIfDisposed()
If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested
MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True
Catch exit_ex As ExitException
If Not exit_ex.Silent Then
If exit_ex.SimpleLogLine Then
MyMainLOG = $"{ToStringForLog()}: downloading interrupted (exit) ({exit_ex.Message})"
Else
ErrorsDescriber.Execute(EDP.SendToLog, exit_ex, $"{ToStringForLog()}: downloading interrupted (exit)")
End If
End If
Canceled = True
Catch dex As ObjectDisposedException When Disposed
Canceled = True
Catch ex As Exception
LogError(ex, "downloading data error")
HasError = True
Finally
If Not UserExists Then AddNonExistingUserToLog($"User '{ToStringForLog()}' not found on the site")
If Not Responser Is Nothing Then Responser.Dispose() : Responser = Nothing
If Not Canceled Then _DataParsed = True
TokenPersonal = Nothing
_ContentNew.Clear()
_DownloadInProgress = False
DownloadTopCount = Nothing
DownloadDateFrom = Nothing
DownloadDateTo = Nothing
DownloadMissingOnly = False
_ForceSaveUserData = False
_ForceSaveUserInfo = False
ProgressPre.Done()
__DOWNLOAD_IN_PROGRESS = False
OnUserDownloadStateChanged(False)
If _ResponserAddResponseReceivedHandler Then Responser_ResponseReceived_RemoveHandler()
End Try
End Sub
Protected Sub UpdateDataFiles()
If Not User.File.IsEmptyString OrElse IsSavedPosts Then
MyFileSettings = Nothing
If IsSavedPosts Then
User = New UserInfo(SettingsHost.SavedPostsFolderName, HOST)
User.File.Path = $"{HOST.SavedPostsPath.PathWithSeparator}{SettingsFolderName}"
MyFileSettings = User.File
MyFileSettings.Name = MyFileSettings.Name.Replace(SettingsHost.SavedPostsFolderName, "SavedPosts")
End If
If MyFileSettings.IsEmptyString Then MyFileSettings = User.File
MyFileData = MyFileSettings
MyFileData.Name &= "_Data"
MyFilePosts = MyFileSettings
MyFilePosts.Name &= "_Posts"
MyFilePosts.Extension = "txt"
Else
Throw New ArgumentNullException("User.File", "User file not detected")
End If
End Sub
Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken)
Protected Overridable Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
End Sub
Protected Sub Responser_ResponseReceived_RemoveHandler()
If Not Responser Is Nothing And _ResponserAddResponseReceivedHandler And Not Disposed Then
Try : RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived : Catch : End Try
End If
End Sub
Protected Function CreateCache() As CacheKeeper
Dim Cache As New CacheKeeper($"{DownloadContentDefault_GetRootDir()}\_tCache\")
Cache.CacheDeleteError = CacheDeletionError(Cache)
If Cache.RootDirectory.Exists(SFO.Path, False) Then Cache.RootDirectory.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.ReturnValue)
Cache.Validate()
Return Cache
End Function
#Region "DownloadSingleObject"
Protected IsSingleObjectDownload As Boolean = False
Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject
Dim URL$ = String.Empty
Try
ResetHost()
URL = Data.URL
AccountName = Data.AccountName
TokenQueue = Token
If HOST Is Nothing Then Throw New ExitException($"Host '{AccountName}' not found")
Data.DownloadState = UserMediaStates.Tried
Progress = Data.Progress
If Not Progress Is Nothing Then Progress.ResetProgressOnMaximumChanges = False
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Responser
If Not HOST Is Nothing AndAlso HOST.Available(ISiteSettings.Download.SingleObject, True) AndAlso
Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
SeparateVideoFolder = False
IsSingleObjectDownload = True
DownloadSingleObject_GetPosts(Data, Token)
DownloadSingleObject_CreateMedia(Data, Token)
DownloadSingleObject_Download(Data, Token)
DownloadSingleObject_PostProcessing(Data)
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Data.DownloadState = UserMediaStates.Missing
ErrorsDescriber.Execute(EDP.SendToLog, oex, $"{Site} download canceled: {URL}")
Catch dex As ObjectDisposedException When Disposed
Catch exit_ex As ExitException
If Not exit_ex.Silent Then
If exit_ex.SimpleLogLine Then
MyMainLOG = $"{URL}: downloading canceled (exit) ({exit_ex.Message})"
Else
ErrorsDescriber.Execute(EDP.SendToLog, exit_ex, $"{URL}: downloading canceled (exit)")
End If
End If
Catch ex As Exception
Data.DownloadState = UserMediaStates.Missing
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{Site} single data downloader error: {URL}")
End Try
End Sub
Protected Overridable Sub DownloadSingleObject_CreateMedia(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
If _TempMediaList.Count > 0 Then
For Each m As UserMedia In _TempMediaList
m.File = DownloadSingleObject_CreateFile(Data, m.File)
_ContentNew.Add(m)
Next
End If
End Sub
Protected Overridable Sub DownloadSingleObject_PostProcessing(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, Optional ByVal ResetTitle As Boolean = True)
If _ContentNew.Count > 0 Then
If _ContentNew.Any(Function(mm) mm.State = UStates.Downloaded) Then
Data.DownloadState = UserMediaStates.Downloaded
Dim thumbAlong As Boolean = False
If TypeOf Data Is DownloadableMediaHost Then thumbAlong = DirectCast(Data, DownloadableMediaHost).ThumbAlong
If _ContentNew(0).Type = UTypes.Picture Or _ContentNew(0).Type = UTypes.GIF Then
DirectCast(Data, IDownloadableMedia).ThumbnailFile = _ContentNew(0).File
ElseIf Settings.STDownloader_TakeSnapshot And Settings.FfmpegFile.Exists And Not Settings.STDownloader_RemoveDownloadedAutomatically Then
Dim f As SFile = _ContentNew(0).File
Dim ff As SFile
If Settings.STDownloader_SnapshotsKeepWithFiles Or thumbAlong Then
ff = f
Else
ff = Settings.CacheSnapshots(Settings.STDownloader_SnapShotsCachePermamnent).NewFile
End If
ff.Name &= "_thumb"
ff.Extension = "jpg"
f = Web.FFMPEG.TakeSnapshot(f, ff, Settings.FfmpegFile, TimeSpan.FromSeconds(1),,, EDP.SendToLog + EDP.ReturnValue)
If f.Exists Then DirectCast(Data, IDownloadableMedia).ThumbnailFile = f
End If
Dim filesSize# = (From mm As UserMedia In _ContentNew Where mm.State = UStates.Downloaded AndAlso mm.File.Exists Select mm.File.Size).Sum
If filesSize > 0 Then filesSize /= 1024
Data.Size = filesSize
Else
Data.DownloadState = UserMediaStates.Missing
End If
YouTube.Objects.YouTubeMediaContainerBase.Update(_ContentNew(0), Data)
If ResetTitle And Not _ContentNew(0).File.Name.IsEmptyString Then Data.Title = _ContentNew(0).File.Name
Else
Data.DownloadState = UserMediaStates.Missing
End If
End Sub
Protected Function DownloadSingleObject_CreateFile(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal DFile As SFile) As SFile
If Not Data.File.Path.IsEmptyString Then DFile.Path = Data.File.Path
If DFile.Name.IsEmptyString Then DFile.Name = "OutputFile"
Return DFile
End Function
Protected Overridable Sub DownloadSingleObject_Download(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
DownloadContent(Token)
End Sub
Protected Overridable Sub DownloadSingleObject_GetPosts(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
End Sub
#End Region
#Region "ReparseVideo, ReparseMissing"
Protected Overridable Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
''' <summary>
''' Missing posts must be collected from [<see cref="_ContentList"/>].<br/>
''' Reparsed post must be added to [<see cref="_TempMediaList"/>].<br/>
''' At the end of the function, reparsed posts must be removed from [<see cref="_ContentList"/>].
''' </summary>
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub
#End Region
#Region "MD5 support"
Protected Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
Friend Property UseMD5Comparison As Boolean = False
Protected Property StartMD5Checked As Boolean = False
Friend Property RemoveExistingDuplicates As Boolean = False
Protected Overridable Sub ValidateMD5(ByVal Token As CancellationToken)
Try
Dim missingMD5 As Predicate(Of UserMedia) = Function(d) (d.Type = UTypes.GIF Or d.Type = UTypes.Picture) And d.MD5.IsEmptyString
If UseMD5Comparison And _TempMediaList.Exists(missingMD5) Then
Dim i%
Dim itemsCount% = 0
Dim limit% = If(DownloadTopCount, 0)
Dim data As UserMedia = Nothing
Dim hashList As New Dictionary(Of String, SFile)
Dim f As SFile
Dim ErrMD5 As New ErrorsDescriber(EDP.ReturnValue)
Dim __getMD5 As Func(Of UserMedia, Boolean, String) =
Function(ByVal __data As UserMedia, ByVal IsUrl As Boolean) As String
Try
Dim ImgFormat As Imaging.ImageFormat = Nothing
Dim hash$ = String.Empty
Dim __isGif As Boolean = False
If __data.Type = UTypes.GIF Then
ImgFormat = Imaging.ImageFormat.Gif
__isGif = True
ElseIf Not __data.File.IsEmptyString Then
ImgFormat = GetImageFormat(__data.File)
End If
If ImgFormat Is Nothing Then ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl And Not __isGif Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
ElseIf IsUrl And __isGif Then
hash = ByteArrayToString(GetMD5FromBytes(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
If hash.IsEmptyString And Not __isGif Then
If ImgFormat Is Imaging.ImageFormat.Jpeg Then ImgFormat = Imaging.ImageFormat.Png Else ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
End If
Return hash
Catch
Return String.Empty
End Try
End Function
If Not StartMD5Checked Then
StartMD5Checked = True
If _ContentList.Exists(missingMD5) Then
Dim existingFiles As List(Of SFile) = SFile.GetFiles(MyFileSettings.CutPath, "*.jpg|*.jpeg|*.png|*.gif",, EDP.ReturnValue).ListIfNothing
Dim eIndx%
Dim eFinder As Predicate(Of SFile) = Function(ff) ff.File = data.File.File
If RemoveExistingDuplicates Then
RemoveExistingDuplicates = False
_ForceSaveUserInfo = True
If existingFiles.Count > 0 Then
Dim h$
ProgressPre.ChangeMax(existingFiles.Count)
For i = existingFiles.Count - 1 To 0 Step -1
ProgressPre.Perform()
h = __getMD5(New UserMedia With {.File = existingFiles(i)}, False)
If Not h.IsEmptyString Then
If hashList.ContainsKey(h) Then
MyMainLOG = $"{ToStringForLog()}: Removed image [{existingFiles(i).File}] (duplicate of [{hashList(h).File}])"
existingFiles(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, ErrMD5)
existingFiles.RemoveAt(i)
Else
hashList.Add(h, existingFiles(i))
End If
End If
Next
End If
End If
ProgressPre.ChangeMax(_ContentList.Count)
For i = 0 To _ContentList.Count - 1
data = _ContentList(i)
ProgressPre.Perform()
If data.Type = UTypes.GIF Or data.Type = UTypes.Picture Then
If data.MD5.IsEmptyString Then
ThrowAny(Token)
eIndx = existingFiles.FindIndex(eFinder)
If eIndx >= 0 Then
data.MD5 = __getMD5(New UserMedia With {.File = existingFiles(eIndx)}, False)
If Not data.MD5.IsEmptyString Then _ContentList(i) = data : _ForceSaveUserData = True
End If
End If
existingFiles.RemoveAll(eFinder)
End If
Next
If existingFiles.Count > 0 Then
ProgressPre.ChangeMax(existingFiles.Count)
For i = 0 To existingFiles.Count - 1
f = existingFiles(i)
ProgressPre.Perform()
data = New UserMedia(f.File) With {
.State = UStates.Downloaded,
.Type = IIf(f.Extension = "gif", UTypes.GIF, UTypes.Picture),
.File = f
}
ThrowAny(Token)
data.MD5 = __getMD5(data, False)
If Not data.MD5.IsEmptyString Then _ContentList.Add(data) : _ForceSaveUserData = True
Next
existingFiles.Clear()
End If
End If
End If
If _ContentList.Count > 0 Then
With _ContentList.Select(Function(d) d.MD5)
If .ListExists Then .ToList.ForEach(Sub(md5value) _
If Not md5value.IsEmptyString AndAlso Not hashList.ContainsKey(md5value) Then hashList.Add(md5value, New SFile))
End With
End If
ProgressPre.ChangeMax(_TempMediaList.Count)
For i = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If limit > 0 And itemsCount >= limit Then
_TempMediaList.RemoveAt(i)
Else
data = _TempMediaList(i)
If missingMD5(data) Then
ThrowAny(Token)
data.MD5 = __getMD5(data, True)
If Not data.MD5.IsEmptyString Then
If hashList.ContainsKey(data.MD5) Then
_TempMediaList.RemoveAt(i)
Else
hashList.Add(data.MD5, New SFile)
_TempMediaList(i) = data
itemsCount += 1
End If
End If
End If
End If
Next
End If
Catch iex As ArgumentOutOfRangeException When Disposed
Catch ex As Exception
ProcessException(ex, Token, "ValidateMD5",, VALIDATE_MD5_ERROR)
Finally
ProgressPre.Done()
End Try
End Sub
#End Region
#Region "DownloadContent"
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
Private NotInheritable Class OptionalWebClient : Inherits DownloadObjects.WebClient2
Private ReadOnly Source As UserDataBase
Friend Sub New(ByRef Source As UserDataBase)
Me.Source = Source
UseResponserClient = Source.UseResponserClient
If UseResponserClient Then
Client = Source.Responser
Else
Client = New RWebClient With {.UseNativeClient = Not Source.IsSingleObjectDownload}
End If
If Source.IsSingleObjectDownload Then DelegateEvents = True
End Sub
Private _LastProgressValue As Integer = 0
Protected Overrides Sub Client_DownloadProgressChanged(ByVal Sender As Object, ByVal e As DownloadProgressChangedEventArgs)
Dim v% = e.ProgressPercentage
If v > _LastProgressValue Then
If v > 100 Then v = 100
Source.Progress.Value = v
Source.Progress.Perform(0)
End If
_LastProgressValue = e.ProgressPercentage
End Sub
Protected Overrides Sub Client_DownloadFileCompleted(ByVal Sender As Object, ByVal e As AsyncCompletedEventArgs)
Source.Progress.Done()
End Sub
End Class
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try
Dim i%
Dim dCount% = 0, dTotal% = 0
ThrowAny(Token)
If _ContentNew.Count > 0 Then
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then
MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim MyDir$ = DownloadContentDefault_GetRootDir()
Dim vsf As Boolean = SeparateVideoFolderF
Dim __isVideo As Boolean
Dim __interrupt As Boolean
Dim f As SFile
Dim v As UserMedia
Dim fileNumProvider As SFileNumbers = SFileNumbers.Default
Dim __deleteFile As Action(Of SFile, String) = Sub(ByVal FileToDelete As SFile, ByVal FileUrl As String)
Try
If FileToDelete.Exists Then FileToDelete.Delete(,, EDP.ThrowException)
Catch file_io_ex As IOException
MyMainLOG = "File download aborted. You should download the following file again." & vbCr &
$"File: {FileToDelete}{vbCr}URL: {FileUrl}"
Catch file_del_ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, file_del_ex)
End Try
End Sub
Using w As New OptionalWebClient(Me)
If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count
If IsSingleObjectDownload Then
If _ContentNew.Count = 1 And _ContentNew(0).Type = UTypes.Video Then
Progress.Value = 0
Progress.Maximum = 100
Progress.Provider = MyProgressNumberProvider.Percentage
ElseIf _ContentNew(0).Type = UTypes.m3u8 Then
Progress.Provider = MyProgressNumberProvider.Percentage
Else
w.DelegateEvents = False
End If
End If
For i = 0 To _ContentNew.Count - 1
ThrowAny(Token)
v = _ContentNew(i)
v.State = UStates.Tried
If v.File.IsEmptyString Then
f = CreateFileFromUrl(v.URL)
Else
f = v.File
End If
f.Separator = "\"
If Not IsSingleObjectDownload Then f.Path = MyDir
If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL
If Not f.IsEmptyString And Not v.URL.IsEmptyString Then
Try
__isVideo = v.Type = UTypes.Video Or f.Extension = "mp4" Or v.Type = UTypes.m3u8
If f.Extension.IsEmptyString Then
Select Case v.Type
Case UTypes.Picture : f.Extension = "jpg"
Case UTypes.Video, UTypes.m3u8 : f.Extension = "mp4"
Case UTypes.GIF : f.Extension = "gif"
End Select
ElseIf f.Extension = "webp" And Settings.DownloadNativeImageFormat Then
f.Extension = "jpg"
End If
If Not v.SpecialFolder.IsEmptyString Then
f.Path = $"{f.PathWithSeparator}{v.SpecialFolder.StringTrimEnd("*")}\".CSFileP.Path
f.Exists(SFO.Path)
End If
If __isVideo And vsf Then
If v.SpecialFolder.IsEmptyString OrElse Not v.SpecialFolder.EndsWith("*") Then
f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
End If
End If
If __isVideo Then fileNumProvider.FileName = f.Name : f = SFile.IndexReindex(f,,, fileNumProvider)
__interrupt = False
If IsSingleObjectDownload Then f.Exists(SFO.Path, True)
If v.Type = UTypes.m3u8 And UseInternalM3U8Function Then
f = DownloadM3U8(v.URL, v, f, Token)
If f.IsEmptyString Then Throw New Exception("M3U8 download failed")
ElseIf UseInternalDownloadFileFunction AndAlso ValidateDownloadFile(v.URL, v, __interrupt) Then
f = DownloadFile(v.URL, v, f, Token)
If f.IsEmptyString Then Throw New Exception("InternalFunc download failed")
Else
If UseInternalDownloadFileFunction And __interrupt Then Throw New Exception("InternalFunc download interrupted")
If UseClientTokens Then
w.DownloadFile(v.URL, f, Token)
Else
w.DownloadFile(v.URL, f)
End If
End If
If __isVideo Then
v.Type = UTypes.Video
DownloadedVideos(False) += 1
ElseIf v.Type = UTypes.GIF Then
DownloadedPictures(False) += 1
Else
v.Type = UTypes.Picture
DownloadedPictures(False) += 1
End If
v.File = ChangeFileNameByProvider(f, v)
v.State = UStates.Downloaded
DownloadContentDefault_PostProcessing(v, f, Token)
dCount += 1
Catch woex As OperationCanceledException When Token.IsCancellationRequested
__deleteFile.Invoke(f, v.URL_BASE)
v.State = UStates.Missing
v.Attempts += 1
_ContentNew(i) = v
Throw woex
Catch wex As Exception
If DownloadContentDefault_ProcessDownloadException() Then
v.Attempts += 1
v.State = UStates.Missing
If MissingErrorsAdd Then ErrorDownloading(f, v.URL)
End If
End Try
Else
v.State = UStates.Skipped
End If
_ContentNew(i) = v
If DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value Then
Progress.Perform(_ContentNew.Count - dTotal)
Exit Sub
Else
dTotal += 1
Progress.Perform()
End If
Next
End Using
End If
End If
Catch iex As IndexOutOfRangeException When Disposed
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "content downloading error")
HasError = True
End Try
End Sub
Protected UseInternalM3U8Function As Boolean = False
Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile
Return Nothing
End Function
Protected UseInternalDownloadFileFunction As Boolean = False
Protected Overridable Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile
Return Nothing
End Function
Protected Overridable Function ValidateDownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByRef Interrupt As Boolean) As Boolean
Return True
End Function
''' <returns><c>MyFile.CutPath(IIf(IsSingleObjectDownload, 0, 1)).PathNoSeparator</c></returns>
Protected Overridable Function DownloadContentDefault_GetRootDir() As String
Return MyFile.CutPath(IIf(IsSingleObjectDownload, 0, 1)).PathNoSeparator
End Function
Protected Overridable Sub DownloadContentDefault_PostProcessing(ByRef m As UserMedia, ByVal File As SFile, ByVal Token As CancellationToken)
End Sub
Protected Overridable Function DownloadContentDefault_ProcessDownloadException() As Boolean
Return True
End Function
#End Region
#Region "ProcessException"
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,
Optional ByVal ThrowEx As Boolean = True) As Integer
If TypeOf ex Is ExitException Then
Throw ex
ElseIf Not ((TypeOf ex Is OperationCanceledException And (Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested)) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE Then
Dim v% = DownloadingException(ex, Message, True, EObj)
If v = 0 Then LogError(ex, Message) : HasError = True
Return v
End If
Else
If ThrowEx Then Throw ex Else Return EXCEPTION_OPERATION_CANCELED
End If
Return 0
End Function
''' <summary>0 - Execute LogError and set HasError</summary>
Protected MustOverride Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Optional ByVal EObj As Object = Nothing) As Integer
#End Region
#Region "ChangeFileNameByProvider, RunScript"
Protected Overridable Function CreateFileFromUrl(ByVal URL As String) As SFile
Return New SFile(URL)
End Function
Protected Overridable Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
Dim ff As SFile = Nothing
Try
If f.Exists Then
If Not Settings.FileReplaceNameByDate.Value = FileNameReplaceMode.None Then
ff = f
ff.Name = String.Format(FileDateAppenderPattern, f.Name, CStr(AConvert(Of String)(If(m.Post.Date, Now), FileDateAppenderProvider, String.Empty)))
ff = SFile.IndexReindex(ff,,, New NumberedFile(ff))
End If
If Not ff.Name.IsEmptyString Then My.Computer.FileSystem.RenameFile(f, ff.File) : Return ff
End If
Return f
Catch ex As Exception
LogError(ex, $"change file name from [{f}] to [{ff}]")
Return f
End Try
End Function
Private Sub RunScript()
Try
Const spa$ = "{0}"
If ScriptUse Then
Dim ScriptPattern$
If Not ScriptData.IsEmptyString Then
ScriptPattern = ScriptData
Else
ScriptPattern = Settings.ScriptData.Value
End If
If Not ScriptPattern.IsEmptyString Then
If Not ScriptPattern.Contains(spa) Then ScriptPattern &= $" ""{spa}"""
Using b As New BatchExecutor With {.RedirectStandardError = True}
b.Execute({String.Format(ScriptPattern, MyFile.CutPath(1).PathNoSeparator)}, EDP.SendToLog + EDP.ThrowException)
If b.HasError Or Not b.ErrorOutput.IsEmptyString Then Throw New Exception(b.ErrorOutput, b.ErrorException)
End Using
End If
End If
Catch ex As Exception
LogError(ex, "script execution error")
End Try
End Sub
#End Region
#End Region
#Region "Erase, Delete, Move, Merge, Copy"
Friend Shared Function GetEraseMode(ByVal Users As IEnumerable(Of IUserData)) As IUserData.EraseMode
Dim mode As IUserData.EraseMode = IUserData.EraseMode.None
If Users.ListExists Then
Dim m As New MMessage("The data of the following users will be erased:" & vbCr & vbCr, "Erase data",
{New MsgBoxButton("History and Data", "All files (images and videos) will be deleted; download history will be deleted."),
New MsgBoxButton("Data", "All files (images and videos) will be deleted; download history will not be affected."),
New MsgBoxButton("History", "All files (images and videos) will not be affected; download history will be deleted."),
New MsgBoxButton("Cancel")
}, MsgBoxStyle.Exclamation) With {.ButtonsPerRow = 4}
Dim collectionsCount% = Users.Count(Function(u) u.IsCollection)
m.Text &= Users.ListToStringE(vbNewLine, MainFrameObj.GetUserListProvider(collectionsCount > 0))
m.Text &= vbCr.StringDup(2)
If collectionsCount > 0 Then
If collectionsCount = 1 And Users.Count = 1 Then
m.Text &= $"THIS USER IS A COLLECTION OF {DirectCast(Users(0), UserDataBind).Count} USERS. THE DATA WILL BE ERASED FOR ALL OF THEM."
Else
m.Text &= "ONE OR MORE USERS IN THE LIST IS A COLLECTION. THE DATA WILL BE ERASED FOR EACH USER OF EACH COLLECTION."
End If
m.Text &= vbCr.StringDup(2)
End If
m.Text &= "Are you sure you want to erase the data?"
Select Case m.Show
Case 0 : mode = IUserData.EraseMode.Data + IUserData.EraseMode.History
Case 1 : mode = IUserData.EraseMode.Data
Case 2 : mode = IUserData.EraseMode.History
End Select
End If
Return mode
End Function
Friend Overridable Function EraseData(ByVal Mode As IUserData.EraseMode) As Boolean Implements IUserData.EraseData
Try
Dim result As Boolean = False
If Not Mode = IUserData.EraseMode.None And Not DataMerging Then
Dim m() As IUserData.EraseMode = Mode.EnumExtract(Of IUserData.EraseMode)
If m.ListExists Then
Dim e As New ErrorsDescriber(EDP.ReturnValue)
If m.Contains(IUserData.EraseMode.History) Then
If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
LastUpdated = Nothing
EraseData_AdditionalDataFiles()
UpdateUserInformation()
End If
If m.Contains(IUserData.EraseMode.Data) Then
Dim files As List(Of SFile) = SFile.GetFiles(DownloadContentDefault_GetRootDir.CSFileP,, SearchOption.AllDirectories, e)
If files.ListExists Then files.RemoveAll(Function(f) Not f.Extension.IsEmptyString AndAlso (f.Extension = "txt" Or f.Extension = "xml"))
If files.ListExists Then files.ForEach(Sub(f) f.Delete(SFO.File, Settings.DeleteMode, e))
LatestData.Clear()
result = True
End If
If result Then
_TempPostsList.Clear()
_TempMediaList.Clear()
_ContentNew.Clear()
_ContentList.Clear()
End If
End If
End If
Return result
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"EraseData({CInt(Mode)}): {ToStringForLog()}", False)
End Try
End Function
Protected Overridable Sub EraseData_AdditionalDataFiles() Implements IPluginContentProvider.ResetHistoryData
End Sub
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)
Settings.UsersList.Remove(User)
Settings.UpdateUsersList()
If Not IncludedInCollection Then Settings.Users.Remove(Me)
Downloader.UserRemove(Me)
Dispose(True)
Return 1
Else
Return 0
End If
End Function
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
Settings.Feeds.Load()
If IncludedInCollection And __CollectionName.IsEmptyString And __SpecialCollectionPath.IsEmptyString Then
Settings.Users.Add(Me)
Removed = False
User.CollectionName = String.Empty
User.SpecialCollectionPath = String.Empty
User.UserModel = UsageModel.Default
User.CollectionModel = UsageModel.Default
Else
Settings.Users.Remove(Me)
Removed = True
User.CollectionName = __CollectionName
User.SpecialCollectionPath = __SpecialCollectionPath
If Not IsVirtual Then User.SpecialPath = Nothing
End If
_TurnBack = True
User.UpdateUserFile()
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.CutPath.Exists(SFO.Path)
SFile.Move(UserBefore.File.CutPath(, EDP.ThrowException), f, SFO.Path,,
SFODelete.EmptyOnly + SFODelete.DeleteToRecycleBin + SFODelete.OnCancelThrowException, EDP.ThrowException)
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
End If
Settings.UsersList.Remove(UserBefore)
Settings.UpdateUsersList(User)
Settings.Feeds.UpdateUsers(UserBefore, User)
UpdateUserInformation()
Return True
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Files moving error")
User = UserBefore
If _TurnBack Then
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
End If
Return False
End Try
End Function
Friend Overloads Sub MergeData()
Dim UserBefore As UserInfo = User
Try
If DataMerging Then
Throw New InvalidOperationException($"{Site} - {Name}: data already merged") With {.HelpLink = 1}
Else
Dim files As List(Of SFile) = Nothing
Dim allFiles As List(Of SFile) = Nothing
Dim fSource As SFile, fDest As SFile
Dim ReplacingPath$ = UserBefore.File.CutPath.Path
Dim dirs As List(Of SFile) = SFile.GetDirectories(UserBefore.File.CutPath,, SearchOption.AllDirectories)
Dim FilesMover As Action = Sub()
If files.ListExists Then
For Each fSource In files
fDest = fSource
fDest.Path = User.File.CutPath.PathWithSeparator & fSource.Path.Replace(ReplacingPath, String.Empty)
fDest.Exists(SFO.Path,, EDP.ThrowException)
fDest = CheckFile(fDest, allFiles)
File.Move(fSource, fDest)
Next
files.Clear()
End If
End Sub
DataMerging = True
If dirs.ListExists Then
For Each dir As SFile In dirs
allFiles = SFile.GetFiles(SFile.GetPath(User.File.CutPath.PathWithSeparator &
dir.Path.Replace(ReplacingPath, String.Empty)),,, EDP.ReturnValue)
files = SFile.GetFiles(dir,,, EDP.ReturnValue)
FilesMover.Invoke
Next
End If
allFiles = SFile.GetFiles(User.File.CutPath,,, EDP.ReturnValue)
files = SFile.GetFiles(UserBefore.File.CutPath,,, EDP.ReturnValue)
FilesMover.Invoke
If SFile.GetFiles(UserBefore.File.CutPath,, SearchOption.AllDirectories,
New ErrorsDescriber(False, False, False, New List(Of SFile))).Count = 0 Then
UserBefore.File.CutPath.Delete(SFO.Path, Settings.DeleteMode, EDP.SendToLog)
End If
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
Settings.Feeds.UpdateUsers(UserBefore, User)
UpdateUserInformation()
End If
Catch ioex As InvalidOperationException When ioex.HelpLink = 1
MsgBoxE(ioex.Message, vbCritical)
Catch ex As Exception
LogError(ex, "[UserDataBase.MergeData]")
End Try
End Sub
Private Function CheckFile(ByVal f As SFile, ByRef List As IEnumerable(Of SFile)) As SFile
If List.ListExists Then
Dim p As RParams = RParams.DMS(".+?\s{0,1}\((\d+)\)|.+", 0, EDP.ReturnValue)
Dim i% = List.Where(Function(ff) CStr(RegexReplace(ff.Name, p)).Trim.ToLower = f.Name.Trim.ToLower).Count
If i > 0 Then f.Name &= $" ({i + 1})"
End If
Return f
End Function
Private Class FilesCopyingException : Inherits ErrorsDescriberException
Friend Sub New(ByVal User As IUserData, ByVal Msg As String, ByVal Path As SFile)
SendToLogOnlyMessage = True
If User.IncludedInCollection Then _MainMessage = $"[{User.CollectionName}] - "
_MainMessage &= $"[{User.Site}] - [{User.Name}]. {Msg}: {Path.Path}."
End Sub
End Class
Friend Overridable Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements IUserData.CopyFiles
Dim fSource As SFile = Nothing
Dim fDest As SFile = Nothing
Try
Dim pOffset%
If IncludedInCollection Then
If DataMerging Then pOffset = 1 Else pOffset = 2
Else
pOffset = 1
End If
fSource = MyFile.CutPath(pOffset).Path.CSFileP
Dim OptPath$ = String.Empty
If IncludedInCollection Then
OptPath = $"Collections\{CollectionName}" 'Copying a collection based on the first file
Else
OptPath = $"{Site}\{Name}"
End If
fDest = $"{DestinationPath.PathWithSeparator}{OptPath}".CSFileP
If fDest.Exists(SFO.Path, False) AndAlso MsgBoxE({$"The following path already exists:{vbCr}{fDest.Path}" & vbCr &
"Do you want to copy files here?", "Copying files"}, vbExclamation + vbYesNo) = vbNo Then _
Throw New FilesCopyingException(Me, "The following path already exists", fDest)
If DestinationPath.Exists(SFO.Path, True) Then
My.Computer.FileSystem.CopyDirectory(fSource, fDest, FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.ThrowException)
Else
Throw New FilesCopyingException(Me, "Cannot create the following path", fDest)
End If
Return True
Catch cex As OperationCanceledException
Return ErrorsDescriber.Execute(e, New FilesCopyingException(Me, "Copy canceled", fDest),, False)
Catch ex As Exception
Return ErrorsDescriber.Execute(e, ex,, False)
End Try
End Function
#End Region
#Region "Errors functions"
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing)
ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
End Sub
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
End Sub
''' <exception cref="ObjectDisposedException"></exception>
Protected Sub ThrowIfDisposed()
If Disposed Then Throw New ObjectDisposedException(ToString(), "Object disposed")
End Sub
''' <inheritdoc cref="ThrowAny(CancellationToken)"/>
Private Overloads Sub ThrowAny() Implements IThrower.ThrowAny
ThrowAny(TokenQueue)
End Sub
''' <summary><c>ThrowAnyImpl(Token)</c></summary>
''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception>
Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
ThrowAnyImpl(Token)
End Sub
Protected Sub ThrowAnyImpl(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
TokenQueue.ThrowIfCancellationRequested()
TokenPersonal.ThrowIfCancellationRequested()
ThrowIfDisposed()
End Sub
#End Region
Friend Function ToStringForLog() As String
Return $"{IIf(IncludedInCollection, $"[{CollectionName}] - ", String.Empty)}[{Site}] - {Name}"
End Function
Public Overrides Function ToString() As String
If IsCollection Then
Return CollectionName
Else
Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If
End Function
Public Overrides Function GetHashCode() As Integer
Dim hcStr$
If Not CollectionName.IsEmptyString Then
hcStr = CollectionName
Else
hcStr = IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If
If hcStr.IsEmptyString Then hcStr = LVIKey
Return hcStr.GetHashCode
End Function
#Region "Buttons actions"
Private Sub BTT_CONTEXT_DOWN_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN.KeyClick
Downloader.Add(Me, e.IncludeInTheFeed)
End Sub
Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click
Using f As New Editors.UserCreatorForm(Me)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then UpdateUserInformation()
End Using
End Sub
Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click
End Sub
Private Sub BTT_CONTEXT_ERASE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_ERASE.Click
Const msgTitle$ = "Erase data"
Try
Dim m As IUserData.EraseMode = GetEraseMode({Me})
If Not m = IUserData.EraseMode.None Then
If EraseData(m) Then
MsgBoxE({"User data has been erased.", msgTitle})
Else
MsgBoxE({"User data has not been erased.", msgTitle}, vbExclamation)
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, msgTitle)
End Try
End Sub
Private Sub BTT_CONTEXT_OPEN_PATH_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_PATH.Click
OpenFolder()
End Sub
Private Sub BTT_CONTEXT_OPEN_SITE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_SITE.Click
OpenSite()
End Sub
#End Region
#Region "IComparable Support"
Friend Overridable Overloads Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
If TypeOf Other Is UserDataBind Then
Return 1
ElseIf IsCollection Then
Return Name.CompareTo(Other.Name)
Else
Return FriendlyName.IfNullOrEmpty(Name).StringTrim.CompareTo(Other.FriendlyName.IfNullOrEmpty(Other.Name).StringTrim)
End If
End Function
Friend Overridable Overloads Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then
Return CompareTo(DirectCast(Obj, UserDataBase))
Else
Return 0
End If
End Function
#End Region
#Region "IEquatable Support"
Friend Overridable Overloads Function Equals(ByVal Other As UserDataBase) As Boolean Implements IEquatable(Of UserDataBase).Equals
Return LVIKey = Other.LVIKey And IsSavedPosts = Other.IsSavedPosts
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then
Return Equals(DirectCast(Obj, UserDataBase))
Else
Return False
End If
End Function
#End Region
#Region "IDisposable Support"
Protected disposedValue As Boolean = False
Friend ReadOnly Property Disposed As Boolean Implements IUserData.Disposed
Get
Return disposedValue
End Get
End Property
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
_ContentList.Clear()
_ContentNew.Clear()
LatestData.Clear()
_TempMediaList.Clear()
_TempPostsList.Clear()
TokenPersonal = Nothing
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()
If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose()
If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose()
If Not BTT_CONTEXT_ERASE Is Nothing Then BTT_CONTEXT_ERASE.Dispose()
If Not BTT_CONTEXT_OPEN_PATH Is Nothing Then BTT_CONTEXT_OPEN_PATH.Dispose()
If Not BTT_CONTEXT_OPEN_SITE Is Nothing Then BTT_CONTEXT_OPEN_SITE.Dispose()
UserUpdatedEventHandlers.Clear()
End If
disposedValue = True
End If
End Sub
Protected Overloads Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace