mirror of
https://github.com/AAndyProgram/SCrawler.git
synced 2026-03-14 15:52:18 +00:00
YT.VideoListForm: hide clear and delete buttons in menu; add 'BTT_CLEAR_SELECTED' button API.Base.TokenBatch: add debug option API.ALL: fix missing posts API.JFF: rewrite m3u8 downloader; add ffmpeg requirement for the download; fixed missing posts; fixed download to the date; fixed corrupted files DownloadableMediaHost: remove thumbnail when removed from list if thumbnail is stored in cache
1025 lines
58 KiB
VB.net
1025 lines
58 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.Net
|
|
Imports System.Threading
|
|
Imports SCrawler.API.Base
|
|
Imports SCrawler.API.Reddit.RedditViewExchange
|
|
Imports SCrawler.API.YouTube.Objects
|
|
Imports SCrawler.Plugin.Hosts
|
|
Imports PersonalUtilities.Functions.XML
|
|
Imports PersonalUtilities.Functions.RegularExpressions
|
|
Imports PersonalUtilities.Tools.ImageRenderer
|
|
Imports PersonalUtilities.Tools.Web.Clients
|
|
Imports PersonalUtilities.Tools.Web.Documents.JSON
|
|
Imports UStates = SCrawler.API.Base.UserMedia.States
|
|
Imports UTypes = SCrawler.API.Base.UserMedia.Types
|
|
Imports CView = SCrawler.API.Reddit.IRedditView.View
|
|
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
|
|
Namespace API.Reddit
|
|
Friend Class UserData : Inherits UserDataBase : Implements IChannelLimits, IRedditView
|
|
#Region "XML names"
|
|
Private Const Name_TrueName As String = "TrueName"
|
|
#End Region
|
|
#Region "Declarations"
|
|
Private Const CannelsLabelName As String = "Channels"
|
|
Friend Const CannelsLabelName_ChannelsForm As String = "RChannels"
|
|
Private ReadOnly Property MySiteSettings As SiteSettings
|
|
Get
|
|
Return DirectCast(HOST.Source, SiteSettings)
|
|
End Get
|
|
End Property
|
|
Private ReadOnly Property DateTrueProvider(ByVal IsChannel As Boolean) As IFormatProvider
|
|
Get
|
|
Return If(IsChannel, UnixDate32ProviderReddit, UnixDate64Provider)
|
|
End Get
|
|
End Property
|
|
Private ReadOnly Property UseM3U8 As Boolean
|
|
Get
|
|
Return Settings.UseM3U8 And CBool(DirectCast(HOST.Source, SiteSettings).UseM3U8.Value)
|
|
End Get
|
|
End Property
|
|
Friend Property IsChannel As Boolean = False
|
|
Friend Property TrueName As String = String.Empty
|
|
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
|
|
Get
|
|
Return {CannelsLabelName, CannelsLabelName_ChannelsForm, UserLabelName}
|
|
End Get
|
|
End Property
|
|
#End Region
|
|
#Region "Channels Support"
|
|
#Region "IChannelLimits Support"
|
|
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
|
|
Friend Property DownloadLimitPost As String Implements IChannelLimits.DownloadLimitPost
|
|
Friend Property DownloadLimitDate As Date? Implements IChannelLimits.DownloadLimitDate
|
|
Friend Overloads Sub SetLimit(Optional ByVal MaxPost As String = "", Optional ByVal MaxCount As Integer? = Nothing,
|
|
Optional ByVal MinDate As Date? = Nothing) Implements IChannelLimits.SetLimit
|
|
DownloadLimitPost = MaxPost
|
|
DownloadLimitCount = MaxCount
|
|
DownloadLimitDate = MinDate
|
|
End Sub
|
|
Friend Overloads Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit
|
|
With Source
|
|
DownloadLimitCount = .DownloadLimitCount
|
|
DownloadLimitPost = .DownloadLimitPost
|
|
DownloadLimitDate = .DownloadLimitDate
|
|
AutoGetLimits = .AutoGetLimits
|
|
End With
|
|
End Sub
|
|
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
|
|
#End Region
|
|
Friend Property ChannelInfo As Channel
|
|
Private ReadOnly ChannelPostsNames As List(Of String)
|
|
Friend Property SkipExistsUsers As Boolean = False
|
|
Private ReadOnly _ExistsUsersNames As List(Of String)
|
|
Friend Property SaveToCache As Boolean = False
|
|
Friend Function GetNewChannelPosts() As IEnumerable(Of UserPost)
|
|
If _ContentNew.Count > 0 Then Return (From c As UserMedia In _ContentNew
|
|
Where Not c.Post.CachedFile.IsEmptyString And c.State = UStates.Downloaded
|
|
Select c.Post) Else Return Nothing
|
|
End Function
|
|
#End Region
|
|
#Region "IRedditView Support"
|
|
Friend Property ViewMode As CView Implements IRedditView.ViewMode
|
|
Friend Property ViewPeriod As CPeriod Implements IRedditView.ViewPeriod
|
|
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
|
|
If Not Options Is Nothing Then
|
|
ViewMode = Options.ViewMode
|
|
ViewPeriod = Options.ViewPeriod
|
|
End If
|
|
End Sub
|
|
Private ReadOnly Property View As String
|
|
Get
|
|
Select Case ViewMode
|
|
Case CView.Hot : Return "hot"
|
|
Case CView.Top : Return "top"
|
|
Case Else : Return "new"
|
|
End Select
|
|
End Get
|
|
End Property
|
|
Private ReadOnly Property Period As String
|
|
Get
|
|
If ViewMode = CView.Top Then
|
|
Select Case ViewPeriod
|
|
Case CPeriod.Hour : Return "hour"
|
|
Case CPeriod.Day : Return "day"
|
|
Case CPeriod.Week : Return "week"
|
|
Case CPeriod.Month : Return "month"
|
|
Case CPeriod.Year : Return "year"
|
|
Case Else : Return "all"
|
|
End Select
|
|
Else
|
|
Return "all"
|
|
End If
|
|
End Get
|
|
End Property
|
|
#End Region
|
|
#Region "Initializer"
|
|
Friend Sub New()
|
|
ChannelPostsNames = New List(Of String)
|
|
_ExistsUsersNames = New List(Of String)
|
|
_CrossPosts = New List(Of String)
|
|
UseMD5Comparison = True
|
|
StartMD5Checked = True
|
|
RemoveExistingDuplicates = False
|
|
UseInternalDownloadFileFunction = True
|
|
UseInternalM3U8Function = True
|
|
End Sub
|
|
#End Region
|
|
#Region "Load and Update user info"
|
|
Private Function UpdateNames() As Boolean
|
|
If TrueName.IsEmptyString Then
|
|
Dim n$() = Name.Split("@")
|
|
If n.ListExists Then
|
|
If n.Length = 2 Then
|
|
TrueName = n(0)
|
|
IsChannel = True
|
|
ElseIf IsChannel Then
|
|
TrueName = Name
|
|
Else
|
|
TrueName = n(0)
|
|
End If
|
|
End If
|
|
If Not IsSavedPosts Then
|
|
Dim l$ = IIf(IsChannel, CannelsLabelName, UserLabelName)
|
|
Settings.Labels.Add(l)
|
|
Labels.ListAddValue(l, LNC)
|
|
Labels.Sort()
|
|
Return True
|
|
End If
|
|
End If
|
|
Return False
|
|
End Function
|
|
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
|
|
With Container
|
|
If Loading Then
|
|
ViewMode = .Value(Name_ViewMode).FromXML(Of Integer)(CInt(CView.New))
|
|
ViewPeriod = .Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(CPeriod.All))
|
|
IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False)
|
|
TrueName = .Value(Name_TrueName)
|
|
UpdateNames()
|
|
Else
|
|
If UpdateNames() Then .Value(Name_LabelsName) = LabelsString
|
|
.Add(Name_ViewMode, CInt(ViewMode))
|
|
.Add(Name_ViewPeriod, CInt(ViewPeriod))
|
|
.Add(Name_IsChannel, IsChannel.BoolToInteger)
|
|
.Add(Name_TrueName, TrueName)
|
|
End If
|
|
End With
|
|
End Sub
|
|
Friend Overrides Function ExchangeOptionsGet() As Object
|
|
Return New RedditViewExchange With {.ViewMode = ViewMode, .ViewPeriod = ViewPeriod}
|
|
End Function
|
|
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
|
|
If Not Obj Is Nothing AndAlso TypeOf Obj Is IRedditView Then SetView(DirectCast(Obj, IRedditView))
|
|
End Sub
|
|
#End Region
|
|
#Region "Download Overrides"
|
|
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
|
|
_CrossPosts.Clear()
|
|
If CreatedByChannel And Settings.FromChannelDownloadTopUse And Settings.FromChannelDownloadTop > 0 Then _
|
|
DownloadTopCount = Settings.FromChannelDownloadTop.Value
|
|
If IsChannel Or IsSavedPosts Then UseMD5Comparison = False
|
|
If IsSavedPosts Then TrueName = MySiteSettings.SavedPostsUserName.Value
|
|
UpdateNames()
|
|
If Not IsSavedPosts AndAlso (IsChannel AndAlso Not ChannelInfo Is Nothing) Then
|
|
UseMD5Comparison = False
|
|
EnvirDownloadSet()
|
|
If Not Responser Is Nothing Then Responser.Dispose()
|
|
Responser = New Responser
|
|
Responser.Copy(MySiteSettings.Responser)
|
|
ChannelPostsNames.ListAddList(ChannelInfo.PostsAll.Select(Function(p) p.ID), LNC)
|
|
If Not ViewMode = CView.New Then ChannelPostsNames.ListAddList(ChannelInfo.PostsNames, LNC)
|
|
If SkipExistsUsers Then _ExistsUsersNames.ListAddList(Settings.UsersList.Select(Function(p) p.Name), LNC)
|
|
DownloadDataF(Token)
|
|
ReparseVideo(Token)
|
|
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
|
|
DownloadContent(Token)
|
|
Else
|
|
MyBase.DownloadData(Token)
|
|
End If
|
|
End Sub
|
|
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
|
With MySiteSettings
|
|
If IsSavedPosts Then
|
|
If Not CBool(.UseTokenForSavedPosts.Value) Then Responser.Headers.Remove(DeclaredNames.Header_Authorization)
|
|
Else
|
|
If Not CBool(.UseCookiesForTimelines.Value) Then Responser.Cookies.Clear()
|
|
If Not CBool(.UseTokenForTimelines.Value) Then Responser.Headers.Remove(DeclaredNames.Header_Authorization)
|
|
End If
|
|
End With
|
|
|
|
_TotalPostsDownloaded = 0
|
|
If IsSavedPosts Then
|
|
Responser.DecodersError = EDP.ReturnValue
|
|
DownloadDataChannel(String.Empty, Token)
|
|
ElseIf IsChannel Then
|
|
If ChannelInfo Is Nothing 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
|
|
Else
|
|
GetUserInfo()
|
|
End If
|
|
If SaveToCache AndAlso Not Responser.Decoders.Contains(SymbolsConverter.Converters.HTML) Then _
|
|
Responser.Decoders.Add(SymbolsConverter.Converters.HTML)
|
|
DownloadDataChannel(String.Empty, Token)
|
|
If ChannelInfo Is Nothing Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
|
|
Else
|
|
GetUserInfo()
|
|
DownloadDataUser(String.Empty, Token)
|
|
End If
|
|
ProgressPre.Done()
|
|
End Sub
|
|
#End Region
|
|
#Region "Download Functions (User, Channel)"
|
|
Private _TotalPostsDownloaded As Integer = 0
|
|
Private ReadOnly _CrossPosts As List(Of String)
|
|
Private Const SiteGfycatKey As String = "gfycat"
|
|
Private Const SiteRedGifsKey As String = "redgifs"
|
|
Private Const Node_CrosspostRootId As String = "crosspostRootId"
|
|
Private Const Node_CrosspostParentId As String = "crosspostParentId"
|
|
Private Const Node_CrosspostParent As String = "crosspost_parent"
|
|
Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken)
|
|
Dim eObj% = 0
|
|
Dim round% = 0
|
|
Dim URL$ = String.Empty
|
|
Dim _completed As Boolean = False
|
|
Do
|
|
round += 1
|
|
Try
|
|
Dim PostID$ = String.Empty, PostTmp$ = String.Empty
|
|
Dim PostDate$
|
|
Dim n As EContainer, nn As EContainer
|
|
Dim NewPostDetected As Boolean = False
|
|
Dim ExistsDetected As Boolean = False
|
|
Dim IsCrossPost As Predicate(Of EContainer) = Function(e) Not e.Value(Node_CrosspostRootId).IsEmptyString Or Not e.Value(Node_CrosspostParentId).IsEmptyString Or Not e.Value(Node_CrosspostParent).IsEmptyString
|
|
Dim CheckNode As Predicate(Of EContainer) = Function(e) Not ParseUserMediaOnly OrElse If(e("author")?.Value, "/").ToLower.Equals(TrueName.StringToLower)
|
|
Dim _PostID As Func(Of String) = Function() PostTmp.IfNullOrEmpty(PostID)
|
|
|
|
URL = $"https://gateway.reddit.com/desktopapi/v1/user/{TrueName}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
|
|
ThrowAny(Token)
|
|
Dim r$ = Responser.GetResponse(URL)
|
|
If Not r.IsEmptyString Then
|
|
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
|
|
If w.Count > 0 Then
|
|
n = w.GetNode(JsonNodesJson)
|
|
If Not n Is Nothing AndAlso n.Count > 0 Then
|
|
ProgressPre.ChangeMax(n.Count)
|
|
For Each nn In n
|
|
ProgressPre.Perform()
|
|
ThrowAny(Token)
|
|
If nn.Count > 0 Then
|
|
If CheckNode(nn) Then
|
|
|
|
'Obtain post ID
|
|
PostTmp = nn.Name
|
|
If PostTmp.IsEmptyString Then PostTmp = nn.Value("id")
|
|
If PostTmp.IsEmptyString Then Continue For
|
|
'Check for CrossPost
|
|
If IsCrossPost(nn) Then
|
|
_CrossPosts.ListAddList({nn.Value(Node_CrosspostRootId),
|
|
nn.Value(Node_CrosspostParentId),
|
|
nn.Value(Node_CrosspostParent)}, LNC)
|
|
Continue For
|
|
Else
|
|
If Not _CrossPosts.Contains(PostTmp) Then PostID = PostTmp : PostTmp = String.Empty
|
|
End If
|
|
|
|
'Download decision
|
|
If Not _TempPostsList.Contains(_PostID()) Then
|
|
NewPostDetected = True
|
|
_TempPostsList.Add(_PostID())
|
|
Else
|
|
If Not _CrossPosts.Contains(_PostID()) Then ExistsDetected = True
|
|
Continue For
|
|
End If
|
|
If nn.Contains("created") Then PostDate = nn("created").Value Else PostDate = String.Empty
|
|
Select Case CheckDatesLimit(PostDate, DateTrueProvider(IsChannel))
|
|
Case DateResult.Skip : Continue For
|
|
Case DateResult.Exit : Exit Sub
|
|
End Select
|
|
|
|
ParseContainer(nn, _PostID(), PostDate)
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
End If
|
|
End Using
|
|
If POST.IsEmptyString And ExistsDetected Then Exit Sub
|
|
If Not _PostID().IsEmptyString And NewPostDetected Then DownloadDataUser(_PostID(), Token)
|
|
End If
|
|
_completed = True
|
|
Catch ex As Exception
|
|
If ProcessException(ex, Token, $"data downloading error [{URL}]",, eObj) = HttpStatusCode.InternalServerError Then
|
|
If round = 2 Then eObj = HttpStatusCode.InternalServerError
|
|
Else
|
|
_completed = True
|
|
End If
|
|
End Try
|
|
Loop While Not _completed
|
|
End Sub
|
|
Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken)
|
|
Dim eObj% = 0
|
|
Dim round% = 0
|
|
Dim URL$ = String.Empty
|
|
Dim _completed As Boolean = False
|
|
Do
|
|
round += 1
|
|
Try
|
|
Dim PostID$ = String.Empty
|
|
Dim PostDate$, _UserID$
|
|
Dim n As EContainer, nn As EContainer, s As EContainer
|
|
Dim NewPostDetected As Boolean = False
|
|
Dim ExistsDetected As Boolean = False
|
|
Dim eCount As Predicate(Of EContainer) = Function(e) e.Count > 0
|
|
Dim lDate As Date?
|
|
|
|
If IsSavedPosts Then
|
|
URL = $"https://www.reddit.com/user/{TrueName}/saved.json?after={POST}"
|
|
Else
|
|
URL = $"https://reddit.com/r/{TrueName}/{View}.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
|
|
End If
|
|
|
|
ThrowAny(Token)
|
|
Dim r$ = Responser.GetResponse(URL)
|
|
If Not r.IsEmptyString Then
|
|
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
|
|
If w.Count > 0 Then
|
|
n = w.GetNode(ChannelJsonNodes)
|
|
If Not n Is Nothing AndAlso n.Count > 0 Then
|
|
ProgressPre.ChangeMax(n.Count)
|
|
For Each nn In n
|
|
ProgressPre.Perform()
|
|
ThrowAny(Token)
|
|
s = nn.ItemF({eCount})
|
|
If If(s?.Count, 0) > 0 Then
|
|
PostID = s.Value("name")
|
|
If PostID.IsEmptyString AndAlso s.Contains("id") Then PostID = s("id").Value
|
|
|
|
If ChannelPostsNames.Contains(PostID) Then
|
|
If ViewMode = CView.New Then ExistsDetected = True Else NewPostDetected = True 'bypass
|
|
Continue For
|
|
End If
|
|
If DownloadLimitCount.HasValue AndAlso _TotalPostsDownloaded >= DownloadLimitCount.Value Then Exit Sub
|
|
If Not DownloadLimitPost.IsEmptyString AndAlso DownloadLimitPost = PostID Then Exit Sub
|
|
If ViewMode = CView.New AndAlso DownloadLimitDate.HasValue AndAlso _TempMediaList.Count > 0 Then
|
|
With (From __u In _TempMediaList Where __u.Post.Date.HasValue Select __u.Post.Date.Value)
|
|
If .Count > 0 Then lDate = .Min Else lDate = Nothing
|
|
End With
|
|
If lDate.HasValue AndAlso lDate.Value <= DownloadLimitDate.Value Then Exit Sub
|
|
End If
|
|
|
|
If IsSavedPosts Then
|
|
If Not _TempPostsList.Contains(PostID) Then
|
|
NewPostDetected = True
|
|
_TempPostsList.Add(PostID)
|
|
Else
|
|
ExistsDetected = True
|
|
Continue For
|
|
End If
|
|
Else
|
|
NewPostDetected = True
|
|
End If
|
|
|
|
If s.Contains("created") Then PostDate = s("created").Value Else PostDate = String.Empty
|
|
_UserID = s.Value("author")
|
|
|
|
If Not IsSavedPosts AndAlso SkipExistsUsers AndAlso _ExistsUsersNames.Count > 0 AndAlso
|
|
Not _UserID.IsEmptyString AndAlso _ExistsUsersNames.Contains(_UserID) Then
|
|
If Not IsSavedPosts AndAlso Not ChannelInfo Is Nothing Then _
|
|
ChannelInfo.ChannelExistentUserNames.ListAddValue(_UserID, LNC)
|
|
Continue For
|
|
End If
|
|
|
|
ParseContainer(s, PostID, PostDate, _UserID)
|
|
End If
|
|
Next
|
|
End If
|
|
End If
|
|
End Using
|
|
If POST.IsEmptyString And ExistsDetected Then Exit Sub
|
|
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataChannel(PostID, Token)
|
|
End If
|
|
_completed = True
|
|
Catch ex As Exception
|
|
If ProcessException(ex, Token, $"channel data downloading error [{URL}]",, eObj) = HttpStatusCode.InternalServerError Then
|
|
If round = 2 Then eObj = HttpStatusCode.InternalServerError
|
|
Else
|
|
_completed = True
|
|
End If
|
|
End Try
|
|
Loop While Not _completed
|
|
End Sub
|
|
#End Region
|
|
#Region "GetUserInfo"
|
|
Private Sub GetUserInfo()
|
|
Try
|
|
If Not IsSavedPosts And ChannelInfo Is Nothing Then
|
|
Dim r$ = Responser.GetResponse($"https://reddit.com/{IIf(IsChannel, "r", "user")}/{TrueName}/about.json",, EDP.ReturnValue)
|
|
If Not r.IsEmptyString Then
|
|
Using j As EContainer = JsonDocument.Parse(r)
|
|
If Not j Is Nothing AndAlso j.Contains({"data", "subreddit"}) Then
|
|
If ID.IsEmptyString Then ID = j.Value({"data"}, "id")
|
|
With j({"data", "subreddit"})
|
|
UserSiteNameUpdate(.Value("title"))
|
|
UserDescriptionUpdate(.Value("public_description"))
|
|
Dim dir As SFile = MyFile.CutPath
|
|
Dim __getFile As Action(Of String) = Sub(ByVal img As String)
|
|
If Not img.IsEmptyString Then
|
|
Dim f As SFile = CreateFileFromUrl(img)
|
|
If Not f.Name.IsEmptyString Then
|
|
If f.Extension.IsEmptyString Then f.Extension = "jpg"
|
|
f.Path = dir.Path
|
|
If Not f.Exists Then GetWebFile(img, f, EDP.ReturnValue)
|
|
If f.Exists Then IconBannerDownloaded = True
|
|
End If
|
|
End If
|
|
End Sub
|
|
If DownloadIconBanner Then
|
|
__getFile.Invoke(.Value("icon_img"))
|
|
__getFile.Invoke(.Value("banner_img"))
|
|
End If
|
|
End With
|
|
End If
|
|
End Using
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
End Try
|
|
End Sub
|
|
#End Region
|
|
#Region "ParseContainer"
|
|
Private Function ParseContainer(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal UserID As String = Nothing,
|
|
Optional ByVal AllowReparse As Boolean = True) As Boolean
|
|
If Not e Is Nothing Then
|
|
Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
|
|
Dim eCount As Predicate(Of EContainer) = Function(item) item.Count > 0
|
|
Dim added As Boolean = True
|
|
Dim tmpUrl$ = e.Value("url").IfNullOrEmpty(e.Value({"source"}, "url"))
|
|
If Not tmpUrl.IsEmptyString AndAlso tmpUrl.StringContains({$"{SiteRedGifsKey}.com", $"{SiteGfycatKey}.com"}) Then
|
|
If SaveToCache Then
|
|
tmpUrl = e.Value({"media", "oembed"}, "thumbnail_url")
|
|
If Not tmpUrl.IsEmptyString Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, UserID), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
Else
|
|
added = False
|
|
End If
|
|
Else
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, UserID), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
End If
|
|
ElseIf CreateImgurMedia(tmpUrl, PostID, PostDate, UserID, IsChannel) Then
|
|
_TotalPostsDownloaded += 1
|
|
ElseIf DownloadGallery(e, PostID, PostDate, UserID, SaveToCache) Then
|
|
_TotalPostsDownloaded += 1
|
|
ElseIf Not If(e({"media"}, "type")?.Value, String.Empty).IsEmptyString Then
|
|
With e("media")
|
|
Dim t$ = .Item("type").Value
|
|
Select Case t
|
|
Case "gallery" : If DownloadGallery(.Self, PostID, PostDate) Then _TotalPostsDownloaded += 1 Else added = False
|
|
Case "image", "gifvideo"
|
|
|
|
Dim resolution As Sizes = Nothing
|
|
Dim content As Sizes = Nothing
|
|
Dim chosenVal$ = String.Empty
|
|
ParseResolutions(e("media"), e("preview"), resolution)
|
|
If .Contains("content") Then
|
|
content = CreateSize(.Self, "content")
|
|
If content.HasError Or content.Data.IsEmptyString Then content = Nothing
|
|
End If
|
|
|
|
If UPicType(t) = UTypes.Picture Then
|
|
If Not content.Data.IsEmptyString Then
|
|
If Not resolution.Data.IsEmptyString Then
|
|
If content.Value >= resolution.Value AndAlso TryImage(content.Data) Then
|
|
chosenVal = content.Data
|
|
Else
|
|
chosenVal = resolution.Data
|
|
End If
|
|
Else
|
|
chosenVal = content.Data
|
|
End If
|
|
Else
|
|
chosenVal = resolution.Data
|
|
End If
|
|
Else
|
|
If Not resolution.Data.IsEmptyString Then
|
|
chosenVal = resolution.Data
|
|
ElseIf Not content.Data.IsEmptyString Then
|
|
chosenVal = content.Data
|
|
End If
|
|
End If
|
|
|
|
If Not chosenVal.IsEmptyString Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UPicType(t), chosenVal, PostID, PostDate, UserID), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
Else
|
|
added = False
|
|
End If
|
|
Case "video"
|
|
If UseM3U8 AndAlso .Item("hlsUrl").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, .Value("hlsUrl"), PostID, PostDate, UserID), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
ElseIf Not UseM3U8 AndAlso .Item("fallback_url").XmlIfNothingValue("/").ToLower.Contains("mp4") Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, .Value("fallback_url"), PostID, PostDate, UserID), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
Else
|
|
added = False
|
|
End If
|
|
Case Else : added = False
|
|
End Select
|
|
End With
|
|
ElseIf Not If(e({"media", "reddit_video"}, "fallback_url")?.Value, String.Empty).IsEmptyString Then
|
|
tmpUrl = e({"media", "reddit_video"}, "fallback_url").Value
|
|
If SaveToCache Then
|
|
tmpUrl = GetVideoRedditPreview(e)
|
|
If Not tmpUrl.IsEmptyString Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, UserID, False), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
Else
|
|
added = False
|
|
End If
|
|
ElseIf UseM3U8 AndAlso Not If(e({"media", "reddit_video"}, "hls_url")?.Value, String.Empty).IsEmptyString Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, e.Value({"media", "reddit_video"}, "hls_url"), PostID, PostDate, UserID), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
Else
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, tmpUrl, PostID, PostDate, UserID), LNC)
|
|
_TotalPostsDownloaded += 1
|
|
End If
|
|
Else
|
|
added = False
|
|
End If
|
|
If Not added Then
|
|
If AllowReparse Then
|
|
If If(e.ItemF({"crosspost_parent_list", 0})?.Count, 0) > 0 Then
|
|
added = ParseContainer(e.ItemF({"crosspost_parent_list", 0}), PostID, PostDate, UserID, True)
|
|
Else
|
|
Dim tPostId$ = e.Value(Node_CrosspostParent).IfNullOrEmpty(e.Value(Node_CrosspostParentId)).IfNullOrEmpty(e.Value(Node_CrosspostRootId))
|
|
If Not PostID.IsEmptyString Then
|
|
Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
|
|
If Not r.IsEmptyString Then
|
|
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
|
|
If j.ListExists Then
|
|
With j.ItemF({0, "data", "children", 0, "data"})
|
|
If .ListExists Then added = ParseContainer(.Self, PostID, PostDate, UserID, False)
|
|
End With
|
|
End If
|
|
End Using
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
If Not added Then
|
|
Dim node As EContainer = e({"source", "url"})
|
|
Dim tmpType As UTypes = UTypes.Undefined
|
|
If Not If(node?.Value, String.Empty).IsEmptyString Then
|
|
With node.Value.ToLower
|
|
Select Case True
|
|
Case .Contains(SiteRedGifsKey), .Contains(SiteGfycatKey) : If Not SaveToCache Then tmpType = UTypes.VideoPre
|
|
Case .Contains("m3u8") : If Settings.UseM3U8 And Not SaveToCache Then tmpType = UTypes.m3u8
|
|
Case .Contains(".gif") And TryFile(node.Value) : tmpType = UTypes.GIF
|
|
Case TryFile(node.Value) : tmpType = UTypes.Picture
|
|
Case Else : tmpType = UTypes.Undefined
|
|
End Select
|
|
End With
|
|
If Not tmpType = UTypes.Undefined Then
|
|
_TempMediaList.ListAddValue(MediaFromData(tmpType, node.Value, PostID, PostDate, UserID), LNC)
|
|
added = True
|
|
End If
|
|
End If
|
|
If Not added And e.Contains("preview") Then
|
|
With e.ItemF({"preview", "images", eCount})
|
|
If .ListExists Then
|
|
tmpType = UTypes.Undefined
|
|
tmpUrl = String.Empty
|
|
Dim sv$ = .Value({"source"}, "url")
|
|
If Not sv.IsEmptyString AndAlso sv.Contains(".gif") Then
|
|
tmpUrl = .Value({"variants", "gif", "source"}, "url")
|
|
If Not tmpUrl.IsEmptyString Then tmpType = UTypes.GIF
|
|
End If
|
|
If tmpUrl.IsEmptyString Then
|
|
tmpUrl = .Value({"variants", "mp4", "source"}, "url")
|
|
If Not tmpUrl.IsEmptyString Then tmpType = UTypes.Video
|
|
End If
|
|
If tmpUrl.IsEmptyString Then
|
|
tmpUrl = .Value({"source"}, "url")
|
|
If Not tmpUrl.IsEmptyString Then tmpType = UTypes.Picture
|
|
End If
|
|
If Not tmpUrl.IsEmptyString And Not tmpType = UTypes.Undefined Then
|
|
Dim m As UserMedia = MediaFromData(tmpType, tmpUrl, PostID, PostDate, UserID)
|
|
If tmpType = UTypes.Video Then m.File.Extension = "mp4"
|
|
_TempMediaList.ListAddValue(m, LNC)
|
|
_TotalPostsDownloaded += 1
|
|
added = True
|
|
End If
|
|
End If
|
|
End With
|
|
End If
|
|
End If
|
|
End If
|
|
Return added
|
|
Else
|
|
Return False
|
|
End If
|
|
End Function
|
|
Private Function TryImage(ByVal URL As String) As Boolean
|
|
Try
|
|
Dim img As Image = GetImage(SFile.GetBytesFromNet(URL, EDP.ThrowException), EDP.ThrowException)
|
|
If Not img Is Nothing Then
|
|
img.Dispose()
|
|
Return True
|
|
Else
|
|
Return False
|
|
End If
|
|
Catch
|
|
Return False
|
|
End Try
|
|
End Function
|
|
#End Region
|
|
#Region "Download Base Functions"
|
|
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), LNC)
|
|
ElseIf _URL.Contains(".gifv") Then
|
|
If SaveToCache Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL.Replace(".gifv", ".gif"), PostID, PostDate, _UserID), LNC)
|
|
Else
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL.Replace(".gifv", ".mp4"), PostID, PostDate, _UserID), LNC)
|
|
End If
|
|
ElseIf _URL.Contains(".mp4") Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL, PostID, PostDate, _UserID), LNC)
|
|
ElseIf _URL.Contains(".gif") Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID), LNC)
|
|
Else
|
|
Dim obj As IEnumerable(Of UserMedia) = Imgur.Envir.GetVideoInfo(_URL, EDP.ReturnValue)
|
|
If Not obj.ListExists Then
|
|
If Not TryFile(_URL) Then _URL &= ".jpg"
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID), LNC)
|
|
Else
|
|
Dim ut As UTypes
|
|
Dim m As UserMedia
|
|
For Each data As UserMedia In obj
|
|
With data
|
|
If Not .URL.IsEmptyString Then
|
|
If Not .File.IsEmptyString Then
|
|
Select Case .File.Extension
|
|
Case "jpg", "png", "jpeg" : ut = UTypes.Picture
|
|
Case "gifv" : ut = IIf(SaveToCache, UTypes.Picture, UTypes.Video)
|
|
Case "mp4" : ut = UTypes.Video
|
|
Case "gif" : ut = UTypes.GIF
|
|
Case Else : ut = UTypes.Picture : .File.Extension = "jpg"
|
|
End Select
|
|
m = MediaFromData(ut, _URL, PostID, PostDate, _UserID)
|
|
m.URL = .URL
|
|
m.File = .File.File
|
|
_TempMediaList.ListAddValue(m, LNC)
|
|
End If
|
|
End If
|
|
End With
|
|
Next
|
|
End If
|
|
End If
|
|
Return True
|
|
Else
|
|
Return False
|
|
End If
|
|
End Function
|
|
Private Function DownloadGallery(ByVal e 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
|
|
Dim added As Boolean = False
|
|
Dim node As EContainer = Nothing
|
|
If e.Contains("media_metadata") Then
|
|
node = e("media_metadata")
|
|
ElseIf e.Contains("mediaMetadata") Then
|
|
node = e("mediaMetadata")
|
|
End If
|
|
If If(node?.Count, 0) > 0 Then
|
|
Dim t As EContainer
|
|
For Each n As EContainer In node
|
|
t = n.ItemF({"s", "u"})
|
|
If Not t Is Nothing AndAlso Not t.Value.IsEmptyString Then
|
|
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, t.Value, PostID, PostDate, _UserID), LNC)
|
|
added = True
|
|
If FirstOnly Then Exit For
|
|
End If
|
|
Next
|
|
End If
|
|
Return added
|
|
Catch ex As Exception
|
|
ProcessException(ex, Nothing, "gallery parsing error", False)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
Private Function GetVideoRedditPreview(ByVal Node As EContainer) As String
|
|
Try
|
|
If Not Node Is Nothing Then
|
|
Dim n As EContainer = Node.ItemF({"preview", "images", 0})
|
|
Dim DestNode$() = Nothing
|
|
If If(n?.Count, 0) > 0 Then Return ParseResolutions(n)
|
|
End If
|
|
Return String.Empty
|
|
Catch ex As Exception
|
|
ProcessException(ex, Nothing, "reddit video preview parsing error", False)
|
|
Return String.Empty
|
|
End Try
|
|
End Function
|
|
Private Function ParseResolutions(ByVal Node As EContainer, Optional ByVal PreviewNode As EContainer = Nothing,
|
|
Optional ByRef SResult As Sizes = Nothing) As String
|
|
Try
|
|
If If(Node?.Count, 0) > 0 Then
|
|
Dim DestNode$() = Nothing
|
|
If If(Node("resolutions")?.Count, 0) > 0 Then
|
|
DestNode = {"resolutions"}
|
|
ElseIf If(Node({"variants", "nsfw", "resolutions"})?.Count, 0) > 0 Then
|
|
DestNode = {"variants", "nsfw", "resolutions"}
|
|
End If
|
|
If Not DestNode Is Nothing Then
|
|
With Node(DestNode)
|
|
Dim sl As List(Of Sizes) = .Select(Function(e) CreateSize(e)).
|
|
ListWithRemove(Function(ss) ss.HasError Or ss.Data.IsEmptyString)
|
|
If If(PreviewNode?.Count, 0) > 0 Then
|
|
Dim sp As Sizes = CreateSize(PreviewNode)
|
|
If Not sp.HasError And Not sp.Data.IsEmptyString Then
|
|
If sl Is Nothing Then sl = New List(Of Sizes)
|
|
sl.Add(sp)
|
|
End If
|
|
End If
|
|
If sl.ListExists Then
|
|
Dim s As Sizes
|
|
sl.Sort()
|
|
s = sl.First
|
|
sl.Clear()
|
|
SResult = s
|
|
Return s.Data
|
|
End If
|
|
End With
|
|
End If
|
|
End If
|
|
Return String.Empty
|
|
Catch ex As Exception
|
|
Return String.Empty
|
|
End Try
|
|
End Function
|
|
Private Function CreateSize(ByVal Node As EContainer, Optional ByVal UrlNodeName As String = "url") As Sizes
|
|
Return New Sizes(Node.Value("width"), Node.Value(UrlNodeName))
|
|
End Function
|
|
#End Region
|
|
#Region "ReparseVideo"
|
|
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
|
|
Dim RedGifsResponser As Responser = Nothing
|
|
Try
|
|
ThrowAny(Token)
|
|
Const v2 As UTypes = UTypes.VideoPre + UTypes.m3u8
|
|
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(p) p.Type = UTypes.VideoPre Or p.Type = v2) Then
|
|
Dim r$, v$
|
|
Dim e As New ErrorsDescriber(EDP.ReturnValue)
|
|
Dim m As UserMedia, m2 As UserMedia
|
|
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
|
|
Dim _repeatForRedgifs As Boolean
|
|
RedGifsResponser = RedGifsHost.Responser.Copy
|
|
ProgressPre.ChangeMax(_TempMediaList.Count)
|
|
For i% = _TempMediaList.Count - 1 To 0 Step -1
|
|
ThrowAny(Token)
|
|
ProgressPre.Perform()
|
|
If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then
|
|
m = _TempMediaList(i)
|
|
If _TempMediaList(i).Type = UTypes.VideoPre Then
|
|
Do
|
|
_repeatForRedgifs = False
|
|
If m.URL.Contains($"{SiteGfycatKey}.com") Then
|
|
r = Gfycat.Envir.GetVideo(m.URL)
|
|
If Not r.IsEmptyString AndAlso r.Contains("redgifs.com") Then m.URL = r : _repeatForRedgifs = True
|
|
ElseIf m.URL.Contains(SiteRedGifsKey) Then
|
|
m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost)
|
|
If m2.State = UStates.Missing Then
|
|
m.State = UStates.Missing
|
|
_ContentList.Add(m)
|
|
_TempMediaList.RemoveAt(i)
|
|
ElseIf m2.State = RedGifs.UserData.DataGone Then
|
|
_TempMediaList.RemoveAt(i)
|
|
Else
|
|
m2.URL_BASE = m.URL
|
|
m2.Post = m.Post
|
|
_TempMediaList(i) = m2
|
|
End If
|
|
Continue For
|
|
Else
|
|
r = Responser.GetResponse(m.URL,, e)
|
|
End If
|
|
Loop While _repeatForRedgifs
|
|
Else
|
|
r = m.URL
|
|
End If
|
|
_TempMediaList(i) = New UserMedia
|
|
If Not r.IsEmptyString Then
|
|
v = RegexReplace(r, VideoRegEx)
|
|
If Not v.IsEmptyString Then
|
|
_TempMediaList(i) = New UserMedia With {.Type = UTypes.Video, .URL = v, .File = v, .Post = m.Post}
|
|
Else
|
|
_TempMediaList.RemoveAt(i)
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
Catch ex As Exception
|
|
ProcessException(ex, Token, "video reparsing error", False)
|
|
Finally
|
|
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
|
|
ProgressPre.Done()
|
|
End Try
|
|
End Sub
|
|
#End Region
|
|
#Region "ReparseMissing"
|
|
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
|
|
Dim rList As New List(Of Integer)
|
|
Dim RedGifsResponser As Responser = Nothing
|
|
Try
|
|
If Not ChannelInfo Is Nothing Or SaveToCache Then Exit Sub
|
|
If ContentMissingExists Then
|
|
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
|
|
RedGifsResponser = RedGifsHost.Responser.Copy
|
|
Dim m As UserMedia, m2 As UserMedia
|
|
Dim r$
|
|
Dim j As EContainer
|
|
Dim lastCount%, li%
|
|
ProgressPre.ChangeMax(_ContentList.Count)
|
|
For i% = 0 To _ContentList.Count - 1
|
|
m = _ContentList(i)
|
|
ProgressPre.Perform()
|
|
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
|
|
ThrowAny(Token)
|
|
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
|
|
If Not r.IsEmptyString Then
|
|
j = JsonDocument.Parse(r, EDP.ReturnValue)
|
|
If Not j Is Nothing Then
|
|
If j.Count > 0 Then
|
|
lastCount = _TempMediaList.Count
|
|
With j.GetNode(SingleJsonNodes)
|
|
If .ListExists AndAlso ParseContainer(.Self, m.Post.ID, String.Empty) Then
|
|
If lastCount <> _TempMediaList.Count Then
|
|
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
|
|
m2 = _TempMediaList(i)
|
|
m2.Post.Date = m.Post.Date
|
|
m2.State = UStates.Missing
|
|
m2.Attempts = m.Attempts
|
|
_TempMediaList(i) = m2
|
|
Next
|
|
End If
|
|
rList.Add(i)
|
|
End If
|
|
End With
|
|
End If
|
|
j.Dispose()
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
Catch ex As Exception
|
|
ProcessException(ex, Token, "missing data downloading error")
|
|
Finally
|
|
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
|
|
If rList.Count > 0 Then
|
|
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
|
|
rList.Clear()
|
|
End If
|
|
ProgressPre.Done()
|
|
End Try
|
|
End Sub
|
|
#End Region
|
|
#Region "DownloadSingleObject"
|
|
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
|
|
Dim __id$ = RegexReplace(Data.URL, RParams.DMS("comments/([^/]+)", 1, EDP.ReturnValue))
|
|
If Not __id.IsEmptyString Then
|
|
User.File = Data.File
|
|
User.File.Name = String.Empty
|
|
User.File.Extension = String.Empty
|
|
_ContentList.Add(New UserMedia With {.State = UStates.Missing, .Post = __id})
|
|
ReparseMissing(Token)
|
|
ReparseVideo(Token)
|
|
End If
|
|
End Sub
|
|
#End Region
|
|
#Region "Structure creator"
|
|
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
|
|
Optional ByVal _UserID As String = "", Optional ByVal ReplacePreview As Boolean = True) As UserMedia
|
|
If _URL.IsEmptyString And t = UTypes.Picture Then Return Nothing
|
|
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
|
|
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}}
|
|
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CreateFileFromUrl(m.URL) Else m.File = Nothing
|
|
If ReplacePreview And m.URL.Contains("preview") And Not t = UTypes.Picture Then m.URL = $"https://i.redd.it/{m.File.File}"
|
|
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel), Nothing) Else m.Post.Date = Nothing
|
|
Return m
|
|
End Function
|
|
Private Function TryFile(ByVal URL As String) As Boolean
|
|
Try
|
|
Return Not URL.IsEmptyString AndAlso Not CreateFileFromUrl(URL).IsEmptyString
|
|
Catch ex As Exception
|
|
Return False
|
|
End Try
|
|
End Function
|
|
Protected Overrides Function CreateFileFromUrl(ByVal URL As String) As SFile
|
|
Return New SFile(CStr(RegexReplace(URL, FilesPattern)))
|
|
End Function
|
|
#End Region
|
|
#Region "DownloadContent"
|
|
Private _RedGifsResponser As Responser = Nothing
|
|
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
|
|
If _ContentNew.Count > 0 Then
|
|
Try
|
|
If Not _RedGifsResponser Is Nothing Then _RedGifsResponser.Dispose()
|
|
_RedGifsResponser = Settings(RedGifs.RedGifsSiteKey).Responser.Copy
|
|
DownloadContentDefault(Token)
|
|
Finally
|
|
If Not _RedGifsResponser Is Nothing Then _RedGifsResponser.Dispose() : _RedGifsResponser = Nothing
|
|
End Try
|
|
End If
|
|
End Sub
|
|
Protected Overrides Function DownloadContentDefault_GetRootDir() As String
|
|
If Not IsSavedPosts AndAlso (IsChannel And SaveToCache And Not ChannelInfo Is Nothing) Then
|
|
Return ChannelInfo.CachePath.PathNoSeparator
|
|
Else
|
|
Return MyBase.DownloadContentDefault_GetRootDir()
|
|
End If
|
|
End Function
|
|
Protected Overrides Sub DownloadContentDefault_PostProcessing(ByRef m As UserMedia, ByVal File As SFile, ByVal Token As CancellationToken)
|
|
m.Post.CachedFile = File
|
|
MyBase.DownloadContentDefault_PostProcessing(m, File, Token)
|
|
End Sub
|
|
Protected Overrides Function DownloadContentDefault_ProcessDownloadException() As Boolean
|
|
Return Not IsChannel Or Not SaveToCache
|
|
End Function
|
|
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
|
|
If _RedGifsResponser.DownloadFile(URL, DestinationFile, EDP.ThrowException) Then
|
|
Return DestinationFile
|
|
Else
|
|
Return Nothing
|
|
End If
|
|
End Function
|
|
Protected Overrides Function ValidateDownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByRef Interrupt As Boolean) As Boolean
|
|
Return URL.Contains(SiteRedGifsKey)
|
|
End Function
|
|
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
|
|
Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
|
|
End Function
|
|
Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
|
|
If Not IsChannel Or Not SaveToCache Then
|
|
Return MyBase.ChangeFileNameByProvider(f, m)
|
|
Else
|
|
Return f
|
|
End If
|
|
End Function
|
|
#End Region
|
|
#Region "Exception"
|
|
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
|
|
Optional ByVal EObj As Object = Nothing) As Integer
|
|
With Responser
|
|
If .StatusCode = HttpStatusCode.NotFound Then
|
|
UserExists = False
|
|
ElseIf .StatusCode = HttpStatusCode.Forbidden Then
|
|
UserSuspended = True
|
|
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then
|
|
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
|
|
Throw New Plugin.ExitException With {.Silent = True}
|
|
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
|
|
Return 1
|
|
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then
|
|
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit credentials expired ({ToString()})"
|
|
MySiteSettings.SessionInterrupted = True
|
|
Throw New Plugin.ExitException With {.Silent = True}
|
|
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then
|
|
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
|
|
Return HttpStatusCode.InternalServerError
|
|
Else
|
|
If Not FromPE Then LogError(ex, Message) : HasError = True
|
|
Return 0
|
|
End If
|
|
End With
|
|
Return 1
|
|
End Function
|
|
#End Region
|
|
#Region "IDisposable Support"
|
|
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
|
If Not disposedValue And disposing Then ChannelPostsNames.Clear() : _ExistsUsersNames.Clear() : _CrossPosts.Clear()
|
|
MyBase.Dispose(disposing)
|
|
End Sub
|
|
#End Region
|
|
End Class
|
|
End Namespace |