Add full channel support, make ready for download prop available for collections and multiusers
Fixed imgur pics compatibility
Updated abstract classes and functions for channels compatibility
This commit is contained in:
Andy
2021-12-12 14:47:34 +03:00
parent 70e73c7d97
commit 67c4b25d22
16 changed files with 645 additions and 232 deletions

View File

@@ -33,6 +33,7 @@ Namespace API.Base
#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_FriendlyName As String = "FriendlyName"
Private Const Name_UserID As String = "UserID"
@@ -131,7 +132,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
Private Function GetPicture(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As Image
Protected Function GetPicture(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As Image
Dim f As SFile = Nothing
Dim p As UserImage = Nothing
Dim DelPath As Boolean = True
@@ -234,7 +235,7 @@ BlockNullPicture:
#Region "Downloading params"
Protected _DataLoaded As Boolean = False
Protected _DataParsed As Boolean = False
Friend Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
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
#End Region
@@ -409,7 +410,12 @@ BlockNullPicture:
''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Overloads Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
Select Case u.Site
Case Sites.Reddit : Return New Reddit.UserData(u, _LoadUserInformation)
Case Sites.Reddit
If u.IsChannel Then
Return New Reddit.Channel(u, _LoadUserInformation)
Else
Return New Reddit.UserData(u, _LoadUserInformation)
End If
Case Sites.Twitter : Return New Twitter.UserData(u, _LoadUserInformation)
Case Else : Throw New ArgumentOutOfRangeException("Site", $"Site [{u.Site}] information does not recognized by loader")
End Select
@@ -560,7 +566,7 @@ BlockNullPicture:
Try
Dim URL$ = String.Empty
Select Case Site
Case Sites.Reddit : URL = $"https://www.reddit.com/user/{Name}/"
Case Sites.Reddit : URL = $"https://www.reddit.com/{IIf(IsChannel, "r", "user")}/{Name}/"
Case Sites.Twitter : URL = $"https://twitter.com/{Name}"
Case Else : MsgBoxE($"Site [{Site}] opening does not implemented", MsgBoxStyle.Exclamation)
End Select
@@ -597,7 +603,7 @@ BlockNullPicture:
If _TempMediaList.Count > 0 Then
If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UserMedia.Types.GIF Or m.Type = UserMedia.Types.Picture)
If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UserMedia.Types.Video Or
m.Type = UserMedia.Types.VideoPre Or m.Type = UserMedia.Types.m3u8)
m.Type = UserMedia.Types.VideoPre Or m.Type = UserMedia.Types.m3u8)
End If
ReparseVideo(Token)
@@ -640,7 +646,7 @@ BlockNullPicture:
DownloadTopCount = Nothing
End Try
End Sub
Private Sub UpdateDataFiles()
Protected Sub UpdateDataFiles()
If Not User.File.IsEmptyString Then
MyFileData = User.File
MyFileData.Name &= "_Data"
@@ -680,32 +686,38 @@ BlockNullPicture:
#End Region
#Region "Delete, Move, Merge"
Friend Overridable Function Delete() As Integer Implements IUserData.Delete
Return DeleteF(Me)
End Function
Friend Function DeleteF(ByVal Instance As IUserData) As Integer
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso f.Delete(SFO.Path, False, False) Then
ImageHandler(Me, False)
Settings.UsersList.Remove(User)
Settings.UpdateUsersList()
Settings.Users.Remove(Me)
Downloader.UserRemove(Me)
Settings.Users.Remove(Instance)
Downloader.UserRemove(Instance)
Dispose(True)
Return 1
Else
Return 0
End If
End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal _MergeData As Boolean) As Boolean Implements IUserData.MoveFiles
Friend Overridable Function MoveFiles(ByVal __CollectionName As String) As Boolean Implements IUserData.MoveFiles
Return MoveFilesF(Me, __CollectionName)
End Function
Friend Function MoveFilesF(ByRef Instance As IUserData, ByVal __CollectionName As String) As Boolean
Dim UserBefore As UserInfo = User
Dim Removed As Boolean = True
Dim _TurnBack As Boolean = False
Try
Dim f As SFile
If IncludedInCollection Then
Settings.Users.Add(Me)
Settings.Users.Add(Instance)
Removed = False
User.CollectionName = String.Empty
User.IncludedInCollection = False
Else
Settings.Users.Remove(Me)
Settings.Users.Remove(Instance)
Removed = True
User.CollectionName = __CollectionName
User.IncludedInCollection = True
@@ -720,7 +732,7 @@ BlockNullPicture:
"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)
If Removed Then Settings.Users.Add(Instance) Else Settings.Users.Remove(Instance)
_TurnBack = False
Return False
End If
@@ -736,7 +748,7 @@ BlockNullPicture:
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)
If Removed Then Settings.Users.Add(Instance) Else Settings.Users.Remove(Instance)
End If
Return False
End Try
@@ -783,6 +795,8 @@ BlockNullPicture:
End If
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
@@ -872,7 +886,11 @@ BlockNullPicture:
Return OutValue
End Function
Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
Return CompareTo(DirectCast(Obj, UserDataBase))
If TypeOf Obj Is Reddit.Channel Then
Return CompareTo(DirectCast(DirectCast(Obj, Reddit.Channel).Instance, UserDataBase))
Else
Return CompareTo(DirectCast(Obj, UserDataBase))
End If
End Function
#End Region
#Region "IEquatable Support"
@@ -880,7 +898,11 @@ BlockNullPicture:
Return Site = Other.Site And Name = Other.Name
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Return Equals(DirectCast(Obj, UserDataBase))
If TypeOf Obj Is Reddit.Channel Then
Return Equals(DirectCast(DirectCast(Obj, Reddit.Channel).Instance, UserDataBase))
Else
Return Equals(DirectCast(Obj, UserDataBase))
End If
End Function
#End Region
#Region "IDisposable Support"
@@ -966,7 +988,7 @@ BlockNullPicture:
''' 3 - Collection splitted
''' </summary>
Function Delete() As Integer
Function MoveFiles(ByVal CollectionName As String, ByVal MergeData As Boolean) As Boolean
Function MoveFiles(ByVal CollectionName As String) As Boolean
Sub OpenFolder()
ReadOnly Property Self As IUserData
Property DownloadTopCount As Integer?

View File

@@ -2,9 +2,10 @@
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.XML
Imports SCrawler.API.Base
Imports System.Threading
Namespace API.Reddit
Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel),
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IDisposable
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IUserData, IDisposable
#Region "XML Nodes' Names"
Private Const Name_Name As String = "Name"
Private Const Name_ID As String = "ID"
@@ -12,8 +13,237 @@ Namespace API.Reddit
Private Const Name_PostsNode As String = "Posts"
#End Region
Friend Const DefaultDownloadLimitCount As Integer = 1000
Friend Property Name As String = String.Empty
Friend Property ID As String = String.Empty
#Region "IUserData Support"
Private Event OnPictureUpdated(User As IUserData) Implements IUserData.OnPictureUpdated
Friend Property Instance As IUserData
Private Property IUserData_ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly
Private ReadOnly Property IUserData_IsCollection As Boolean Implements IUserData.IsCollection
Get
Return Instance.IsCollection
End Get
End Property
Private Property IUserData_CollectionName As String Implements IUserData.CollectionName
Get
Return Instance.CollectionName
End Get
Set(ByVal NewName As String)
Instance.CollectionName = NewName
End Set
End Property
Private ReadOnly Property IUserData_IncludedInCollection As Boolean Implements IUserData.IncludedInCollection
Get
Return Instance.IncludedInCollection
End Get
End Property
Private ReadOnly Property IUserData_Labels As List(Of String) Implements IUserData.Labels
Get
Return Instance.Labels
End Get
End Property
Private ReadOnly Property IUserData_IsChannel As Boolean = True Implements IUserData.IsChannel
Private Property IUserData_ReadyForDownload As Boolean Implements IUserData.ReadyForDownload
Get
Return Instance.ReadyForDownload
End Get
Set(ByVal IsReady As Boolean)
Instance.ReadyForDownload = IsReady
End Set
End Property
Private Property IUserData_File As SFile Implements IUserData.File
Get
Return Instance.File
End Get
Set(ByVal NewFile As SFile)
Instance.File = NewFile
End Set
End Property
Private Property IUserData_FileExists As Boolean Implements IUserData.FileExists
Get
Return Instance.FileExists
End Get
Set(ByVal IsExists As Boolean)
Instance.FileExists = IsExists
End Set
End Property
Private Property IUserData_DownloadedPictures As Integer Implements IUserData.DownloadedPictures
Get
Return Instance.DownloadedPictures
End Get
Set(ByVal c As Integer)
Instance.DownloadedPictures = c
End Set
End Property
Private Property IUserData_DownloadedVideos As Integer Implements IUserData.DownloadedVideos
Get
Return Instance.DownloadedVideos
End Get
Set(ByVal c As Integer)
Instance.DownloadedVideos = c
End Set
End Property
Private ReadOnly Property IUserData_DownloadedTotal(Optional Total As Boolean = True) As Integer Implements IUserData.DownloadedTotal
Get
Return Instance.DownloadedTotal
End Get
End Property
Private ReadOnly Property IUserData_DownloadedInformation As String Implements IUserData.DownloadedInformation
Get
Return Instance.DownloadedInformation
End Get
End Property
Private Property IUserData_HasError As Boolean Implements IUserData.HasError
Get
Return Instance.HasError
End Get
Set(ByVal e As Boolean)
Instance.HasError = e
End Set
End Property
Private ReadOnly Property IUserData_FitToAddParams As Boolean Implements IUserData.FitToAddParams
Get
Return Instance.FitToAddParams
End Get
End Property
Private ReadOnly Property IUserData_LVIKey As String Implements IUserData.LVIKey
Get
Return Instance.LVIKey
End Get
End Property
Private ReadOnly Property IUserData_LVIIndex As Integer Implements IUserData.LVIIndex
Get
Return Instance.LVIIndex
End Get
End Property
Private Property IUserData_DownloadImages As Boolean Implements IUserData.DownloadImages
Get
Return Instance.DownloadImages
End Get
Set(ByVal d As Boolean)
Instance.DownloadImages = d
End Set
End Property
Private Property IUserData_DownloadVideos As Boolean Implements IUserData.DownloadVideos
Get
Return Instance.DownloadVideos
End Get
Set(ByVal d As Boolean)
Instance.DownloadVideos = d
End Set
End Property
Private ReadOnly Property IUserData_Self As IUserData Implements IUserData.Self
Get
Return Instance
End Get
End Property
Private Property IUserData_DownloadTopCount As Integer? Implements IUserData.DownloadTopCount
Get
Return Instance.DownloadTopCount
End Get
Set(ByVal c As Integer?)
Instance.DownloadTopCount = c
End Set
End Property
Friend Property Site As Sites = Sites.Reddit Implements IContentProvider.Site
Private Property IUserData_FriendlyName As String Implements IContentProvider.FriendlyName
Get
Return Instance.FriendlyName
End Get
Set(ByVal NewName As String)
Instance.FriendlyName = NewName
End Set
End Property
Private Property IUserData_Description As String Implements IContentProvider.Description
Get
Return Instance.Description
End Get
Set(ByVal d As String)
Instance.Description = d
End Set
End Property
Private Property IUserData_Favorite As Boolean Implements IContentProvider.Favorite
Get
Return Instance.Favorite
End Get
Set(ByVal f As Boolean)
Instance.Favorite = f
End Set
End Property
Private Property IUserData_Temporary As Boolean Implements IContentProvider.Temporary
Get
Return Instance.Temporary
End Get
Set(ByVal t As Boolean)
Instance.Temporary = t
End Set
End Property
Private Sub IUserData_SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Instance.SetPicture(f)
End Sub
Private Sub IUserData_LoadUserInformation() Implements IUserData.LoadUserInformation
Instance.LoadUserInformation()
End Sub
Private Sub IUserData_UpdateUserInformation() Implements IUserData.UpdateUserInformation
Instance.UpdateUserInformation()
End Sub
Private Sub IUserData_OpenFolder() Implements IUserData.OpenFolder
Instance.OpenFolder()
End Sub
Private Sub IUserData_OpenSite() Implements IContentProvider.OpenSite
Instance.OpenSite()
End Sub
Private Sub IUserData_DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
DownloadData(Token, False, Nothing)
End Sub
Private Function IUserData_GetPicture() As Image Implements IUserData.GetPicture
Return Instance.GetPicture()
End Function
Private Function IUserData_GetLVI(ByVal Destination As ListView) As ListViewItem Implements IUserData.GetLVI
Return Instance.GetLVI(Destination)
End Function
Private Function IUserData_GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Implements IUserData.GetLVIGroup
Return Instance.GetLVIGroup(Destination)
End Function
Private Function IUserData_Delete() As Integer Implements IUserData.Delete
Return DirectCast(Instance, UserDataBase).DeleteF(Me)
End Function
Private Function IUserData_MoveFiles(ByVal CollectionName As String) As Boolean Implements IUserData.MoveFiles
Return DirectCast(Instance, UserDataBase).MoveFilesF(Me, CollectionName)
End Function
#End Region
Private _Name As String = String.Empty
Friend Property Name As String Implements IUserData.Name
Get
If IsRegularChannel Then
Return Instance.Name
Else
Return _Name
End If
End Get
Set(ByVal NewName As String)
If IsRegularChannel Then
Instance.Name = NewName
Else
_Name = NewName
End If
End Set
End Property
Private _ID As String = String.Empty
Friend Property ID As String Implements IUserData.ID
Get
If IsRegularChannel Then
Return Instance.ID
Else
Return _ID
End If
End Get
Set(ByVal NewID As String)
If IsRegularChannel Then
Instance.ID = NewID
Else
_ID = NewID
End If
End Set
End Property
Friend ReadOnly Property CUser As UserInfo
Get
Return New UserInfo(Me)
@@ -122,6 +352,7 @@ Namespace API.Reddit
End Sub
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
#End Region
Friend ReadOnly IsRegularChannel As Boolean = False
Friend Sub New()
Posts = New List(Of UserPost)
PostsLatest = New List(Of UserPost)
@@ -131,9 +362,19 @@ Namespace API.Reddit
Me.New
LoadData(f, False)
End Sub
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
Me.New
Instance = New UserData(u, _LoadUserInformation) With {.SaveToCache = False, .SkipExistsUsers = False, .ChannelInfo = Me}
AutoGetLimits = True
DirectCast(Instance, UserData).SetLimit(Me)
IsRegularChannel = True
End Sub
Public Shared Widening Operator CType(ByVal f As SFile) As Channel
Return New Channel(f)
End Operator
Public Shared Widening Operator CType(ByVal c As Channel) As UserDataBase
Return DirectCast(c.Instance, UserDataBase)
End Operator
Public Overrides Function ToString() As String
If Not Name.IsEmptyString Then
Return Name
@@ -144,23 +385,26 @@ Namespace API.Reddit
Friend Sub Delete()
If File.Exists Then File.Delete()
End Sub
Friend Sub DownloadData(ByVal Token As Threading.CancellationToken, Optional ByVal SkipExists As Boolean = True,
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
Optional ByVal p As MyProgress = Nothing)
Try
_Downloading = True
Using d As New UserData(CUser, False, False) With {
.Progress = p,
.SaveToCache = True,
.SkipExistsUsers = SkipExists,
.ChannelInfo = Me
}
d.SetLimit(Me)
d.DownloadData(Token)
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
Token.ThrowIfCancellationRequested()
End Using
If Not Instance Is Nothing Then
Instance.DownloadData(Token)
Else
Using d As New UserData(CUser, False, False) With {
.Progress = p,
.SaveToCache = True,
.SkipExistsUsers = SkipExists,
.ChannelInfo = Me
}
d.SetLimit(Me)
d.DownloadData(Token)
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
End Using
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Finally
_Downloading = False
@@ -201,26 +445,50 @@ Namespace API.Reddit
Friend Overloads Function Equals(ByVal Other As Channel) As Boolean Implements IEquatable(Of Channel).Equals
Return ID = Other.ID
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not Obj Is Nothing Then
If TypeOf Obj Is String Then
Return ID = CStr(Obj)
Else
Return Equals(DirectCast(Obj, Channel))
End If
Private Overloads Function Equals(ByVal Other As UserDataBase) As Boolean Implements IEquatable(Of UserDataBase).Equals
If Not Instance Is Nothing Then
Return Instance.Equals(Other)
Else
Return False
End If
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not Obj Is Nothing Then
If TypeOf Obj Is String Then
Return ID = CStr(Obj)
ElseIf TypeOf Obj Is Channel Then
Return Equals(DirectCast(Obj, Channel))
ElseIf TypeOf Obj Is UserDataBase Then
Return Equals(DirectCast(Obj, UserDataBase))
End If
End If
Return False
End Function
#End Region
#Region "IComparable Support"
Friend Function CompareTo(ByVal Other As Channel) As Integer Implements IComparable(Of Channel).CompareTo
Friend Overloads Function CompareTo(ByVal Other As Channel) As Integer Implements IComparable(Of Channel).CompareTo
If Not Name.IsEmptyString And Not Other.Name.IsEmptyString Then
Return Name.CompareTo(Other.Name)
Else
Return ID.CompareTo(Other.ID)
End If
End Function
Private Overloads Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
If Not Instance Is Nothing Then
Return Instance.CompareTo(Other)
Else
Return 0
End If
End Function
Private Overloads Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If TypeOf Obj Is Channel Then
Return CompareTo(DirectCast(Obj, Channel))
ElseIf TypeOf Obj Is UserDataBase And Not Instance Is Nothing Then
Return Instance.CompareTo(Obj)
Else
Return 0
End If
End Function
#End Region
#Region "ILoaderSaver Support"
Friend Overloads Function LoadData(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Load
@@ -280,12 +548,18 @@ Namespace API.Reddit
#End Region
#Region "IDisposable Support"
Private 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
Posts.Clear()
PostsLatest.Clear()
Range.Dispose()
If Not Instance Is Nothing Then Instance.Dispose()
If CachePath.Exists(SFO.Path, False) Then CachePath.Delete(SFO.Path, False, False, EDP.SendInLog)
End If
disposedValue = True

View File

@@ -66,7 +66,7 @@ Namespace API.Reddit
#End Region
#Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
If IsChannel Then
If IsChannel AndAlso Not ChannelInfo.IsRegularChannel Then
ChannelPostsNames.ListAddList(ChannelInfo.PostsAll.Select(Function(p) p.ID), LNC)
If SkipExistsUsers Then _ExistsUsersNames.ListAddList(Settings.UsersList.Select(Function(p) p.Name), LNC)
DownloadDataF(Token)
@@ -80,7 +80,18 @@ Namespace API.Reddit
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
If IsChannel Then
If ChannelInfo.IsRegularChannel Then
ChannelPostsNames.ListAddList(_TempPostsList, LNC)
If ChannelPostsNames.Count > 0 Then
DownloadLimitCount = Nothing
With _ContentList.Where(Function(c) c.Post.Date.HasValue)
If .Count > 0 Then DownloadLimitDate = .Max(Function(p) p.Post.Date.Value).AddMinutes(-10)
End With
End If
If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount
End If
DownloadDataChannel(String.Empty, Token)
If ChannelInfo.IsRegularChannel Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
Else
DownloadDataUser(String.Empty, Token)
End If
@@ -131,7 +142,7 @@ Namespace API.Reddit
s = nn.ItemF({"source", "url"})
If s.XmlIfNothingValue("/").Contains("redgifs.com") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, PostID, PostDate,, IsChannel), LNC)
Else
ElseIf Not CreateImgurMedia(s.XmlIfNothingValue, PostID, PostDate,, IsChannel) Then
s = nn.ItemF({"media"}).XmlIfNothing
__ItemType = s("type").XmlIfNothingValue
Select Case __ItemType
@@ -241,6 +252,8 @@ Namespace API.Reddit
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
ElseIf CreateImgurMedia(tmpUrl, PostID, PostDate, _UserID, IsChannel) Then
_TotalPostsDownloaded += 1
ElseIf s.Item("media_metadata").XmlIfNothing.Count > 0 Then
DownloadGallery(s, PostID, PostDate, _UserID, SaveToCache)
_TotalPostsDownloaded += 1
@@ -268,6 +281,43 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Download Base Functions"
Private Function ImgurPicture(ByVal Source As EContainer, ByVal Value As String) As String
Try
Dim e As EContainer = Source({"source", "url"}).XmlIfNothing
If Not e.IsEmptyString AndAlso e.Value.ToLower.Contains("imgur") Then
Return e.Value
Else
Return Value
End If
Catch ex As Exception
LogError(ex, "[ImgurPicture]")
Return Value
End Try
End Function
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As Boolean
If Not _URL.IsEmptyString AndAlso _URL.Contains("imgur") Then
If _URL.StringContains({".jpg", ".png", ".jpeg"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
ElseIf _URL.Contains(".gifv") Then
If SaveToCache Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL.Replace(".gifv", ".gif"),
PostID, PostDate, _UserID, IsChannel), LNC)
Else
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL.Replace(".gifv", ".mp4"),
PostID, PostDate, _UserID, IsChannel), LNC)
End If
ElseIf _URL.Contains(".gif") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
Else
If Not TryFile(_URL) Then _URL &= ".jpg"
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
End If
Return True
Else
Return False
End If
End Function
Private Function DownloadGallery(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = Nothing, Optional ByVal FirstOnly As Boolean = False) As Boolean
Try
@@ -349,7 +399,7 @@ Namespace API.Reddit
End Function
Private Function TryFile(ByVal URL As String) As Boolean
Try
If Not URL.IsEmptyString AndAlso URL.Contains(".jpg") Then
If Not URL.IsEmptyString AndAlso URL.StringContains({".jpg", ".png", ".jpeg"}) Then
Dim f As SFile = CStr(RegexReplace(URL, FilesPattern))
Return Not f.IsEmptyString And Not f.File.IsEmptyString
End If

View File

@@ -98,7 +98,7 @@ Namespace API
Friend Overrides Property DataMerging As Boolean
Get
If Count > 0 Then
Return DirectCast(Collections(0), UserDataBase).DataMerging
Return DirectCast(Collections(0).Self, UserDataBase).DataMerging
Else
Return False
End If
@@ -142,6 +142,14 @@ Namespace API
UpdateUserInformation()
End Set
End Property
Friend Overrides Property ReadyForDownload As Boolean
Get
Return Count > 0 AndAlso Collections(0).ReadyForDownload
End Get
Set(ByVal IsReady As Boolean)
If Count > 0 Then Collections.ForEach(Sub(c) c.ReadyForDownload = IsReady)
End Set
End Property
Friend Overrides ReadOnly Property Labels As List(Of String)
Get
If Count > 0 Then
@@ -153,15 +161,15 @@ Namespace API
End Property
Friend Overrides Function GetUserInformation() As String
Dim OutStr$ = String.Empty
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), $"{vbCrLf}{vbCrLf}"))
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c.Self, UserDataBase).GetUserInformation(), $"{vbCrLf}{vbCrLf}"))
Return OutStr
End Function
Friend Overrides Property LastUpdated As Date?
Get
If Count > 0 Then
With If((From c In Collections
Where DirectCast(c, UserDataBase).LastUpdated.HasValue
Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
Where DirectCast(c.Self, UserDataBase).LastUpdated.HasValue
Select DirectCast(c.Self, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
If .Count > 0 Then Return .Max
End With
End If
@@ -179,7 +187,7 @@ Namespace API
Friend ReadOnly Property ContextDown As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DOWN).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_DOWN).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -188,7 +196,7 @@ Namespace API
Friend ReadOnly Property ContextEdit As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_EDIT).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_EDIT).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -197,7 +205,7 @@ Namespace API
Friend ReadOnly Property ContextDelete As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DELETE).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_DELETE).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -206,7 +214,7 @@ Namespace API
Friend ReadOnly Property ContextPath As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_PATH).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_OPEN_PATH).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -215,7 +223,7 @@ Namespace API
Friend ReadOnly Property ContextSite As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_SITE).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_OPEN_SITE).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -239,7 +247,7 @@ Namespace API
If Count > 0 Then Collections.ForEach(Sub(c) c.UpdateUserInformation())
End Sub
Friend Overrides Sub LoadContentInformation()
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation())
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c.Self, UserDataBase).LoadContentInformation())
End Sub
Friend Overrides Property DownloadTopCount As Integer?
Get
@@ -288,8 +296,8 @@ Namespace API
''' <exception cref="InvalidOperationException"></exception>
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
With _Item
Dim m As Boolean = DataMerging
If .MoveFiles(CollectionName, m) Then
If .MoveFiles(CollectionName) Then
If DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
Collections.Add(_Item)
With Collections.Last
If Collections.Count - 1 > 0 Then
@@ -298,7 +306,7 @@ Namespace API
.UpdateUserInformation()
End If
ImageHandler(_Item, False)
AddHandler .OnPictureUpdated, AddressOf User_OnPictureUpdated
AddHandler .Self.OnPictureUpdated, AddressOf User_OnPictureUpdated
DirectCast(.Self, UserDataBase).CreateButtons(Count - 1)
End With
Else
@@ -313,7 +321,7 @@ Namespace API
Case Sites.Twitter : Collections.Add(New Twitter.UserData(u, _LoadData))
Case Else : Exit Sub
End Select
With DirectCast(Collections(Count - 1), UserDataBase)
With DirectCast(Collections.Last.Self, UserDataBase)
.CreateButtons(Count - 1)
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf BTT_CONTEXT_DELETE_Click
End With
@@ -324,7 +332,7 @@ Namespace API
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
End If
End Sub
Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal _MergeData As Boolean) As Boolean
Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean
Throw New NotImplementedException("Files moving does not available if collection context")
End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
@@ -334,7 +342,7 @@ Namespace API
MsgBoxE($"Collection [{CollectionName}] data already merged")
Else
If Collections.Count > 1 Then
Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).MergeData())
Collections.ForEach(Sub(c) DirectCast(c.Self, UserDataBase).MergeData())
MsgBoxE($"Collection [{CollectionName}] data merged")
Else
MsgBoxE($"Collection [{CollectionName}] contains only one user profile" & vbCr &
@@ -367,21 +375,24 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical)
Return False
Else
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty, False)
DirectCast(_Item.Self, UserDataBase).MoveFiles(String.Empty)
ImageHandler(_Item)
Return Collections.Remove(_Item)
End If
End Function
Friend Overrides Function Delete() As Integer
If Count > 0 Then
Dim f As SFile
If MsgBoxE({$"Collection may contain data{vbCr}Do you really want to delete collection and all of it files?", "Collection deleting"},
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
f = Collections(0).File.CutPath(2).PathWithSeparator
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) c.Delete())
Downloader.UserRemove(Me)
ImageHandler(Me, False)
Collections.ListClearDispose
Dispose(False)
If f.Exists(SFO.Path, False) Then f.Delete(SFO.Path, True, False, EDP.SendInLog)
Return 2
Else
If DataMerging Then
@@ -390,10 +401,10 @@ Namespace API
End If
If MsgBoxE({$"Do you want to delete collection only?{vbCr}Users will not be deleted", "Collection deleting"},
MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
Dim f As SFile = Collections(0).File.CutPath(2)
f = Collections(0).File.CutPath(2)
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c)
c.MoveFiles(String.Empty, False)
c.MoveFiles(String.Empty)
ImageHandler(c)
End Sub)
Collections.Clear()