[\r\n\s]*?\<[^\>]*?alt=""([^""]*)"""
albumName = StringTrim(RegexReplace(r, albumRegex))
If albumName.IsEmptyString Then albumName = block.AlbumID
- Using j As EContainer = JsonDocument.Parse("{" & block.Data & "}", jErr)
- If Not j Is Nothing Then
- If If(j("urls")?.Count, 0) > 0 Then
- _TempMediaList.ListAddList(j("urls").Select(Function(jj) _
- New UserMedia(jj.ItemF({0}).XmlIfNothingValue, UTypes.Picture) With {
- .SpecialFolder = $"Albums\{albumName}\"}), LNC)
- End If
+ j = JsonDocument.Parse("{" & block.Data & "}", jErr)
+ If Not j Is Nothing Then
+ If If(j("urls")?.Count, 0) > 0 Then
+ _TempMediaList.ListAddList(j("urls").Select(Function(jj) _
+ New UserMedia(jj.ItemF({0}).XmlIfNothingValue, UTypes.Picture) With {
+ .SpecialFolder = $"Albums\{albumName}\",
+ .File = CreatePhotoFile(.URL, .File)}), LNC)
End If
- End Using
+ j.Dispose()
+ End If
Next
l.Clear()
End If
@@ -444,7 +456,9 @@ Namespace API.PornHub
If Not r.IsEmptyString Then
url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto)
If Not url.IsEmptyString Then _
- _TempMediaList.ListAddValue(New UserMedia(url, UTypes.Picture) With {.SpecialFolder = $"Albums\{AlbumName}\"}, LNC)
+ _TempMediaList.ListAddValue(New UserMedia(url, UTypes.Picture) With {
+ .SpecialFolder = $"Albums\{AlbumName}\",
+ .File = CreatePhotoFile(url, .File)}, LNC)
End If
Catch
End Try
@@ -468,7 +482,7 @@ Namespace API.PornHub
If r.Contains(HtmlPageNotFoundPhoto) Then Return False
Dim urls As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
If urls.ListExists Then
- Dim NewUrl$
+ Dim NewUrl$, pFile$
Dim m As UserMedia
Dim l2 As List(Of UserMedia) = urls.Select(Function(__url) New UserMedia(__url, UTypes.Picture) With {
.Post = __url.Split("/").LastOrDefault}).ToList
@@ -487,7 +501,8 @@ Namespace API.PornHub
NewUrl = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto)
If Not NewUrl.IsEmptyString Then
m.URL = NewUrl
- m.File = NewUrl
+ pFile = RegexReplace(NewUrl, Regex_Photo_File)
+ If Not pFile.IsEmptyString Then m.File = pFile Else m.File = NewUrl
_TempPostsList.ListAddValue(m.Post.ID, LNC)
Else
Throw New Exception
@@ -511,13 +526,17 @@ Namespace API.PornHub
#End Region
#End Region
#Region "ReparseVideo"
- Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
+ Protected Overloads Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
+ ReparseVideo(Token, False)
+ End Sub
+ Protected Overloads Sub ReparseVideo(ByVal Token As CancellationToken, ByVal CreateFileName As Boolean,
+ Optional ByRef Data As IYouTubeMediaContainer = Nothing)
Const ERR_NEW_URL$ = "ERR_NEW_URL"
Dim URL$ = String.Empty
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia
- Dim r$, NewUrl$
+ Dim r$, NewUrl$, tmpName$
For i% = _TempMediaList.Count - 1 To 0 Step -1
If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i)
@@ -532,6 +551,14 @@ Namespace API.PornHub
Else
m.URL = NewUrl
m.Type = UTypes.m3u8
+ If CreateFileName Then
+ tmpName = RegexReplace(r, RegexVideoPageTitle)
+ If Not tmpName.IsEmptyString Then
+ If Not Data Is Nothing Then Data.Title = tmpName
+ m.File.Name = TitleHtmlConverter(tmpName)
+ m.File.Extension = "mp4"
+ End If
+ End If
_TempMediaList(i) = m
End If
Else
@@ -565,7 +592,7 @@ Namespace API.PornHub
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
- r = Responser.Curl(m.URL_BASE, eCurl)
+ r = Responser.Curl(m.URL_BASE,, eCurl)
If Not r.IsEmptyString Then
Dim NewUrl$ = CreateVideoURL(r)
If Not NewUrl.IsEmptyString Then
@@ -591,12 +618,12 @@ Namespace API.PornHub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
- Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
- Return M3U8.Download(URL, Responser, DestinationFile)
+ 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, Responser, DestinationFile, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing))
End Function
#End Region
#Region "CreateVideoURL"
- Private Shared Function CreateVideoURL(ByVal r As String) As String
+ Private Function CreateVideoURL(ByVal r As String) As String
Try
Dim OutStr$ = String.Empty
If Not r.IsEmptyString Then
@@ -619,26 +646,18 @@ Namespace API.PornHub
End If
Return OutStr
Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
+ Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
End Try
End Function
#End Region
-#Region "Standalone downloader"
- Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Responser, ByVal Destination As SFile) As UserMedia
- Try
- Dim r$ = Responser.Curl(URL)
- If Not r.IsEmptyString Then
- Dim NewUrl$ = CreateVideoURL(r)
- If Not NewUrl.IsEmptyString Then
- Dim f As SFile = M3U8.Download(NewUrl, Responser, Destination)
- If Not f.IsEmptyString Then Return New UserMedia With {.State = UserMedia.States.Downloaded}
- End If
- End If
- Return Nothing
- Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"PornHub standalone download error: [{URL}]", New UserMedia)
- End Try
- End Function
+#Region "DownloadSingleObject"
+ Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
+ _TempMediaList.Add(New UserMedia(Data.URL, UTypes.VideoPre))
+ ReparseVideo(Token, True, Data)
+ End Sub
+ Protected Overrides Sub DownloadSingleObject_PostProcessing(ByVal Data As IYouTubeMediaContainer, Optional ByVal ResetTitle As Boolean = True)
+ MyBase.DownloadSingleObject_PostProcessing(Data, False)
+ End Sub
#End Region
#Region "Exceptions"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String,
diff --git a/SCrawler/API/PornHub/UserExchangeOptions.vb b/SCrawler/API/PornHub/UserExchangeOptions.vb
index 9ccc4b4..8906308 100644
--- a/SCrawler/API/PornHub/UserExchangeOptions.vb
+++ b/SCrawler/API/PornHub/UserExchangeOptions.vb
@@ -6,18 +6,24 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
+Imports SCrawler.Plugin.Attributes
Namespace API.PornHub
Friend Class UserExchangeOptions
+
Friend Property DownloadGifs As Boolean
+
Friend Property DownloadPhotoOnlyFromModelHub As Boolean
+ Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
DownloadGifs = u.DownloadGifs
DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
+ MySettings = u.HOST.Source
End Sub
Friend Sub New(ByVal s As SiteSettings)
Dim v As CheckState = CInt(s.DownloadGifs.Value)
DownloadGifs = Not v = CheckState.Unchecked
DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value
+ MySettings = s
End Sub
End Class
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Reddit/Channel.vb b/SCrawler/API/Reddit/Channel.vb
index fcc9d25..37cf9e7 100644
--- a/SCrawler/API/Reddit/Channel.vb
+++ b/SCrawler/API/Reddit/Channel.vb
@@ -258,7 +258,8 @@ Namespace API.Reddit
.Progress = p,
.SaveToCache = True,
.SkipExistsUsers = SkipExists,
- .ChannelInfo = Me
+ .ChannelInfo = Me,
+ .IsChannel = True
}
With d
.SetEnvironment(HOST, CUser, False)
@@ -306,7 +307,7 @@ Namespace API.Reddit
Friend Function GetEnumerator() As IEnumerator(Of UserPost) Implements IEnumerable(Of UserPost).GetEnumerator
Return New MyEnumerator(Of UserPost)(Me)
End Function
- Friend Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
+ Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
#End Region
@@ -373,7 +374,7 @@ Namespace API.Reddit
Dim l As New List(Of String)
If Posts.Count > 0 Or PostsLatest.Count > 0 Then l.ListAddList((From p In PostsAll Where Not p.ID.IsEmptyString Select p.ID), LNC)
l.ListAddList(PostsNames, LNC)
- If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendInLog)
+ If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendToLog)
End If
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}
x.Add(Name_Name, Name)
@@ -418,7 +419,7 @@ Namespace API.Reddit
CountOfAddedUsers.Clear()
CountOfLoadedPostsPerSession.Clear()
ChannelExistentUserNames.Clear()
- CachePath.Delete(SFO.Path, SFODelete.None, EDP.SendInLog)
+ CachePath.Delete(SFO.Path, SFODelete.None, EDP.SendToLog)
End If
disposedValue = True
End If
diff --git a/SCrawler/API/Reddit/ChannelsCollection.vb b/SCrawler/API/Reddit/ChannelsCollection.vb
index 799c496..ddaa9f7 100644
--- a/SCrawler/API/Reddit/ChannelsCollection.vb
+++ b/SCrawler/API/Reddit/ChannelsCollection.vb
@@ -55,7 +55,7 @@ Namespace API.Reddit
Return Nothing
End If
Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.ChannelsCollection.GetUserFiles]")
+ Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Reddit.ChannelsCollection.GetUserFiles]")
End Try
End Function
Friend Sub UpdateUsersStats()
diff --git a/SCrawler/API/Reddit/Declarations.vb b/SCrawler/API/Reddit/Declarations.vb
index bd114d7..be26dae 100644
--- a/SCrawler/API/Reddit/Declarations.vb
+++ b/SCrawler/API/Reddit/Declarations.vb
@@ -15,10 +15,12 @@ Namespace API.Reddit
Friend ReadOnly JsonNodesJson() As NodeParams = {New NodeParams("posts", True, True, True, True, 3)}
Friend ReadOnly ChannelJsonNodes() As NodeParams = {New NodeParams("data", True, True, True, True, 1),
New NodeParams("children", True, True, True)}
+ Friend ReadOnly SingleJsonNodes() As NodeParams = {New NodeParams("data", True, True, True, True, 2),
+ New NodeParams("children", True, True, True),
+ New NodeParams("data", True, True, True, True, 1)}
Friend ReadOnly UrlBasePattern As RParams = RParams.DM("(?<=/)([^/]+?\.[\w]{3,4})(?=(\?|\Z))", 0)
Friend ReadOnly VideoRegEx As RParams = RParams.DM("http.{0,1}://[^" & Chr(34) & "]+?mp4", 0)
Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Cultures.EUR)
- Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicodeJS(v, n, e))
- Friend ReadOnly DateProviderChannel As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(AConvert(Of Integer)(v, EUR_PROVIDER, v), n, e))
+ Friend ReadOnly UnixDate32ProviderReddit As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnix32(AConvert(Of Integer)(v, EUR_PROVIDER, v), n, e))
End Module
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Reddit/M3U8.vb b/SCrawler/API/Reddit/M3U8.vb
index 7578d65..4581c8f 100644
--- a/SCrawler/API/Reddit/M3U8.vb
+++ b/SCrawler/API/Reddit/M3U8.vb
@@ -7,8 +7,11 @@
' 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.Reddit.M3U8_Declarations
+Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
+Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Reddit
Namespace M3U8_Declarations
@@ -19,7 +22,7 @@ Namespace API.Reddit
''' Audio, Video
Friend ReadOnly PlayListRegEx_2 As RParams = RParams.DM("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", 0, RegexReturn.List)
Friend ReadOnly PlayListAudioRegEx As RParams = RParams.DM("(HLS_AUDIO_(\d+)[^""]+)", 0, RegexReturn.List)
- Friend ReadOnly DPED As New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue)
+ Friend ReadOnly DPED As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue)
End Module
End Namespace
Friend NotInheritable Class M3U8 : Implements IDisposable
@@ -52,9 +55,12 @@ Namespace API.Reddit
Private OutFile As SFile
Private VideoFile As SFile
Private AudioFile As SFile
- Private CachePath As SFile
+ Private ReadOnly Cache As CacheKeeper
+ Private ReadOnly CacheFiles As CacheKeeper
+ Private ReadOnly Property Progress As MyProgress
+ Private ReadOnly ProgressExists As Boolean
#End Region
- Private Sub New(ByVal URL As String, ByVal OutFile As SFile)
+ Private Sub New(ByVal URL As String, ByVal OutFile As SFile, ByVal Progress As MyProgress)
PlayListURL = URL
BaseURL = RegexReplace(URL, BaseUrlPattern)
Video = New List(Of String)
@@ -62,7 +68,10 @@ Namespace API.Reddit
Me.OutFile = OutFile
Me.OutFile.Name = "PlayListFile"
Me.OutFile.Extension = "mp4"
- CachePath = $"{OutFile.PathWithSeparator}_Cache\{SFile.GetDirectories($"{OutFile.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\"
+ Me.Progress = Progress
+ ProgressExists = Not Me.Progress Is Nothing
+ Cache = New CacheKeeper($"{OutFile.PathWithSeparator}_{Base.M3U8Base.TempCacheFolderName}\")
+ CacheFiles = Cache.NewInstance
End Sub
#Region "Internal functions"
#Region "GetPlaylistUrls"
@@ -78,7 +87,7 @@ Namespace API.Reddit
If Not r.IsEmptyString Then
Dim l As New List(Of Resolution)
If Type = Types.Video Then
- l = RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4})
+ l = RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4}, EDP.ReturnValue)
Else
Try
l = RegexFields(Of Resolution)(r, {PlayListAudioRegEx}, {1, 2})
@@ -112,41 +121,44 @@ Namespace API.Reddit
End Function
#End Region
#Region "ConcatData"
- Private Overloads Sub ConcatData()
- ConcatData(Video, Types.Video, VideoFile)
- ConcatData(Audio, Types.Audio, AudioFile)
+ Private Overloads Sub ConcatData(ByVal Token As CancellationToken)
+ ConcatData(Video, Types.Video, VideoFile, Token)
+ ConcatData(Audio, Types.Audio, AudioFile, Token)
MergeFiles()
End Sub
- Private Overloads Sub ConcatData(ByVal Urls As List(Of String), ByVal Type As Types, ByRef TFile As SFile)
+ Private Overloads Sub ConcatData(ByVal Urls As List(Of String), ByVal Type As Types, ByRef TFile As SFile, ByVal Token As CancellationToken)
Try
+ Token.ThrowIfCancellationRequested()
If Urls.ListExists Then
- Dim ConcatFile As SFile = OutFile
+ Dim tmpCache As CacheKeeper = CacheFiles.NewInstance
+ Dim ConcatFile As SFile = CacheFiles
If Type = Types.Audio Then
- ConcatFile.Name &= "_AUDIO"
+ ConcatFile.Name &= "AUDIO"
ConcatFile.Extension = "aac"
Else
- If Audio.Count > 0 Then ConcatFile.Name &= "_VIDEO"
+ If Audio.Count > 0 Then ConcatFile.Name &= "VIDEO"
ConcatFile.Extension = "mp4"
End If
- If CachePath.Exists(SFO.Path) Then
- Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General})
- ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ThrowException)
+ If tmpCache.Validate Then
Dim i%
- Dim eFiles As New List(Of SFile)
- Dim dFile As SFile = CachePath
+ Dim dFile As SFile = tmpCache.RootDirectory
+ If ProgressExists Then Progress.Maximum += Urls.Count
dFile.Extension = New SFile(Urls(0)).Extension
If dFile.Extension.IsEmptyString Then dFile.Extension = "ts"
Using w As New WebClient
For i = 0 To Urls.Count - 1
+ If ProgressExists Then Progress.Perform()
+ Token.ThrowIfCancellationRequested()
dFile.Name = $"ConPart_{i}"
w.DownloadFile(Urls(i), dFile)
- eFiles.Add(dFile)
+ tmpCache.AddFile(dFile, True)
Next
End Using
- TFile = FFMPEG.ConcatenateFiles(eFiles, Settings.FfmpegFile, ConcatFile, p, DPED)
- eFiles.Clear()
+ TFile = FFMPEG.ConcatenateFiles(tmpCache, Settings.FfmpegFile.File, ConcatFile, Settings.CMDEncoding,, DPED)
End If
End If
+ Catch oex As OperationCanceledException When Token.IsCancellationRequested
+ Throw oex
Catch ex As Exception
ErrorsDescriber.Execute(DPED, ex, $"[M3U8.Save({Type})]")
End Try
@@ -154,25 +166,27 @@ Namespace API.Reddit
#End Region
Private Sub MergeFiles()
Try
+ Dim p As SFileNumbers = SFileNumbers.Default(OutFile.Name)
+ Dim f As SFile = SFile.IndexReindex(OutFile,,, p, EDP.ReturnValue)
If Not VideoFile.IsEmptyString And Not AudioFile.IsEmptyString Then
- Dim p As New SFileNumbers(OutFile.Name,, RParams.DMS("PlayListFile_(\d*)", 1), New ANumbers With {.Format = ANumbers.Formats.General})
- OutFile = FFMPEG.MergeFiles({VideoFile, AudioFile}, Settings.FfmpegFile, OutFile, p, DPED)
+ OutFile = FFMPEG.MergeFiles({VideoFile, AudioFile}, Settings.FfmpegFile.File, f, Settings.CMDEncoding, p, DPED)
Else
- OutFile = VideoFile
+ If f.IsEmptyString Then f = OutFile
+ If Not SFile.Move(VideoFile, f) Then OutFile = VideoFile
End If
Catch ex As Exception
ErrorsDescriber.Execute(DPED, ex, $"[M3U8.MergeFiles]")
End Try
End Sub
- Friend Function Download() As SFile
+ Friend Function Download(ByVal Token As CancellationToken) As SFile
GetPlaylistUrls()
- ConcatData()
+ ConcatData(Token)
Return OutFile
End Function
#End Region
#Region "Statics"
- Friend Shared Function Download(ByVal URL As String, ByVal f As SFile) As SFile
- Using m As New M3U8(URL, f) : Return m.Download() : End Using
+ Friend Shared Function Download(ByVal URL As String, ByVal f As SFile, ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile
+ Using m As New M3U8(URL, f, Progress) : Return m.Download(Token) : End Using
End Function
#End Region
#Region "IDisposable Support"
@@ -182,7 +196,7 @@ Namespace API.Reddit
If disposing Then
Video.Clear()
Audio.Clear()
- CachePath.Delete(SFO.Path, SFODelete.None, DPED)
+ Cache.Dispose()
End If
disposedValue = True
End If
diff --git a/SCrawler/API/Reddit/RedditViewSettingsForm.vb b/SCrawler/API/Reddit/RedditViewSettingsForm.vb
index e65fe0e..7ed1653 100644
--- a/SCrawler/API/Reddit/RedditViewSettingsForm.vb
+++ b/SCrawler/API/Reddit/RedditViewSettingsForm.vb
@@ -18,7 +18,7 @@ Namespace API.Reddit
MyOptions = opt
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
- Private Sub ChannelSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
+ Private Sub RedditViewSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
Dim n$ = String.Empty
If TypeOf MyOptions Is Channel Then
diff --git a/SCrawler/API/Reddit/SiteSettings.vb b/SCrawler/API/Reddit/SiteSettings.vb
index df6aaf2..8aa0bba 100644
--- a/SCrawler/API/Reddit/SiteSettings.vb
+++ b/SCrawler/API/Reddit/SiteSettings.vb
@@ -38,31 +38,28 @@ Namespace API.Reddit
End With
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UseM3U8 = New PropertyValue(True)
- UrlPatternUser = "https://www.reddit.com/user/{0}/"
- UrlPatternChannel = "https://www.reddit.com/r/{0}/"
+ UrlPatternUser = "https://www.reddit.com/{0}/{1}/"
ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
- Select Case What
- Case Download.Main : Return New UserData
- Case Download.Channel : Return New UserData With {.SaveToCache = False, .SkipExistsUsers = False, .AutoGetLimits = True}
- Case Download.SavedPosts
- Dim u As New UserData With {.IsSavedPosts = True}
- DirectCast(u, UserDataBase).User = New UserInfo With {
- .Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty)),
- .IsChannel = True
- }
- Return u
- End Select
- Return Nothing
+ Return New UserData
End Function
+ Friend Const ChannelOption As String = "r"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim l As List(Of String) = RegexReplace(UserURL, UserRegex)
- If l.ListExists(3) Then Return New ExchangeOptions(Site, l(2), l(1) = "r") Else Return Nothing
+ If l.ListExists(3) Then
+ Dim n$ = l(2)
+ If Not l(1).IsEmptyString AndAlso l(1) = ChannelOption Then n &= $"@{ChannelOption}"
+ Return New ExchangeOptions(Site, n)
+ Else
+ Return Nothing
+ End If
End Function
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try
+ Dim trueValue As Boolean = Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
+ If Not trueValue Then Return False
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit")
If dl.ListExists Then
dl = dl.Take(4).ToList
@@ -76,7 +73,7 @@ Namespace API.Reddit
dl.ListToString(vbCr) & vbCr & vbCr &
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
UpdateRedGifsToken()
- Return True
+ Return trueValue
Else
Return False
End If
@@ -84,28 +81,29 @@ Namespace API.Reddit
End If
End If
UpdateRedGifsToken()
- Return True
+ Return trueValue
Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
+ Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
End Try
End Function
Private Sub UpdateRedGifsToken()
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
End Sub
- Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
- Dim spf$ = String.Empty
- Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
- f = $"{f.PathWithSeparator}OptionalPath\"
- Return UserData.GetVideoInfo(URL, Responser, f, spf)
- End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange
If OpenForm Then
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
+ Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
+ With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, "user"), .TrueName) : End With
+ End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
- Return $"https://www.reddit.com/comments/{Media.Post.ID.Split("_").LastOrDefault}/"
+ If Not Media.Post.ID.IsEmptyString Then
+ Return $"https://www.reddit.com/comments/{Media.Post.ID.Split("_").LastOrDefault}/"
+ Else
+ Return String.Empty
+ End If
End Function
End Class
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Reddit/UserData.vb b/SCrawler/API/Reddit/UserData.vb
index 71917d2..87cbd73 100644
--- a/SCrawler/API/Reddit/UserData.vb
+++ b/SCrawler/API/Reddit/UserData.vb
@@ -10,10 +10,10 @@ 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
@@ -22,14 +22,20 @@ Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit
Friend Class UserData : Inherits UserDataBase : Implements IChannelData, 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 Shared ReadOnly Property DateTrueProvider(ByVal IsChannel As Boolean) As IFormatProvider
+ Private ReadOnly Property DateTrueProvider(ByVal IsChannel As Boolean) As IFormatProvider
Get
- Return If(IsChannel, DateProviderChannel, DateProvider)
+ Return If(IsChannel, UnixDate32ProviderReddit, UnixDate64Provider)
End Get
End Property
Private ReadOnly Property UseM3U8 As Boolean
@@ -37,6 +43,9 @@ Namespace API.Reddit
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
+#End Region
#Region "Channels Support"
#Region "IChannelLimits Support"
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
@@ -60,7 +69,7 @@ Namespace API.Reddit
#End Region
Friend Property ChannelInfo As Channel
Private ReadOnly ChannelPostsNames As List(Of String)
- Friend Property SkipExistsUsers As Boolean = True Implements IChannelData.SkipExistsUsers
+ Friend Property SkipExistsUsers As Boolean = False Implements IChannelData.SkipExistsUsers
Private ReadOnly _ExistsUsersNames As List(Of String)
Friend Property SaveToCache As Boolean = False Implements IChannelData.SaveToCache
Friend Function GetNewChannelPosts() As IEnumerable(Of UserPost)
@@ -109,17 +118,49 @@ Namespace API.Reddit
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 Sub UpdateNames()
+ 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()
+ End If
+ End If
+ End Sub
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
+ UpdateNames()
.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
@@ -133,7 +174,13 @@ Namespace API.Reddit
#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
@@ -152,7 +199,6 @@ Namespace API.Reddit
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
If IsSavedPosts Then
- 'TODO: Reddit saved posts: remove Unicode converter?
Responser.DecodersError = EDP.ReturnValue
DownloadDataChannel(String.Empty, Token)
ElseIf IsChannel Then
@@ -183,257 +229,195 @@ Namespace API.Reddit
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)
- Const CPRI$ = "crosspostRootId"
- Const CPPI$ = "crosspostParentId"
+ Dim eObj% = 0
+ Dim round% = 0
Dim URL$ = String.Empty
- Try
- Dim PostID$ = String.Empty, PostTmp$ = String.Empty
- Dim PostDate$
- Dim n As EContainer, nn As EContainer, s As EContainer
- Dim NewPostDetected As Boolean = False
- Dim ExistsDetected As Boolean = False
- Dim _ItemsBefore%
- Dim added As Boolean
- Dim __ItemType$
- Dim tmpType As UTypes
- Dim IsCrossPost As Predicate(Of EContainer) = Function(e) Not (e.Value(CPRI).IsEmptyString And e.Value(CPPI).IsEmptyString)
- Dim CheckNode As Predicate(Of EContainer) = Function(e) Not ParseUserMediaOnly OrElse e("author").XmlIfNothingValue("/").ToLower.Equals(Name.ToLower)
- Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
- Dim _PostID As Func(Of String) = Function() IIf(PostTmp.IsEmptyString, PostID, PostTmp)
+ 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 UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
+ Dim _PostID As Func(Of String) = Function() PostTmp.IfNullOrEmpty(PostID)
- URL = $"https://gateway.reddit.com/desktopapi/v1/user/{Name}/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,, EDP.ThrowException)
- If Not r.IsEmptyString Then
- Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
- If w.Count > 0 Then
- 'TODELETE: moved to 'GetUserInfo' 2023.2.5.0
- 'If UserDescriptionNeedToUpdate() Then UserDescriptionUpdate(w.ItemF({"subredditAboutInfo", 0, "publicDescription"}).XmlIfNothingValue)
- n = w.GetNode(JsonNodesJson)
- If Not n Is Nothing AndAlso n.Count > 0 Then
- For Each nn In n
- ThrowAny(Token)
- If nn.Count > 0 Then
- If CheckNode(nn) Then
+ 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
+ For Each nn In n
+ 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(CPRI), nn.Value(CPPI)}, 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
-
- _ItemsBefore = _TempMediaList.Count
- added = True
- s = nn.ItemF({"source", "url"})
- If s.XmlIfNothingValue("/").StringContains({$"{SiteRedGifsKey}.com", $"{SiteGfycatKey}.com"}) Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, _PostID(), PostDate,, IsChannel), LNC)
- ElseIf Not CreateImgurMedia(s.XmlIfNothingValue, _PostID(), PostDate,, IsChannel) Then
- s = nn.ItemF({"media"}).XmlIfNothing
- __ItemType = s("type").XmlIfNothingValue
- Select Case __ItemType
- Case "gallery" : If Not DownloadGallery(s, _PostID(), PostDate) Then added = False
- Case "image", "gifvideo"
- If s.Contains("content") Then
- _TempMediaList.ListAddValue(MediaFromData(UPicType(__ItemType), s.Value("content"),
- _PostID(), PostDate,, IsChannel), LNC)
- Else
- added = False
- End If
- Case "video"
- If UseM3U8 AndAlso s("hlsUrl").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value("hlsUrl"),
- _PostID(), PostDate,, IsChannel), LNC)
- ElseIf Not UseM3U8 AndAlso s("fallback_url").XmlIfNothingValue("/").ToLower.Contains("mp4") Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, s.Value("fallback_url"),
- _PostID(), PostDate,, IsChannel), LNC)
- Else
- added = False
- End If
- Case Else : added = False
- End Select
- End If
- If Not added Then
- s = nn.ItemF({"source", "url"}).XmlIfNothing
- If Not s.IsEmptyString AndAlso TryFile(s.Value) Then
- With s.Value.ToLower
- Select Case True
- Case .Contains(SiteRedGifsKey), .Contains(SiteGfycatKey) : tmpType = UTypes.VideoPre
- Case .Contains("m3u8") : If Settings.UseM3U8 Then tmpType = UTypes.m3u8
- Case .Contains(".gif") And TryFile(s.Value) : tmpType = UTypes.GIF
- Case TryFile(s.Value) : tmpType = UTypes.Picture
- Case Else : tmpType = UTypes.Undefined
- End Select
- End With
- If Not tmpType = UTypes.Undefined Then
- _TempMediaList.ListAddValue(MediaFromData(tmpType, s.Value, _PostID(), PostDate,, IsChannel), LNC)
- End If
+ '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
- End If
- Next
+ Next
+ End If
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
- Catch ex As Exception
- ProcessException(ex, Token, $"data downloading error [{URL}]")
- End Try
+ 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
- Try
- Dim PostID$ = String.Empty
- Dim PostDate$, _UserID$, tmpUrl$
- Dim n As EContainer, nn As EContainer, s As EContainer, ss 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?
+ 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/{Name}/saved.json?after={POST}"
- Else
- URL = $"https://reddit.com/r/{Name}/{View}.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
- End If
+ 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,, EDP.ThrowException)
- 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
- For Each nn In n
- ThrowAny(Token)
- s = nn.ItemF({eCount})
- If Not s Is Nothing AndAlso s.Count > 0 Then
- PostID = s.Value("name")
- If PostID.IsEmptyString AndAlso s.Contains("id") Then PostID = s("id").Value
+ 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
+ For Each nn In n
+ 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
+ If ChannelPostsNames.Contains(PostID) Then
+ If ViewMode = CView.New Then ExistsDetected = True Else NewPostDetected = True 'bypass
Continue For
End If
- Else
- NewPostDetected = True
- 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 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
-
- tmpUrl = s.Value("url")
- If Not tmpUrl.IsEmptyString AndAlso tmpUrl.StringContains({"redgifs.com", "gfycat.com"}) Then
- If SaveToCache Then
- tmpUrl = s.Value({"media", "oembed"}, "thumbnail_url")
- If Not tmpUrl.IsEmptyString Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
- _TotalPostsDownloaded += 1
+ If IsSavedPosts Then
+ If Not _TempPostsList.Contains(PostID) Then
+ NewPostDetected = True
+ _TempPostsList.Add(PostID)
+ Else
+ ExistsDetected = True
+ Continue For
End If
Else
- _TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
- _TotalPostsDownloaded += 1
+ NewPostDetected = True
End If
- ElseIf Not s.Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
- tmpUrl = s.Value({"media", "reddit_video"}, "fallback_url")
- If SaveToCache Then
- tmpUrl = GetVideoRedditPreview(s)
- If Not tmpUrl.IsEmptyString Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel, False), LNC)
- _TotalPostsDownloaded += 1
- End If
- ElseIf UseM3U8 AndAlso Not s.Value({"media", "reddit_video"}, "hls_url").IsEmptyString Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value({"media", "reddit_video"}, "hls_url"),
- PostID, PostDate, _UserID, IsChannel), LNC)
- Else
- _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, 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
- ElseIf s.Contains("preview") Then
- ss = s.ItemF({"preview", "images", eCount, "source", "url"}).XmlIfNothing
- If Not ss.Value.IsEmptyString Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, ss.Value, PostID, PostDate, _UserID, IsChannel), LNC)
- _TotalPostsDownloaded += 1
+
+ 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
- End If
- Next
+ Next
+ End If
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
- Catch ex As Exception
- ProcessException(ex, Token, $"channel data downloading error [{URL}]")
- End Try
+ 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")}/{Name}/about.json",, EDP.ReturnValue)
+ 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 = UrlToFile(img)
+ Dim f As SFile = CreateFileFromUrl(img)
If Not f.Name.IsEmptyString Then
If f.Extension.IsEmptyString Then f.Extension = "jpg"
f.Path = dir.Path
@@ -452,29 +436,149 @@ Namespace API.Reddit
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"
+ If .Contains("content") Then
+ _TempMediaList.ListAddValue(MediaFromData(UPicType(t), .Value("content"), 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))
+ 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
+ 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
+ tmpUrl = If(e.ItemF({"preview", "images", eCount, "source", "url"})?.Value, String.Empty)
+ If Not tmpUrl.IsEmptyString Then
+ _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, UserID), LNC)
+ _TotalPostsDownloaded += 1
+ added = True
+ End If
+ End If
+ End If
+ End If
+ Return added
+ Else
+ Return False
+ End If
+ 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, IsChannel), LNC)
+ _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, IsChannel), LNC)
+ _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, IsChannel), LNC)
+ _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, IsChannel), LNC)
+ _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL, PostID, PostDate, _UserID), LNC)
ElseIf _URL.Contains(".gif") Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
+ _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, IsChannel), LNC)
+ _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID), LNC)
Else
Dim ut As UTypes
Dim m As UserMedia
@@ -489,7 +593,7 @@ Namespace API.Reddit
Case "gif" : ut = UTypes.GIF
Case Else : ut = UTypes.Picture : .File.Extension = "jpg"
End Select
- m = MediaFromData(ut, _URL, PostID, PostDate, _UserID, IsChannel)
+ m = MediaFromData(ut, _URL, PostID, PostDate, _UserID)
m.URL = .URL
m.File = .File.File
_TempMediaList.ListAddValue(m, LNC)
@@ -504,17 +608,22 @@ Namespace API.Reddit
Return False
End If
End Function
- Private Function DownloadGallery(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
+ 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 cn$ = IIf(IsChannel, "media_metadata", "mediaMetadata")
- If Not w Is Nothing AndAlso w(cn).XmlIfNothing.Count > 0 Then
+ 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 w(cn)
+ 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, IsChannel), LNC)
+ _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, t.Value, PostID, PostDate, _UserID), LNC)
added = True
If FirstOnly Then Exit For
End If
@@ -558,6 +667,8 @@ Namespace API.Reddit
Return String.Empty
End Try
End Function
+#End Region
+#Region "ReparseVideo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Dim RedGifsResponser As Responser = Nothing
Try
@@ -619,6 +730,8 @@ Namespace API.Reddit
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
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
@@ -628,21 +741,33 @@ Namespace API.Reddit
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%
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
- If Not m.URL.IsEmptyString AndAlso m.URL.Contains(SiteRedGifsKey) Then
- m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost)
- If m2.State = RedGifs.UserData.DataGone Then
- rList.Add(i)
- ElseIf Not m2.Type = UTypes.Undefined And Not m2.State = UStates.Missing Then
- m.Type = m2.Type
- m.File = m2.File
- m.URL_BASE = m.URL
- m.URL = m2.URL
- rList.Add(i)
- _TempMediaList.ListAddValue(m, LNC)
+ 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
+ _TempMediaList(i) = m2
+ Next
+ End If
+ rList.Add(i)
+ End If
+ End With
+ End If
+ j.Dispose()
End If
End If
End If
@@ -658,82 +783,27 @@ Namespace API.Reddit
End If
End Try
End Sub
- Private Sub ParsePost(ByVal URL As String)
- Try
- If Not URL.IsEmptyString Then
- Dim __id$ = RegexReplace(URL, RParams.DMS("comments/([^/]+)", 1, EDP.ReturnValue))
- If Not __id.IsEmptyString Then
- URL = $"https://www.reddit.com/comments/{__id.Split("_").LastOrDefault}/.json"
- Dim r$ = Responser.GetResponse(URL,, EDP.ReturnValue)
- If Not r.IsEmptyString Then
- Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
- With j.ItemF({0, "data", "children", 0, "data"})
- If .ListExists Then
- If .Contains({"media"}, "reddit_video") Then
- With .Item({"media"}, "reddit_video")
- If UseM3U8 AndAlso .Item("hls_url").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, .Value("hls_url"), __id, String.Empty), LNC)
- ElseIf Not UseM3U8 AndAlso .Item("fallback_url").XmlIfNothingValue("/").ToLower.Contains("mp4") Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, .Value("fallback_url"), __id, String.Empty), LNC)
- End If
- End With
- ElseIf Not .Value("url").IsEmptyString Then
- If .Value("url").StringContains({$"{SiteRedGifsKey}.com", $"{SiteGfycatKey}.com"}) Then
- _TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, .Value("url"), __id, String.Empty), LNC)
- Else
- CreateImgurMedia(.Value("url"), __id, String.Empty)
- End If
- End If
- End If
- End With
- End Using
- End If
- End If
- End If
- Catch ex As Exception
- ErrorsDescriber.Execute(EDP.SendInLog, ex, $"API.Reddit.ParsePost({URL})")
- End Try
+#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
- Private Class AbsProgress : Inherits PersonalUtilities.Forms.Toolbars.MyProgress
- Public Overrides Sub Perform(Optional ByVal Value As Double = 1)
- End Sub
- End Class
- Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Responser, ByVal f As SFile, ByVal SpecialFolder As String) As IEnumerable(Of UserMedia)
- Try
- If Not URL.IsEmptyString Then
- Using r As New UserData
- r.SetEnvironment(Settings(RedditSiteKey), Nothing, False, False)
- r.Responser = New Responser
- r.Responser.Copy(resp)
- r.ParsePost(URL)
- If r._TempMediaList.Count > 0 Then
- r.ReparseVideo(Nothing)
- If r._TempMediaList.Count > 0 Then
- r._ContentNew.AddRange(r._TempMediaList)
- r.Progress = New AbsProgress
- r.User.File.Path = f.Path
- r.SeparateVideoFolder = False
- r.DownloadContent(Nothing)
- If r._ContentNew.Exists(Function(c) c.State = UStates.Downloaded) Then _
- Return {New UserMedia With {.State = UStates.Downloaded, .SpecialFolder = SpecialFolder}}
- End If
- End If
- End Using
- End If
- Return Nothing
- Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Reddit.UserData.GetVideoInfo({URL})]")
- End Try
- End Function
#End Region
#Region "Structure creator"
- Protected Shared 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 IsChannel As Boolean = False,
- Optional ByVal ReplacePreview As Boolean = True) As UserMedia
+ 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 = UrlToFile(m.URL) Else m.File = Nothing
+ 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") 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
@@ -741,203 +811,67 @@ Namespace API.Reddit
Private Function TryFile(ByVal URL As String) As Boolean
Try
If Not URL.IsEmptyString AndAlso URL.StringContains({".jpg", ".png", ".jpeg"}) Then
- Dim f As SFile = CStr(RegexReplace(URL, FilesPattern))
- Return Not f.File.IsEmptyString
+ Return Not CreateFileFromUrl(URL).IsEmptyString
+ Else
+ Return False
End If
- Return False
Catch ex As Exception
Return False
End Try
End Function
- Private Shared Function UrlToFile(ByVal URL As String) As SFile
- Return CStr(RegexReplace(URL, FilesPattern))
+ 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)
- Dim RedGifsResponser As Responser = Nothing
- Try
- Const _RFN$ = "RedditVideo"
- Const RFN$ = _RFN & "{0}"
- 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
- RedGifsResponser = Settings(RedGifs.RedGifsSiteKey).Responser.Copy
- MyFile.Exists(SFO.Path)
- Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
- Dim IsImgurStuff As Boolean
- Dim MyDir$
- If Not IsSavedPosts AndAlso (IsChannel And SaveToCache And Not ChannelInfo Is Nothing) Then
- MyDir = ChannelInfo.CachePath.PathNoSeparator
- Else
- MyDir = MyFile.CutPath.PathNoSeparator
- End If
- Dim StartRFN% = 0
- If _ContentNew.Exists(Function(c) c.Type = UTypes.Video And c.URL.Contains("redd.it")) Then
- StartRFN = SFile.Indexed_GetMaxIndex($"{MyDir}\{IIf(SeparateVideoFolderF, "Video\", String.Empty)}{_RFN}.mp4",, New SFileNumbers(_RFN, String.Empty), EDP.ReturnValue)
- End If
- Dim HashList As New List(Of String)
- If _ContentList.Count > 0 Then HashList.ListAddList((From h In _ContentList Where Not h.MD5.IsEmptyString Select h.MD5), LNC)
- Dim f As SFile
- Dim v As UserMedia
- Dim cached As Boolean = IsChannel And SaveToCache
- Dim vsf As Boolean = SeparateVideoFolderF
- Dim UseMD5 As Boolean = Not IsChannel Or (Not cached And Settings.ChannelsRegularCheckMD5)
- Dim bDP As New ErrorsDescriber(EDP.None)
- Dim RGRERROR As New ErrorsDescriber(EDP.ThrowException)
- Dim ImgurUrls As New List(Of String)
- Dim TryBytes As Func(Of String, Imaging.ImageFormat, String) =
- Function(ByVal __URL As String, ByVal ImgFormat As Imaging.ImageFormat) As String
- Try
- Return ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__URL, bDP), ImgFormat))
- Catch hash_ex As Exception
- Return String.Empty
- End Try
- End Function
- Dim MD5BS As Func(Of String, UTypes,
- SFile, Boolean, String) = Function(ByVal __URL As String, ByVal __MT As UTypes,
- ByVal __File As SFile, ByVal __IsBase As Boolean) As String
- Try
- ImgurUrls.Clear()
- Dim ImgFormat As Imaging.ImageFormat
- If __MT = UTypes.GIF Then
- ImgFormat = Imaging.ImageFormat.Gif
- ElseIf __IsBase Then
- ImgFormat = GetImageFormat(CStr(RegexReplace(__URL, UrlBasePattern)))
- Else
- ImgFormat = GetImageFormat(__File)
- End If
-
- Dim tmpBytes$ = TryBytes(__URL, ImgFormat)
- If tmpBytes.IsEmptyString And Not __MT = UTypes.GIF Then
- ImgFormat = Imaging.ImageFormat.Png
- tmpBytes = TryBytes(__URL, ImgFormat)
- If Not tmpBytes.IsEmptyString Then Return tmpBytes
- Else
- Return tmpBytes
- End If
-
- If tmpBytes.IsEmptyString And Not __MT = UTypes.GIF And __URL.Contains("imgur.com") Then
- For c% = 0 To 1
- If c = 0 Then
- ImgurUrls.ListAddList(Imgur.Envir.GetGallery(__URL))
- Else
- ImgurUrls.ListAddValue(Imgur.Envir.GetImage(__URL))
- End If
- If ImgurUrls.Count > 0 Then Exit For
- Next
- End If
- Return tmpBytes
- Catch hash_ex As Exception
- Return String.Empty
- End Try
- End Function
- Dim m$
- Using w As New WebClient
- If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
- Progress.Maximum += _ContentNew.Count
- For i = 0 To _ContentNew.Count - 1
- ThrowAny(Token)
- v = _ContentNew(i)
- v.State = UStates.Tried
- If v.File.IsEmptyString Then
- f = UrlToFile(v.URL)
- Else
- f = v.File
- End If
- f.Separator = "\"
- m = String.Empty
- If (v.Type = UTypes.Picture Or v.Type = UTypes.GIF) And UseMD5 Then
- m = MD5BS(v.URL, v.Type, f, False)
- If ImgurUrls.Count = 0 AndAlso m.IsEmptyString AndAlso Not v.URL_BASE.IsEmptyString AndAlso Not v.URL_BASE = v.URL Then
- m = MD5BS(v.URL_BASE, v.Type, f, True)
- If Not m.IsEmptyString Then v.URL = v.URL_BASE
- End If
- End If
-
- If (Not m.IsEmptyString AndAlso Not HashList.Contains(m)) Or Not (v.Type = UTypes.Picture Or
- v.Type = UTypes.GIF) Or Not UseMD5 Or ImgurUrls.Count > 0 Then
- IsImgurStuff = ImgurUrls.Count > 0
- Do
- If Not cached And Not m.IsEmptyString Then HashList.Add(m)
- v.MD5 = m
- If ImgurUrls.Count > 0 Then
- If ImgurUrls(0).IsEmptyString Then ImgurUrls.RemoveAt(0) : Continue Do
- f = UrlToFile(ImgurUrls(0))
- If f.Extension.IsEmptyString Then f.Extension = "gif"
- If f.Name.IsEmptyString Then
- f.Path = MyDir
- f.Name = $"ImgurImg_{v.File.Name}"
- f = SFile.Indexed_IndexFile(f,,, EDP.ReturnValue)
- End If
- End If
- If f.Extension = "webp" And Settings.DownloadNativeImageFormat Then f.Extension = "jpg"
- f.Path = MyDir
- Try
- If (v.Type = UTypes.Video Or v.Type = UTypes.m3u8 Or (ImgurUrls.Count > 0 AndAlso f.Extension = "mp4")) And
- vsf Then f.Path = $"{f.PathWithSeparator}Video"
- If v.Type = UTypes.Video AndAlso v.URL.Contains("redd.it") Then
- StartRFN += 1
- f.Name = String.Format(RFN, StartRFN)
- End If
- If v.Type = UTypes.m3u8 Then
- f = M3U8.Download(v.URL, f)
- ElseIf ImgurUrls.Count > 0 Then
- w.DownloadFile(ImgurUrls(0), f.ToString)
- ElseIf v.URL.Contains(SiteRedGifsKey) Then
- RedGifsResponser.DownloadFile(v.URL, f, RGRERROR)
- Else
- w.DownloadFile(v.URL, f.ToString)
- End If
- If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then
- Select Case v.Type
- Case UTypes.Picture, UTypes.GIF : DownloadedPictures(False) += 1
- Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1
- End Select
- If Not IsChannel Or Not SaveToCache Then
- v.File = ChangeFileNameByProvider(f, v)
- Else
- v.File = f
- End If
- v.Post.CachedFile = f
- v.State = UStates.Downloaded
- dCount += 1
- End If
- Catch wex As Exception
- If Not IsChannel Then
- If Not IsImgurStuff And MissingErrorsAdd Then ErrorDownloading(f, v.URL)
- v.Attempts += 1
- v.State = UStates.Missing
- End If
- End Try
- If ImgurUrls.Count > 0 Then ImgurUrls.RemoveAt(0)
- Loop While ImgurUrls.Count > 0
- Else
- v.State = UStates.Skipped
- End If
- _ContentNew(i) = v
- If (CreatedByChannel And Settings.FromChannelDownloadTopUse And dCount >= Settings.FromChannelDownloadTop) Or
- (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
+ 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, IIf(IsSingleObjectDownload, Progress, Nothing))
+ 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
@@ -949,6 +883,9 @@ Namespace API.Reddit
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
Return 1
+ 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
@@ -956,9 +893,12 @@ Namespace API.Reddit
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
\ No newline at end of file
diff --git a/SCrawler/API/Redgifs/Declarations.vb b/SCrawler/API/Redgifs/Declarations.vb
index 3fd01e6..401c42c 100644
--- a/SCrawler/API/Redgifs/Declarations.vb
+++ b/SCrawler/API/Redgifs/Declarations.vb
@@ -11,7 +11,6 @@ Namespace API.RedGifs
Friend Module Declarations
Friend Const RedGifsSiteKey As String = "AndyProgram_RedGifs"
Friend Const RedGifsSite As String = "RedGifs"
- Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v, n, e))
Friend ReadOnly WatchIDRegex As RParams = RParams.DMS(".+?watch/([^\?&""/]+)", 1, EDP.ReturnValue)
Friend ReadOnly ThumbsIDRegex As RParams = RParams.DMS("([^/\?&""]+?)(-\w+?|)\.(mp4|jpg)", 1, EDP.ReturnValue,
CType(Function(Input$) Input.StringToLower.StringTrim, Func(Of String, String)))
diff --git a/SCrawler/API/Redgifs/SiteSettings.vb b/SCrawler/API/Redgifs/SiteSettings.vb
index dfdb5b5..e664b28 100644
--- a/SCrawler/API/Redgifs/SiteSettings.vb
+++ b/SCrawler/API/Redgifs/SiteSettings.vb
@@ -14,8 +14,6 @@ Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
-Imports UTypes = SCrawler.API.Base.UserMedia.Types
-Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs
Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -32,18 +30,17 @@ Namespace API.RedGifs
End Property
Friend ReadOnly Property Token As PropertyValue
+
+ Private ReadOnly Property UserAgent As PropertyValue
Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization"
#Region "TokenUpdateInterval"
Friend ReadOnly Property TokenUpdateInterval As PropertyValue
- Private Class TokenIntervalProvider : Implements IFieldsCheckerProvider
- Private Property ErrorMessage As String Implements IFieldsCheckerProvider.ErrorMessage
- Private Property Name As String Implements IFieldsCheckerProvider.Name
- Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError
- Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
- Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
+ Private Class TokenIntervalProvider : Inherits FieldsCheckerProviderBase
+ Public Overrides Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
+ Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object
TypeError = False
ErrorMessage = String.Empty
If Not ACheck(Of Integer)(Value) Then
@@ -52,12 +49,10 @@ Namespace API.RedGifs
Return Value
Else
ErrorMessage = $"The value of [{Name}] field must be greater than or equal to 1"
+ HasError = True
End If
Return Nothing
End Function
- Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
- Throw New NotImplementedException("[GetFormat] is not available in the context of [TokenIntervalProvider]")
- End Function
End Class
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
@@ -68,12 +63,14 @@ Namespace API.RedGifs
MyBase.New(RedGifsSite, "redgifs.com")
Dim t$ = String.Empty
With Responser
- Dim b As Boolean = Not .Mode = Responser.Modes.WebClient
.Mode = Responser.Modes.WebClient
+ If Not .UserAgentExists Then .UserAgent = ParserUserAgent
+ .ClientWebUseCookies = False
+ .ClientWebUseHeaders = True
t = .Headers.Value(TokenName)
- If b Then .SaveSettings()
End With
- Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
+ Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(NameOf(Token), v))
+ UserAgent = New PropertyValue(Responser.UserAgent, GetType(String), Sub(v) UpdateResponse(NameOf(UserAgent), v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer))
TokenUpdateIntervalProvider = New TokenIntervalProvider
@@ -83,8 +80,11 @@ Namespace API.RedGifs
End Sub
#End Region
#Region "Response updater"
- Private Sub UpdateResponse(ByVal Value As String)
- Responser.Headers.Add(TokenName, Value)
+ Private Sub UpdateResponse(ByVal Name As String, ByVal Value As String)
+ Select Case Name
+ Case NameOf(Token) : Responser.Headers.Add(TokenName, Value)
+ Case NameOf(UserAgent) : Responser.UserAgent = Value
+ End Select
Responser.SaveSettings()
End Sub
#End Region
@@ -101,16 +101,18 @@ Namespace API.RedGifs
Friend Function UpdateToken() As Boolean
Try
Dim r$
- Dim NewToken$ = String.Empty
+ Dim NewToken$ = String.Empty, NewAgent$ = String.Empty
Using resp As New Responser : r = resp.GetResponse("https://api.redgifs.com/v2/auth/temporary",, EDP.ThrowException) : End Using
If Not r.IsEmptyString Then
Dim j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then
NewToken = j.Value("token")
+ NewAgent = j.Value("agent")
j.Dispose()
End If
End If
If Not NewToken.IsEmptyString Then
+ If Not NewAgent.IsEmptyString Then UserAgent.Value = NewAgent
Token.Value = $"Bearer {NewToken}"
TokenLastDateUpdated.Value = Now
Return True
@@ -118,7 +120,7 @@ Namespace API.RedGifs
Return False
End If
Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.RedGifs.SiteSettings.UpdateToken]", False)
+ Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.RedGifs.SiteSettings.UpdateToken]", False)
End Try
End Function
#End Region
@@ -129,8 +131,10 @@ Namespace API.RedGifs
MyBase.BeginEdit()
End Sub
Friend Overrides Sub Update()
- Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
- If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now
+ If _SiteEditorFormOpened Then
+ Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
+ If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now
+ End If
MyBase.Update()
End Sub
Friend Overrides Sub EndEdit()
@@ -141,32 +145,6 @@ Namespace API.RedGifs
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
- Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
- If BaseAuthExists() Then
- Using resp As Responser = Responser.Copy
- Dim m As UserMedia = UserData.GetDataFromUrlId(URL, False, resp, Settings(RedGifsSiteKey))
- If Not m.State = UStates.Missing And Not m.State = UserData.DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then
- Try
- Dim spf$ = String.Empty
- Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
- If f.IsEmptyString Then
- f = m.File.File
- Else
- f.Name = m.File.Name
- f.Extension = m.File.Extension
- End If
- resp.DownloadFile(m.URL, f, EDP.ThrowException)
- m.State = UStates.Downloaded
- m.SpecialFolder = spf
- Return {m}
- Catch ex As Exception
- ErrorsDescriber.Execute(EDP.SendInLog, ex, $"Redgifs standalone download error: [{URL}]")
- End Try
- End If
- End Using
- End If
- Return Nothing
- End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://www.redgifs.com/watch/{Media.Post.ID}"
End Function
diff --git a/SCrawler/API/Redgifs/UserData.vb b/SCrawler/API/Redgifs/UserData.vb
index 64e46f3..db4c4e9 100644
--- a/SCrawler/API/Redgifs/UserData.vb
+++ b/SCrawler/API/Redgifs/UserData.vb
@@ -9,6 +9,7 @@
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
+Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
@@ -42,7 +43,7 @@ Namespace API.RedGifs
Try
Dim _page As Func(Of String) = Function() If(Page = 1, String.Empty, $"&page={Page}")
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent{_page.Invoke}"
- Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
+ Dim r$ = Responser.GetResponse(URL)
Dim postDate$, postID$
Dim pTotal% = 0
If Not r.IsEmptyString Then
@@ -51,7 +52,7 @@ Namespace API.RedGifs
pTotal = j.Value("pages").FromXML(Of Integer)(0)
For Each g As EContainer In j("gifs")
postDate = g.Value("createDate")
- Select Case CheckDatesLimit(postDate, DateProvider)
+ Select Case CheckDatesLimit(postDate, UnixDate32Provider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
@@ -106,13 +107,13 @@ Namespace API.RedGifs
Dim u As UserMedia
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
- If _ContentList(i).State = UserMedia.States.Missing Then
+ If _ContentList(i).State = UStates.Missing Then
ThrowAny(Token)
u = _ContentList(i)
If Not u.Post.ID.IsEmptyString Then
url = String.Format(PostDataUrl, u.Post.ID.ToLower)
Try
- r = Responser.GetResponse(url,, EDP.ThrowException)
+ r = Responser.GetResponse(url)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
@@ -207,20 +208,29 @@ Namespace API.RedGifs
MyMainLOG = String.Format(_errText, URL)
Return m
Else
- Return ErrorsDescriber.Execute(EDP.SendInLog, ex, String.Format(_errText, URL), m)
+ Return ErrorsDescriber.Execute(EDP.SendToLog, ex, String.Format(_errText, URL), m)
End If
End If
End Try
End Function
#End Region
+#Region "Single data downloader"
+ Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
+ Dim m As UserMedia = GetDataFromUrlId(Data.URL, False, Responser, HOST)
+ If Not m.State = UStates.Missing And Not m.State = DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then
+ m.URL_BASE = MySettings.GetUserPostUrl(Me, m)
+ _TempMediaList.Add(m)
+ End If
+ End Sub
+#End Region
#Region "Create media"
- Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String,
- ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates) As UserMedia
+ Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String,
+ ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDateStr.IsEmptyString Then
- m.Post.Date = AConvert(Of Date)(PostDateStr, DateProvider, Nothing)
+ m.Post.Date = AConvert(Of Date)(PostDateStr, UnixDate32Provider, Nothing)
ElseIf PostDateDate.HasValue Then
m.Post.Date = PostDateDate
Else
@@ -233,8 +243,8 @@ Namespace API.RedGifs
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
- Dim s As WebExceptionStatus = Responser.Client.Status
- Dim sc As HttpStatusCode = Responser.Client.StatusCode
+ Dim s As WebExceptionStatus = Responser.Status
+ Dim sc As HttpStatusCode = Responser.StatusCode
If sc = HttpStatusCode.NotFound Or s = DataGone Then
UserExists = False
ElseIf sc = HttpStatusCode.Unauthorized Then
diff --git a/SCrawler/API/ThisVid/Declarations.vb b/SCrawler/API/ThisVid/Declarations.vb
new file mode 100644
index 0000000..a95bc94
--- /dev/null
+++ b/SCrawler/API/ThisVid/Declarations.vb
@@ -0,0 +1,22 @@
+' Copyright (C) 2023 Andy https://github.com/AAndyProgram
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT ANY WARRANTY
+Imports PersonalUtilities.Functions.RegularExpressions
+Namespace API.ThisVid
+ Friend Module Declarations
+ Friend Const ThisVidSiteKey As String = "AndyProgram_ThisVid"
+ Friend ReadOnly RegExNextPage As RParams = RParams.DMS("class=.pagination-next...a class=.selective..href=""([^""]+)""", 1)
+ Friend ReadOnly RegExVideoList As RParams = RParams.DMS("\[\r\n\s]*[\r\n\s]*\
+ Friend Class SiteSettings : Inherits SiteSettingsBase
+#Region "Declarations"
+ Friend Overrides ReadOnly Property Icon As Icon
+ Get
+ Return My.Resources.SiteResources.ThisVidIcon_16
+ End Get
+ End Property
+ Friend Overrides ReadOnly Property Image As Image
+ Get
+ Return My.Resources.SiteResources.ThisVidPic_16
+ End Get
+ End Property
+
+ Friend ReadOnly Property DownloadPublic As PropertyValue
+
+ Friend ReadOnly Property DownloadPrivate As PropertyValue
+
+ Friend ReadOnly Property DifferentFolders As PropertyValue
+#End Region
+#Region "Initializer"
+ Friend Sub New()
+ MyBase.New("ThisVid", "thisvid.com")
+ DownloadPublic = New PropertyValue(True)
+ DownloadPrivate = New PropertyValue(True)
+ DifferentFolders = New PropertyValue(True)
+ CheckNetscapeCookiesOnEndInit = True
+ UseNetscapeCookies = True
+ UserRegex = RParams.DMS("thisvid.com/members/(\d+)", 1)
+ UrlPatternUser = "https://thisvid.com/members/{0}/"
+ ImageVideoContains = "https://thisvid.com/videos/"
+ End Sub
+#End Region
+#Region "GetInstance, GetSpecialData"
+ Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
+ Return New UserData
+ End Function
+#End Region
+#Region "Downloading"
+ Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
+ Return Settings.YtdlpFile.Exists And (What = ISiteSettings.Download.SingleObject Or Responser.CookiesExists)
+ End Function
+#End Region
+#Region "UserOptions"
+ Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
+ If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions(Me)
+ If OpenForm Then
+ Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
+ End If
+ End Sub
+#End Region
+ End Class
+End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/ThisVid/UserData.vb b/SCrawler/API/ThisVid/UserData.vb
new file mode 100644
index 0000000..b7f8aa0
--- /dev/null
+++ b/SCrawler/API/ThisVid/UserData.vb
@@ -0,0 +1,332 @@
+' Copyright (C) 2023 Andy https://github.com/AAndyProgram
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT ANY WARRANTY
+Imports System.Threading
+Imports SCrawler.API.Base
+Imports SCrawler.API.YouTube.Objects
+Imports PersonalUtilities.Functions.XML
+Imports PersonalUtilities.Functions.RegularExpressions
+Imports PersonalUtilities.Tools
+Imports PersonalUtilities.Tools.Web.Documents.JSON
+Namespace API.ThisVid
+ Friend Class UserData : Inherits UserDataBase
+#Region "XML names"
+ Private Const Name_DownloadPublic As String = "DownloadPublic"
+ Private Const Name_DownloadPrivate As String = "DownloadPrivate"
+ Private Const Name_DifferentFolders As String = "DifferentFolders"
+#End Region
+#Region "Structures"
+ Private Structure Album : Implements IRegExCreator
+ Friend URL As String
+ Friend Title As String
+ Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
+ If ParamsArray.ListExists(2) Then
+ URL = ParamsArray(0)
+ Title = TitleHtmlConverter(ParamsArray(1))
+ End If
+ Return Me
+ End Function
+ End Structure
+#End Region
+#Region "Declarations"
+ Friend Property DownloadPublic As Boolean = True
+ Friend Property DownloadPrivate As Boolean = True
+ Friend Property DifferentFolders As Boolean = True
+#End Region
+#Region "Loaders"
+ Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
+ With Container
+ If Loading Then
+ DownloadPublic = .Value(Name_DownloadPublic).FromXML(Of Boolean)(True)
+ DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(True)
+ DifferentFolders = .Value(Name_DifferentFolders).FromXML(Of Boolean)(True)
+ Else
+ .Add(Name_DownloadPublic, DownloadPublic.BoolToInteger)
+ .Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger)
+ .Add(Name_DifferentFolders, DifferentFolders.BoolToInteger)
+ End If
+ End With
+ End Sub
+ Friend Overrides Function ExchangeOptionsGet() As Object
+ Return New UserExchangeOptions(Me)
+ End Function
+ Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
+ If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
+ With DirectCast(Obj, UserExchangeOptions)
+ DownloadPublic = .DownloadPublic
+ DownloadPrivate = .DownloadPrivate
+ DifferentFolders = .DifferentFolders
+ End With
+ End If
+ End Sub
+#End Region
+#Region "Initializer"
+ Friend Sub New()
+ UseClientTokens = True
+ End Sub
+#End Region
+#Region "Validation"
+ Private Function IsValid() As Boolean
+ Const ProfileDataPattern$ = "{0}[\r\n\s\W]*:[\r\n\s\W]*\[\r\n\s\W]*([^\<]*)[\r\n\s\W]*\[\r\n\s\W]*([^\<]*)[\r\n\s\W]*\<"
+ Try
+ If Not IsSavedPosts Then
+ Dim r$ = Responser.GetResponse($"https://thisvid.com/members/{ID}/")
+ If Not r.IsEmptyString Then
+ Dim rr As New RParams("", Nothing, 1, EDP.ReturnValue)
+ Dim __getValue As Func(Of String, Boolean, String) = Function(ByVal member As String, ByVal appendMember As Boolean) As String
+ rr.Pattern = String.Format(ProfileDataPattern, member)
+ Dim v$ = CStr(RegexReplace(r, rr)).StringTrim
+ If Not v.IsEmptyString And appendMember Then v = $"{member}: {v}"
+ Return v
+ End Function
+ UserSiteNameUpdate(__getValue("Name", False))
+ If Not UserSiteName.IsEmptyString And FriendlyName.IsEmptyString Then FriendlyName = UserSiteName : _ForceSaveUserData = True
+ Dim descr$ = String.Empty
+ descr.StringAppendLine(__getValue("Birth date", True))
+ descr.StringAppendLine(__getValue("Country", True))
+ descr.StringAppendLine(__getValue("City", True))
+ descr.StringAppendLine(__getValue("Gender", True))
+ descr.StringAppendLine(__getValue("Orientation", True))
+ descr.StringAppendLine(__getValue("Relationship status", True))
+ descr.StringAppendLine(__getValue("Favourite category", True))
+ descr.StringAppendLine(__getValue("My interests", True))
+ rr.Pattern = DescriptionPattern
+ descr.StringAppendLine(CStr(RegexReplace(r, rr)).StringTrim)
+ UserDescriptionUpdate(descr)
+ Else
+ Return False
+ End If
+ End If
+ Return True
+ Catch ex As Exception
+ UserExists = False
+ Return False
+ End Try
+ End Function
+#End Region
+#Region "Download functions"
+ Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
+ If ID.IsEmptyString Then ID = Name
+ If IsValid() Then
+ If IsSavedPosts Then
+ DownloadData(1, True, Token)
+ DownloadData_Images(Token)
+ Else
+ If DownloadVideos Then
+ If DownloadPublic Then DownloadData(1, True, Token)
+ If DownloadPrivate Then DownloadData(1, False, Token)
+ End If
+ If DownloadImages Then DownloadData_Images(Token)
+ End If
+ End If
+ End Sub
+ Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsPublic As Boolean, ByVal Token As CancellationToken)
+ Dim URL$ = String.Empty
+ Try
+ Dim p$ = IIf(Page = 1, String.Empty, $"{Page}/")
+ If IsSavedPosts Then
+ URL = $"https://thisvid.com/my_favourite_videos/{p}"
+ Else
+ URL = $"https://thisvid.com/members/{ID}/{IIf(IsPublic, "public", "private")}_videos/{p}"
+ End If
+ ThrowAny(Token)
+ Dim r$ = Responser.GetResponse(URL)
+ Dim cBefore% = _TempMediaList.Count
+ If Not r.IsEmptyString Then
+ Dim __SpecialFolder$ = IIf(DifferentFolders, IIf(IsPublic, "Public", "Private"), String.Empty)
+ Dim l As List(Of String) = RegexReplace(r, If(IsSavedPosts, RegExVideoListSavedPosts, RegExVideoList))
+ If l.ListExists Then
+ For Each u$ In l
+ If Not u.IsEmptyString Then
+ If Not _TempPostsList.Contains(u) Then
+ _TempPostsList.Add(u)
+ _TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder})
+ Else
+ Exit Sub
+ End If
+ End If
+ Next
+ End If
+ End If
+ If Not cBefore = _TempMediaList.Count Then DownloadData(Page + 1, IsPublic, Token)
+ Catch ex As Exception
+ ProcessException(ex, Token, $"videos downloading error [{URL}]")
+ End Try
+ End Sub
+ Private Sub DownloadData_Images(ByVal Token As CancellationToken)
+ Dim __baseUrl$ = If(IsSavedPosts, "https://thisvid.com/my_favourite_albums/", $"https://thisvid.com/members/{ID}/albums/")
+ Dim URL$ = String.Empty
+ Try
+ Dim r$
+ Dim i% = 0
+ Dim __continue As Boolean = False
+ Dim rAlbums As RParams = If(IsSavedPosts, RegExAlbumsListSaved, RegExAlbumsList)
+ Do
+ i += 1
+ __continue = False
+ URL = __baseUrl
+ If i > 1 Then URL &= $"{i}/"
+ r = Responser.GetResponse(URL)
+ If Not r.IsEmptyString() Then
+ Dim albums As List(Of Album) = RegexFields(Of Album)(r, {rAlbums}, {1, 2}, EDP.ReturnValue)
+ Dim images As List(Of String)
+ Dim albumId$, img$, imgUrl$, imgId$
+ Dim u As UserMedia
+ Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
+ __continue = True
+ If albums.ListExists Then
+ If albums.Count < 20 Then __continue = False
+ For Each a As Album In albums
+ If Not a.URL.IsEmptyString Then
+ ThrowAny(Token)
+ r = Responser.GetResponse(a.URL,, rErr)
+ If Not r.IsEmptyString Then
+ albumId = RegexReplace(r, RegExAlbumID)
+ If a.Title.IsEmptyString Then a.Title = albumId
+ images = RegexReplace(r, RegExAlbumImagesList)
+ If images.ListExists Then
+ For Each img In images
+ ThrowAny(Token)
+ r = Responser.GetResponse(img,, rErr)
+ If Not r.IsEmptyString Then
+ imgUrl = RegexReplace(r, RegExAlbumImageUrl)
+ If Not imgUrl.IsEmptyString Then
+ u = New UserMedia(imgUrl) With {
+ .SpecialFolder = a.Title,
+ .Type = UserMedia.Types.Picture,
+ .URL_BASE = img
+ }
+ If Not u.File.File.IsEmptyString Then
+ imgId = $"{albumId}_{u.File.Name}"
+ If u.File.Extension.IsEmptyString Then u.File.Extension = "jpg"
+ u.Post = imgId
+ If Not _TempPostsList.Contains(imgId) Then
+ _TempPostsList.Add(imgId)
+ _TempMediaList.Add(u)
+ Else
+ Exit For
+ End If
+ End If
+ End If
+ End If
+ Next
+ images.Clear()
+ End If
+ End If
+ End If
+ Next
+ Else
+ Exit Do
+ End If
+ End If
+ Loop While __continue
+ Catch ex As Exception
+ ProcessException(ex, Token, $"images downloading error [{URL}]")
+ End Try
+ End Sub
+#End Region
+#Region "ReparseVideo"
+ Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
+ Try
+ If _TempMediaList.Count > 0 Then
+ Dim u As UserMedia
+ Dim dirCmd$ = String.Empty
+ Dim f As SFile = Settings.YtdlpFile.File
+ Dim n$
+ Dim cookieFile As SFile = DirectCast(HOST.Source, SiteSettings).CookiesNetscapeFile
+ Dim command$
+ Dim e As EContainer
+ For i% = _TempMediaList.Count - 1 To 0 Step -1
+ u = _TempMediaList(i)
+ If u.Type = UserMedia.Types.VideoPre Then
+ ThrowAny(Token)
+ command = $"""{f}"" --verbose --dump-json "
+ If cookieFile.Exists Then command &= $"--no-cookies-from-browser --cookies ""{cookieFile}"" "
+ command &= u.URL
+ e = GetJson(command)
+ If Not e Is Nothing Then
+ u.URL = e.Value("url")
+ u.Post = New UserPost(e.Value("id"), ADateTime.ParseUnix32(e.Value("epoch")))
+ If u.Post.Date.HasValue Then
+ Select Case CheckDatesLimit(u.Post.Date.Value, Nothing)
+ Case DateResult.Skip : _TempPostsList.ListAddValue(u.Post.ID, LNC) : _TempMediaList.RemoveAt(i) : Continue For
+ Case DateResult.Exit : Exit Sub
+ End Select
+ End If
+ n = TitleHtmlConverter(e.Value("title"))
+ If Not n.IsEmptyString Then n = n.Replace("ThisVid.com", String.Empty).StringTrim.StringTrimEnd("-").StringTrim
+ If n.IsEmptyString Then n = u.Post.ID
+ If n.IsEmptyString Then n = "VideoFile"
+ u.File = $"{n}.mp4"
+ If u.URL.IsEmptyString OrElse (Not u.Post.ID.IsEmptyString AndAlso _TempPostsList.Contains(u.Post.ID)) Then
+ _TempMediaList.RemoveAt(i)
+ Else
+ u.Type = UserMedia.Types.Video
+ _TempPostsList.Add(u.Post.ID)
+ _TempMediaList(i) = u
+ End If
+ e.Dispose()
+ End If
+ End If
+ Next
+ End If
+ Catch ex As Exception
+ ProcessException(ex, Token, "video reparsing error")
+ End Try
+ End Sub
+#End Region
+#Region "GetJson"
+ Private Function GetJson(ByVal Command As String) As EContainer
+ Try
+ Using b As New BatchExecutor(True)
+ b.Execute(Command, EDP.ReturnValue)
+ If b.OutputData.Count > 0 Then
+ Dim e As EContainer
+ For Each d$ In b.OutputData
+ If Not d.IsEmptyString AndAlso d.StartsWith("{") Then
+ e = JsonDocument.Parse(d, EDP.ReturnValue)
+ If Not e Is Nothing Then Return e
+ End If
+ Next
+ End If
+ End Using
+ Return Nothing
+ Catch ex As Exception
+ HasError = True
+ LogError(ex, $"GetJson({Command})")
+ Return Nothing
+ End Try
+ End Function
+#End Region
+#Region "DownloadContent"
+ Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
+ Dim s As Boolean? = SeparateVideoFolder
+ If DifferentFolders Then SeparateVideoFolder = False Else SeparateVideoFolder = Nothing
+ DownloadContentDefault(Token)
+ SeparateVideoFolder = s
+ End Sub
+#End Region
+#Region "Standalone downloader"
+ Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
+ _TempMediaList.Add(New UserMedia(Data.URL) With {.Type = UserMedia.Types.VideoPre})
+ ReparseVideo(Token)
+ End Sub
+#End Region
+#Region "DownloadingException"
+ Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
+ Optional ByVal EObj As Object = Nothing) As Integer
+ If Responser.StatusCode = Net.HttpStatusCode.NotFound Then
+ Return 1
+ Else
+ Return 0
+ End If
+ End Function
+#End Region
+ End Class
+End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/ThisVid/UserExchangeOptions.vb b/SCrawler/API/ThisVid/UserExchangeOptions.vb
new file mode 100644
index 0000000..3b91793
--- /dev/null
+++ b/SCrawler/API/ThisVid/UserExchangeOptions.vb
@@ -0,0 +1,32 @@
+' Copyright (C) 2023 Andy https://github.com/AAndyProgram
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT ANY WARRANTY
+Imports SCrawler.Plugin.Attributes
+Namespace API.ThisVid
+ Friend Class UserExchangeOptions
+
+ Friend Property DownloadPublic As Boolean = True
+
+ Friend Property DownloadPrivate As Boolean = True
+
+ Friend Property DifferentFolders As Boolean = True
+ Private ReadOnly Property MySettings As SiteSettings
+ Friend Sub New(ByVal s As SiteSettings)
+ DownloadPublic = s.DownloadPublic.Value
+ DownloadPrivate = s.DownloadPrivate.Value
+ DifferentFolders = s.DifferentFolders.Value
+ MySettings = s
+ End Sub
+ Friend Sub New(ByVal u As UserData)
+ DownloadPublic = u.DownloadPublic
+ DownloadPrivate = u.DownloadPrivate
+ DifferentFolders = u.DifferentFolders
+ MySettings = u.HOST.Source
+ End Sub
+ End Class
+End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/TikTok/Declarations.vb b/SCrawler/API/TikTok/Declarations.vb
index e749d95..2b030da 100644
--- a/SCrawler/API/TikTok/Declarations.vb
+++ b/SCrawler/API/TikTok/Declarations.vb
@@ -10,11 +10,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok
Friend Module Declarations
Friend ReadOnly RegexEnvir As New RegexParseEnvir
- Friend ReadOnly CheckDateProvider As New CustomProvider(Function(v, d, p, n, e)
- With DirectCast(v, Date?)
- If .HasValue Then Return .Value Else Return Nothing
- End With
- End Function)
+ Friend ReadOnly CheckDateProvider As New CustomProvider(Function(v) IIf(CType(v, Date?).HasValue, CObj(CType(v, Date?).Value), Nothing))
Friend Class RegexParseEnvir
Private ReadOnly UrlIdRegex As RParams = RParams.DMS("http[s]?://[w\.]{0,4}tiktok.com/[^/]+?/video/(\d+)", 1, EDP.ReturnValue)
Private ReadOnly RegexItemsArrPre As RParams = RParams.DMS("ItemList"":\{""user-post"":\{""list"":\[([^\[]+)\]", 1)
@@ -33,7 +29,7 @@ Namespace API.TikTok
End If
Return Nothing
Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.TikTok.RegexParseEnvir.GetIDList]")
+ Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.TikTok.RegexParseEnvir.GetIDList]")
End Try
End Function
Friend Function GetVideoData(ByVal r As String, ByVal ID As String, ByRef URL As String, ByRef [Date] As Date?) As Boolean
@@ -46,12 +42,12 @@ Namespace API.TikTok
Dim u$ = RegexReplace(r, VideoPattern)
If Not u.IsEmptyString Then URL = SymbolsConverter.Unicode.Decode(u, EDP.ReturnValue)
Dim d$ = RegexReplace(r, DatePattern)
- If Not d.IsEmptyString Then [Date] = ADateTime.ParseUnicode(d)
+ If Not d.IsEmptyString Then [Date] = ADateTime.ParseUnix32(d)
Return Not URL.IsEmptyString
End If
Return False
Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.TikTok.RegexParseEnvir.GetVideoData]", False)
+ Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.TikTok.RegexParseEnvir.GetVideoData]", False)
End Try
End Function
Friend Function ExtractPostID(ByVal URL As String) As String
diff --git a/SCrawler/API/TikTok/SiteSettings.vb b/SCrawler/API/TikTok/SiteSettings.vb
index fd3574e..bf9df98 100644
--- a/SCrawler/API/TikTok/SiteSettings.vb
+++ b/SCrawler/API/TikTok/SiteSettings.vb
@@ -32,11 +32,12 @@ Namespace API.TikTok
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
- Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
- Return UserData.GetVideoInfo(URL, Responser)
- End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists
End Function
+ Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
+ 'TODO: TikTok disabled
+ Return False
+ End Function
End Class
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/TikTok/UserData.vb b/SCrawler/API/TikTok/UserData.vb
index fbf1b4d..9ff3590 100644
--- a/SCrawler/API/TikTok/UserData.vb
+++ b/SCrawler/API/TikTok/UserData.vb
@@ -26,7 +26,7 @@ Namespace API.TikTok
Dim PostURL$ = String.Empty
Dim r$
URL = $"https://www.tiktok.com/@{Name}"
- r = Responser.GetResponse(URL,, EDP.ThrowException)
+ r = Responser.GetResponse(URL)
PostIDs = RegexEnvir.GetIDList(r)
If PostIDs.ListExists Then
For Each __id$ In PostIDs
@@ -52,28 +52,7 @@ Namespace API.TikTok
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
- Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Responser, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
- Try
- If Not URL.IsEmptyString Then
- Dim PostId$ = String.Empty
- Dim PostDate As Date? = Nothing
- Dim PostURL$ = String.Empty
- Dim r$
- PostId = RegexEnvir.ExtractPostID(URL)
- If Not PostId.IsEmptyString Then
- Using resp As Responser = Responser.Copy() : r = resp.GetResponse(URL,, EDP.ThrowException) : End Using
- If Not r.IsEmptyString Then
- If RegexEnvir.GetVideoData(r, PostId, PostURL, PostDate) Then Return {MediaFromData(PostURL, PostId, PostDate)}
- End If
- End If
- End If
- Return Nothing
- Catch ex As Exception
- If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowMainMsg + EDP.SendInLog)
- Return ErrorsDescriber.Execute(e, ex, $"TikTok standalone downloader: fetch media error ({URL})")
- End Try
- End Function
- Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As Date?) As UserMedia
+ Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As Date?) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, UserMedia.Types.Video) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = $"{PostID}.mp4"
diff --git a/SCrawler/API/Twitter/Declarations.vb b/SCrawler/API/Twitter/Declarations.vb
index 1073ac4..cee4a04 100644
--- a/SCrawler/API/Twitter/Declarations.vb
+++ b/SCrawler/API/Twitter/Declarations.vb
@@ -16,7 +16,6 @@ Namespace API.Twitter
Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
Friend ReadOnly VideoNode As NodeParams() = {New NodeParams("video_info", True, True, True, True, 10)}
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)
- Friend ReadOnly UserIdRegEx As RParams = RParams.DMS("user_id.:.(\d+)", 1, EDP.ReturnValue)
Private Function GetDateProvider() As ADateTime
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"
diff --git a/SCrawler/API/Twitter/EditorExchangeOptions.vb b/SCrawler/API/Twitter/EditorExchangeOptions.vb
index 346a41f..6ef40c0 100644
--- a/SCrawler/API/Twitter/EditorExchangeOptions.vb
+++ b/SCrawler/API/Twitter/EditorExchangeOptions.vb
@@ -6,20 +6,37 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
+Imports SCrawler.Plugin.Attributes
Namespace API.Twitter
Friend Class EditorExchangeOptions
+ Private Const DefaultOffset As Integer = 100
+ Friend Property SiteKey As String = TwitterSiteKey
+
Friend Property GifsDownload As Boolean
+
Friend Property GifsSpecialFolder As String
+
Friend Property GifsPrefix As String
+
Friend Property UseMD5Comparison As Boolean = False
+
Friend Property RemoveExistingDuplicates As Boolean = False
- Friend Sub New()
- End Sub
+ Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings)
GifsDownload = s.GifsDownload.Value
GifsSpecialFolder = s.GifsSpecialFolder.Value
GifsPrefix = s.GifsPrefix.Value
UseMD5Comparison = s.UseMD5Comparison.Value
+ MySettings = s
+ End Sub
+ Friend Sub New(ByVal s As Mastodon.SiteSettings)
+ GifsDownload = s.GifsDownload.Value
+ GifsSpecialFolder = s.GifsSpecialFolder.Value
+ GifsPrefix = s.GifsPrefix.Value
+ UseMD5Comparison = s.UseMD5Comparison.Value
+ MySettings = s
End Sub
Friend Sub New(ByVal u As UserData)
GifsDownload = u.GifsDownload
@@ -27,6 +44,7 @@ Namespace API.Twitter
GifsPrefix = u.GifsPrefix
UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates
+ MySettings = u.HOST.Source
End Sub
End Class
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Twitter/OptionsForm.Designer.vb b/SCrawler/API/Twitter/OptionsForm.Designer.vb
deleted file mode 100644
index 1b2dd82..0000000
--- a/SCrawler/API/Twitter/OptionsForm.Designer.vb
+++ /dev/null
@@ -1,185 +0,0 @@
-' Copyright (C) 2023 Andy https://github.com/AAndyProgram
-' This program is free software: you can redistribute it and/or modify
-' it under the terms of the GNU General Public License as published by
-' the Free Software Foundation, either version 3 of the License, or
-' (at your option) any later version.
-'
-' This program is distributed in the hope that it will be useful,
-' but WITHOUT ANY WARRANTY
-Namespace API.Twitter
-
- Partial Friend Class OptionsForm : Inherits System.Windows.Forms.Form
-
- Protected Overrides Sub Dispose(ByVal disposing As Boolean)
- Try
- If disposing AndAlso components IsNot Nothing Then
- components.Dispose()
- End If
- Finally
- MyBase.Dispose(disposing)
- End Try
- End Sub
- Private components As System.ComponentModel.IContainer
-
- Private Sub InitializeComponent()
- Me.components = New System.ComponentModel.Container()
- Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
- Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
- Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
- Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(OptionsForm))
- Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
- Dim TT_MAIN As System.Windows.Forms.ToolTip
- Me.CH_DOWN_GIFS = New System.Windows.Forms.CheckBox()
- Me.TXT_GIF_FOLDER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
- Me.TXT_GIF_PREFIX = New PersonalUtilities.Forms.Controls.TextBoxExtended()
- Me.CH_USE_MD5 = New System.Windows.Forms.CheckBox()
- Me.CH_REMOVE_EXISTING_DUP = New System.Windows.Forms.CheckBox()
- CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
- TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
- TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
- CONTAINER_MAIN.ContentPanel.SuspendLayout()
- CONTAINER_MAIN.SuspendLayout()
- TP_MAIN.SuspendLayout()
- CType(Me.TXT_GIF_FOLDER, System.ComponentModel.ISupportInitialize).BeginInit()
- CType(Me.TXT_GIF_PREFIX, System.ComponentModel.ISupportInitialize).BeginInit()
- Me.SuspendLayout()
- '
- 'CONTAINER_MAIN
- '
- '
- 'CONTAINER_MAIN.ContentPanel
- '
- CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
- CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(304, 161)
- CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
- CONTAINER_MAIN.LeftToolStripPanelVisible = False
- CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
- CONTAINER_MAIN.Name = "CONTAINER_MAIN"
- CONTAINER_MAIN.RightToolStripPanelVisible = False
- CONTAINER_MAIN.Size = New System.Drawing.Size(304, 161)
- CONTAINER_MAIN.TabIndex = 0
- CONTAINER_MAIN.TopToolStripPanelVisible = False
- '
- 'TP_MAIN
- '
- TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
- TP_MAIN.ColumnCount = 1
- TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
- TP_MAIN.Controls.Add(Me.CH_DOWN_GIFS, 0, 0)
- TP_MAIN.Controls.Add(Me.TXT_GIF_FOLDER, 0, 1)
- TP_MAIN.Controls.Add(Me.TXT_GIF_PREFIX, 0, 2)
- TP_MAIN.Controls.Add(Me.CH_USE_MD5, 0, 3)
- TP_MAIN.Controls.Add(Me.CH_REMOVE_EXISTING_DUP, 0, 4)
- TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
- TP_MAIN.Location = New System.Drawing.Point(0, 0)
- TP_MAIN.Name = "TP_MAIN"
- TP_MAIN.RowCount = 6
- TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
- TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
- TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
- TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
- TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
- TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
- TP_MAIN.Size = New System.Drawing.Size(304, 161)
- TP_MAIN.TabIndex = 0
- '
- 'CH_DOWN_GIFS
- '
- Me.CH_DOWN_GIFS.AutoSize = True
- Me.CH_DOWN_GIFS.Dock = System.Windows.Forms.DockStyle.Fill
- Me.CH_DOWN_GIFS.Location = New System.Drawing.Point(4, 4)
- Me.CH_DOWN_GIFS.Name = "CH_DOWN_GIFS"
- Me.CH_DOWN_GIFS.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
- Me.CH_DOWN_GIFS.Size = New System.Drawing.Size(296, 19)
- Me.CH_DOWN_GIFS.TabIndex = 0
- Me.CH_DOWN_GIFS.Text = "Download GIFs"
- Me.CH_DOWN_GIFS.UseVisualStyleBackColor = True
- '
- 'TXT_GIF_FOLDER
- '
- ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
- ActionButton3.Name = "Clear"
- ActionButton3.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
- Me.TXT_GIF_FOLDER.Buttons.Add(ActionButton3)
- Me.TXT_GIF_FOLDER.CaptionText = "GIFs special folder"
- Me.TXT_GIF_FOLDER.CaptionToolTipText = "Put the GIFs in a special folder"
- Me.TXT_GIF_FOLDER.Dock = System.Windows.Forms.DockStyle.Fill
- Me.TXT_GIF_FOLDER.Location = New System.Drawing.Point(4, 30)
- Me.TXT_GIF_FOLDER.Name = "TXT_GIF_FOLDER"
- Me.TXT_GIF_FOLDER.Size = New System.Drawing.Size(296, 22)
- Me.TXT_GIF_FOLDER.TabIndex = 1
- '
- 'TXT_GIF_PREFIX
- '
- ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
- ActionButton4.Name = "Clear"
- ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
- Me.TXT_GIF_PREFIX.Buttons.Add(ActionButton4)
- Me.TXT_GIF_PREFIX.CaptionText = "GIF prefix"
- Me.TXT_GIF_PREFIX.CaptionToolTipText = "This prefix will be added to the beginning of the filename"
- Me.TXT_GIF_PREFIX.Dock = System.Windows.Forms.DockStyle.Fill
- Me.TXT_GIF_PREFIX.Location = New System.Drawing.Point(4, 59)
- Me.TXT_GIF_PREFIX.Name = "TXT_GIF_PREFIX"
- Me.TXT_GIF_PREFIX.Size = New System.Drawing.Size(296, 22)
- Me.TXT_GIF_PREFIX.TabIndex = 2
- '
- 'CH_USE_MD5
- '
- Me.CH_USE_MD5.AutoSize = True
- Me.CH_USE_MD5.Dock = System.Windows.Forms.DockStyle.Fill
- Me.CH_USE_MD5.Location = New System.Drawing.Point(4, 88)
- Me.CH_USE_MD5.Name = "CH_USE_MD5"
- Me.CH_USE_MD5.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
- Me.CH_USE_MD5.Size = New System.Drawing.Size(296, 19)
- Me.CH_USE_MD5.TabIndex = 3
- Me.CH_USE_MD5.Text = "Use MD5 comparison"
- TT_MAIN.SetToolTip(Me.CH_USE_MD5, "Each image will be checked for existence using MD5")
- Me.CH_USE_MD5.UseVisualStyleBackColor = True
- '
- 'CH_REMOVE_EXISTING_DUP
- '
- Me.CH_REMOVE_EXISTING_DUP.AutoSize = True
- Me.CH_REMOVE_EXISTING_DUP.Dock = System.Windows.Forms.DockStyle.Fill
- Me.CH_REMOVE_EXISTING_DUP.Location = New System.Drawing.Point(4, 114)
- Me.CH_REMOVE_EXISTING_DUP.Name = "CH_REMOVE_EXISTING_DUP"
- Me.CH_REMOVE_EXISTING_DUP.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
- Me.CH_REMOVE_EXISTING_DUP.Size = New System.Drawing.Size(296, 19)
- Me.CH_REMOVE_EXISTING_DUP.TabIndex = 4
- Me.CH_REMOVE_EXISTING_DUP.Text = "Remove existing duplicates"
- TT_MAIN.SetToolTip(Me.CH_REMOVE_EXISTING_DUP, "Existing files will be checked for duplicates and duplicates removed." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Works only" &
- " on the first activation 'Use MD5 comparison'.")
- Me.CH_REMOVE_EXISTING_DUP.UseVisualStyleBackColor = True
- '
- 'OptionsForm
- '
- Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
- Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
- Me.ClientSize = New System.Drawing.Size(304, 161)
- Me.Controls.Add(CONTAINER_MAIN)
- Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
- Me.Icon = Global.SCrawler.My.Resources.SiteResources.TwitterIcon_32
- Me.MaximizeBox = False
- Me.MaximumSize = New System.Drawing.Size(320, 200)
- Me.MinimizeBox = False
- Me.MinimumSize = New System.Drawing.Size(320, 200)
- Me.Name = "OptionsForm"
- Me.ShowInTaskbar = False
- Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
- Me.Text = "Options"
- CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
- CONTAINER_MAIN.ResumeLayout(False)
- CONTAINER_MAIN.PerformLayout()
- TP_MAIN.ResumeLayout(False)
- TP_MAIN.PerformLayout()
- CType(Me.TXT_GIF_FOLDER, System.ComponentModel.ISupportInitialize).EndInit()
- CType(Me.TXT_GIF_PREFIX, System.ComponentModel.ISupportInitialize).EndInit()
- Me.ResumeLayout(False)
-
- End Sub
- Private WithEvents CH_DOWN_GIFS As CheckBox
- Private WithEvents TXT_GIF_FOLDER As PersonalUtilities.Forms.Controls.TextBoxExtended
- Private WithEvents TXT_GIF_PREFIX As PersonalUtilities.Forms.Controls.TextBoxExtended
- Private WithEvents CH_USE_MD5 As CheckBox
- Private WithEvents CH_REMOVE_EXISTING_DUP As CheckBox
- End Class
-End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Twitter/OptionsForm.vb b/SCrawler/API/Twitter/OptionsForm.vb
deleted file mode 100644
index 8cac46e..0000000
--- a/SCrawler/API/Twitter/OptionsForm.vb
+++ /dev/null
@@ -1,81 +0,0 @@
-' Copyright (C) 2023 Andy https://github.com/AAndyProgram
-' This program is free software: you can redistribute it and/or modify
-' it under the terms of the GNU General Public License as published by
-' the Free Software Foundation, either version 3 of the License, or
-' (at your option) any later version.
-'
-' This program is distributed in the hope that it will be useful,
-' but WITHOUT ANY WARRANTY
-Imports SCrawler.Plugin.Attributes
-Imports PersonalUtilities.Forms
-Imports PersonalUtilities.Forms.Controls
-Namespace API.Twitter
- Friend Class OptionsForm
- Private WithEvents MyDefs As DefaultFormOptions
- Private ReadOnly Property MyExchangeOptions As EditorExchangeOptions
- Private ReadOnly MyGifTextProvider As SiteSettings.GifStringProvider
- Friend Sub New(ByRef ExchangeOptions As EditorExchangeOptions)
- InitializeComponent()
- MyExchangeOptions = ExchangeOptions
- MyGifTextProvider = New SiteSettings.GifStringProvider
- MyDefs = New DefaultFormOptions(Me, Settings.Design)
- End Sub
- Private Sub OptionsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
- With MyDefs
- .MyViewInitialize(True)
- .AddOkCancelToolbar()
- With MyExchangeOptions
- CH_DOWN_GIFS.Checked = .GifsDownload
- TXT_GIF_FOLDER.Text = .GifsSpecialFolder
- TXT_GIF_FOLDER.Tag = NameOf(SiteSettings.GifsSpecialFolder)
- TXT_GIF_PREFIX.Text = .GifsPrefix
- TXT_GIF_PREFIX.Tag = NameOf(SiteSettings.GifsPrefix)
- CH_USE_MD5.Checked = .UseMD5Comparison
- CH_REMOVE_EXISTING_DUP.Checked = .RemoveExistingDuplicates
-
- Try
- Dim p As PropertyOption
- With Settings(TwitterSiteKey)
- p = .PropList.Find(Function(pp) pp.Name = TXT_GIF_FOLDER.Tag).Options
- If Not p Is Nothing Then
- TXT_GIF_FOLDER.CaptionText = p.ControlText
- TXT_GIF_FOLDER.CaptionToolTipText = p.ControlToolTip
- TXT_GIF_FOLDER.CaptionToolTipEnabled = Not TXT_GIF_FOLDER.CaptionToolTipText.IsEmptyString
- End If
-
- p = .PropList.Find(Function(pp) pp.Name = TXT_GIF_PREFIX.Tag).Options
- If Not p Is Nothing Then
- TXT_GIF_PREFIX.CaptionText = p.ControlText
- TXT_GIF_PREFIX.CaptionToolTipText = p.ControlToolTip
- TXT_GIF_PREFIX.CaptionToolTipEnabled = Not TXT_GIF_PREFIX.CaptionToolTipText.IsEmptyString
- End If
- End With
- Catch
- End Try
- End With
- .EndLoaderOperations()
- End With
- End Sub
- Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
- With MyExchangeOptions
- .GifsDownload = CH_DOWN_GIFS.Checked
- .GifsSpecialFolder = TXT_GIF_FOLDER.Text
- .GifsPrefix = TXT_GIF_PREFIX.Text
- .UseMD5Comparison = CH_USE_MD5.Checked
- .RemoveExistingDuplicates = CH_REMOVE_EXISTING_DUP.Checked
- End With
- MyDefs.CloseForm()
- End Sub
- Private Sub TXT_ActionOnTextChanged(ByVal Sender As TextBoxExtended, ByVal e As EventArgs) Handles TXT_GIF_FOLDER.ActionOnTextChanged,
- TXT_GIF_PREFIX.ActionOnTextChanged
- If Not MyDefs.Initializing Then
- With Sender
- MyGifTextProvider.PropertyName = .Tag
- Dim s% = .SelectionStart
- Dim t$ = AConvert(Of String)(.Text, String.Empty, MyGifTextProvider)
- If Not .Text = t Then .Text = t : .Select(s, 0)
- End With
- End If
- End Sub
- End Class
-End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Twitter/SiteSettings.vb b/SCrawler/API/Twitter/SiteSettings.vb
index c5d2043..358f89b 100644
--- a/SCrawler/API/Twitter/SiteSettings.vb
+++ b/SCrawler/API/Twitter/SiteSettings.vb
@@ -11,12 +11,25 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
-Imports PersonalUtilities.Tools.Web.Cookies
Namespace API.Twitter
Friend Class SiteSettings : Inherits SiteSettingsBase
+#Region "Token names"
Friend Const Header_Authorization As String = "authorization"
Friend Const Header_Token As String = "x-csrf-token"
+#End Region
+#Region "Properties constants"
+ Friend Const GifsSpecialFolder_Text As String = "GIFs special folder"
+ Friend Const GifsSpecialFolder_ToolTip As String = "Put the GIFs in a special folder" & vbCr &
+ "This is a folder name, not an absolute path." & vbCr &
+ "This folder(s) will be created relative to the user's root folder." & vbCr &
+ "Examples:" & vbCr & "SomeFolderName" & vbCr & "SomeFolderName\SomeFolderName2"
+ Friend Const GifsPrefix_Text As String = "GIF prefix"
+ Friend Const GifsPrefix_ToolTip As String = "This prefix will be added to the beginning of the filename"
+ Friend Const GifsDownload_Text As String = "Download GIFs"
+ Friend Const UseMD5Comparison_Text As String = "Use MD5 comparison"
+ Friend Const UseMD5Comparison_ToolTip As String = "Each image will be checked for existence using MD5"
+#End Region
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
@@ -34,19 +47,13 @@ Namespace API.Twitter
Private ReadOnly Property Auth As PropertyValue
Private ReadOnly Property Token As PropertyValue
-
- Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region
#Region "Other properties"
-
+
Friend ReadOnly Property GifsDownload As PropertyValue
-
+
Friend ReadOnly Property GifsSpecialFolder As PropertyValue
-
+
Friend ReadOnly Property GifsPrefix As PropertyValue
Private ReadOnly Property GifStringChecker As IFormatProvider
@@ -60,69 +67,18 @@ Namespace API.Twitter
v = v.StringRemoveWinForbiddenSymbols
Else
v = v.StringReplaceSymbols(GetWinForbiddenSymbols.ToList.ListWithRemove("\").ToArray, String.Empty, EDP.ReturnValue)
- v = v.StringTrim("\")
End If
End If
Return v
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
- Throw New NotImplementedException("[GetFormat] is not available in the context of [TimersChecker]")
+ Throw New NotImplementedException("[GetFormat] is not available in the context of [GifStringProvider]")
End Function
End Class
-
+
Friend ReadOnly Property UseMD5Comparison As PropertyValue
#End Region
Friend Overrides ReadOnly Property Responser As Responser
-#End Region
- Friend Sub New()
- MyBase.New(TwitterSite)
- Responser = New Responser($"{SettingsFolderName}\Responser_{Site}.xml")
-
- Dim a$ = String.Empty
- Dim t$ = String.Empty
-
- With Responser
- If .File.Exists Then
- Dim b As Boolean = .CookiesDomain.IsEmptyString
- If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
- .LoadSettings()
- a = .Headers.Value(Header_Authorization)
- t = .Headers.Value(Header_Token)
- .CookiesDomain = "twitter.com"
- If b Then .SaveSettings()
- Else
- .ContentType = "application/json"
- .Accept = "*/*"
- .CookiesDomain = "twitter.com"
- .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
- .Decoders.Add(SymbolsConverter.Converters.Unicode)
- .Headers.Add("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
- .Headers.Add("sec-ch-ua-mobile", "?0")
- .Headers.Add("sec-fetch-dest", "empty")
- .Headers.Add("sec-fetch-mode", "cors")
- .Headers.Add("sec-fetch-site", "same-origin")
- .Headers.Add(Header_Token, String.Empty)
- .Headers.Add("x-twitter-active-user", "yes")
- .Headers.Add("x-twitter-auth-type", "OAuth2Session")
- .Headers.Add(Header_Authorization, String.Empty)
- .SaveSettings()
- End If
- End With
-
- Auth = New PropertyValue(a, GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v))
- Token = New PropertyValue(t, GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
- SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
-
- GifsDownload = New PropertyValue(True)
- GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String))
- GifsPrefix = New PropertyValue("GIF_")
- GifStringChecker = New GifStringProvider
- UseMD5Comparison = New PropertyValue(False)
-
- UserRegex = RParams.DMS("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1)
- UrlPatternUser = "https://twitter.com/{0}"
- ImageVideoContains = "twitter"
- End Sub
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
@@ -137,15 +93,59 @@ Namespace API.Twitter
End If
End If
End Sub
+#End Region
+ Friend Sub New()
+ MyBase.New(TwitterSite)
+ Responser = New Responser($"{SettingsFolderName}\Responser_{Site}.xml") With {.DeclaredError = EDP.ThrowException}
+
+ Dim a$ = String.Empty
+ Dim t$ = String.Empty
+
+ With Responser
+ If .File.Exists Then
+ .CookiesDomain = "twitter.com"
+ .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
+ .LoadSettings()
+ a = .Headers.Value(Header_Authorization)
+ t = .Headers.Value(Header_Token)
+ Else
+ .ContentType = "application/json"
+ .Accept = "*/*"
+ .CookiesDomain = "twitter.com"
+ .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
+ .Decoders.Add(SymbolsConverter.Converters.Unicode)
+ .Headers.Add("sec-ch-ua", """Chromium"";v=""112"", ""Google Chrome"";v=""112"", ""Not:A-Brand"";v=""99""")
+ .Headers.Add("sec-ch-ua-mobile", "?0")
+ .Headers.Add("sec-fetch-dest", "empty")
+ .Headers.Add("sec-fetch-mode", "cors")
+ .Headers.Add("sec-fetch-site", "same-origin")
+ .Headers.Add(Header_Token, String.Empty)
+ .Headers.Add("x-twitter-active-user", "yes")
+ .Headers.Add("x-twitter-auth-type", "OAuth2Session")
+ .Headers.Add(Header_Authorization, String.Empty)
+ .SaveSettings()
+ End If
+ .Cookies.ChangedAllowInternalDrop = False
+ .Cookies.Changed = False
+ End With
+
+ Auth = New PropertyValue(a, GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v))
+ Token = New PropertyValue(t, GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
+
+ GifsDownload = New PropertyValue(True)
+ GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String))
+ GifsPrefix = New PropertyValue("GIF_")
+ GifStringChecker = New GifStringProvider
+ UseMD5Comparison = New PropertyValue(False)
+
+ UserRegex = RParams.DMS("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1)
+ UrlPatternUser = "https://twitter.com/{0}"
+ ImageVideoContains = "twitter"
+ CheckNetscapeCookiesOnEndInit = True
+ UseNetscapeCookies = True
+ End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
- If What = ISiteSettings.Download.SavedPosts Then
- Return New UserData With {.IsSavedPosts = True, .User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}}
- Else
- Return New UserData
- End If
- End Function
- Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
- Return UserData.GetVideoInfo(URL, Responser)
+ Return New UserData
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://twitter.com/{User.Name}/status/{Media.Post.ID}"
@@ -153,11 +153,31 @@ Namespace API.Twitter
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And ACheck(Token.Value) And ACheck(Auth.Value)
End Function
- Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
- If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
- If OpenForm Then
- Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
+ Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
+ If MyBase.Available(What, Silent) Then
+ If What = ISiteSettings.Download.SavedPosts Then
+ Return Settings.GalleryDLFile.Exists
+ Else
+ Return True
+ End If
+ Else
+ Return False
End If
+ End Function
+ Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
+ If Options Is Nothing OrElse (Not TypeOf Options Is EditorExchangeOptions OrElse
+ Not DirectCast(Options, EditorExchangeOptions).SiteKey = TwitterSiteKey) Then _
+ Options = New EditorExchangeOptions(Me)
+ If OpenForm Then
+ Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
+ End If
+ End Sub
+ Friend Overrides Sub Update()
+ If _SiteEditorFormOpened Then
+ Dim tf$ = GifsSpecialFolder.Value
+ If Not tf.IsEmptyString Then tf = tf.StringTrim("\") : GifsSpecialFolder.Value = tf
+ End If
+ MyBase.Update()
End Sub
End Class
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Twitter/UserData.vb b/SCrawler/API/Twitter/UserData.vb
index 855bf6c..069d567 100644
--- a/SCrawler/API/Twitter/UserData.vb
+++ b/SCrawler/API/Twitter/UserData.vb
@@ -7,39 +7,32 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Net
-Imports System.Drawing
Imports System.Threading
Imports SCrawler.API.Base
+Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
-Imports PersonalUtilities.Tools.ImageRenderer
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase
- Private Const SinglePostUrl As String = "https://api.twitter.com/1.1/statuses/show.json?id={0}&tweet_mode=extended"
+ Protected SinglePostUrl As String = "https://api.twitter.com/1.1/statuses/show.json?id={0}&tweet_mode=extended"
#Region "XML names"
Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
- Private Const Name_UseMD5Comparison As String = "UseMD5Comparison"
- Private Const Name_RemoveExistingDuplicates As String = "RemoveExistingDuplicates"
- Private Const Name_StartMD5Checked As String = "StartMD5Checked"
#End Region
#Region "Declarations"
- Friend Property GifsDownload As Boolean
- Friend Property GifsSpecialFolder As String
- Friend Property GifsPrefix As String
+ Friend Property GifsDownload As Boolean = True
+ Friend Property GifsSpecialFolder As String = String.Empty
+ Friend Property GifsPrefix As String = String.Empty
Private ReadOnly _DataNames As List(Of String)
- Friend Property UseMD5Comparison As Boolean = False
- Private StartMD5Checked As Boolean = False
- Friend Property RemoveExistingDuplicates As Boolean = False
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
- Return New EditorExchangeOptions(Me)
+ Return New EditorExchangeOptions(Me) With {.SiteKey = HOST.Key}
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
@@ -83,45 +76,35 @@ Namespace API.Twitter
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If IsSavedPosts Then
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
- DownloadData(String.Empty, Token)
+ DownloadData_SavedPosts(Token)
Else
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData(String.Empty, Token)
- If UseMD5Comparison Then ValidateMD5(Token)
End If
End Sub
Private Overloads Sub DownloadData(ByVal POST As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
- Dim NextCursor$ = String.Empty
- Dim __NextCursor As Predicate(Of EContainer) = Function(e) e.Value({"content", "operation", "cursor"}, "cursorType") = "Bottom"
Dim PostID$ = String.Empty
Dim PostDate$
- Dim nn As EContainer, s As EContainer
+ Dim nn As EContainer
Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False
Dim UID As Func(Of EContainer, String) = Function(e) e.XmlIfNothing.Item({"user", "id"}).XmlIfNothingValue
- If IsSavedPosts Then
- If Name.IsEmptyString Then Throw New ArgumentNullException With {.HelpLink = 1}
- URL = $"https://api.twitter.com/2/timeline/bookmark.json?screen_name={Name}&count=200" &
- "&tweet_mode=extended&include_entities=true&include_user_entities=true&include_ext_media_availability=true"
- If Not POST.IsEmptyString Then URL &= $"&cursor={SymbolsConverter.ASCII.EncodeSymbolsOnly(POST)}"
- Else
- URL = $"https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name={Name}&count=200&exclude_replies=false&include_rts=1&tweet_mode=extended"
- If Not POST.IsEmptyString Then URL &= $"&max_id={POST}"
- End If
+ URL = $"https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name={Name}&count=200&exclude_replies=false&include_rts=1&tweet_mode=extended"
+ If Not POST.IsEmptyString Then URL &= $"&max_id={POST}"
ThrowAny(Token)
- Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
+ Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r)
If w.ListExists Then
- If Not IsSavedPosts And POST.IsEmptyString And Not w.ItemF({0, "user"}) Is Nothing Then
+ If POST.IsEmptyString And Not w.ItemF({0, "user"}) Is Nothing Then
With w.ItemF({0, "user"})
- If .Value("screen_name").StringToLower = Name Then
+ If .Value("screen_name").StringToLower = Name.ToLower Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
@@ -145,15 +128,10 @@ Namespace API.Twitter
For Each nn In If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, w)
ThrowAny(Token)
If nn.Count > 0 Then
- If IsSavedPosts Then
- PostID = nn.Value
- If PostID.IsEmptyString Then PostID = nn.Value("id_str")
- Else
- PostID = nn.Value("id")
- If ID.IsEmptyString Then
- ID = UID(nn)
- If Not ID.IsEmptyString Then UpdateUserInformation()
- End If
+ PostID = nn.Value("id")
+ If ID.IsEmptyString Then
+ ID = UID(nn)
+ If Not ID.IsEmptyString Then UpdateUserInformation()
End If
'Date Pattern:
@@ -172,32 +150,58 @@ Namespace API.Twitter
Continue For
End If
- If IsSavedPosts OrElse Not ParseUserMediaOnly OrElse
- (
- Not nn.Contains("retweeted_status") OrElse
- (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)
- ) Then ObtainMedia(nn, PostID, PostDate)
+ If Not ParseUserMediaOnly OrElse
+ (Not nn.Contains("retweeted_status") OrElse (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then _
+ ObtainMedia(nn, PostID, PostDate)
End If
Next
-
- If IsSavedPosts Then
- s = w.ItemF({"timeline", "instructions", 0, "addEntries", "entries"}).XmlIfNothing
- If s.Count > 0 Then NextCursor = If(s.ItemF({__NextCursor})?.Value({"content", "operation", "cursor"}, "value"), String.Empty)
- End If
End If
End Using
- If IsSavedPosts Then
- If Not NextCursor.IsEmptyString And Not NextCursor = POST Then DownloadData(NextCursor, Token)
- Else
- If POST.IsEmptyString And ExistsDetected Then Exit Sub
- If Not PostID.IsEmptyString And NewPostDetected Then DownloadData(PostID, Token)
+ If POST.IsEmptyString And ExistsDetected Then Exit Sub
+ If Not PostID.IsEmptyString And NewPostDetected Then DownloadData(PostID, Token)
+ End If
+ Catch ex As Exception
+ ProcessException(ex, Token, $"data downloading error [{URL}]")
+ End Try
+ End Sub
+ Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken)
+ Try
+ Dim urls As List(Of String) = GetBookmarksUrlsFromGalleryDL()
+ If urls.ListExists Then
+ Dim postIds As New List(Of String)
+ Dim r$
+ Dim j As EContainer, jj As EContainer
+ Dim jErr As New ErrorsDescriber(EDP.ReturnValue)
+ Dim rPattern As RParams = RParams.DM("(?<=tweet-)(\d+)\Z", 0, EDP.ReturnValue)
+ For Each url$ In urls
+ r = Responser.GetResponse(url)
+ If Not r.IsEmptyString Then
+ j = JsonDocument.Parse(r, jErr)
+ If Not j Is Nothing Then
+ jj = j.ItemF({"data", "bookmark_timeline_v2", "timeline", "instructions", 0, "entries"})
+ If If(jj?.Count, 0) > 0 Then postIds.ListAddList(jj.Select(Function(jj2) CStr(RegexReplace(jj2.Value("entryId"), rPattern))), LNC)
+ j.Dispose()
+ End If
+ End If
+ Next
+ If postIds.Count > 0 Then postIds.RemoveAll(Function(pid) pid.IsEmptyString OrElse (_TempPostsList.Contains(pid) Or _DataNames.Contains(pid)))
+ If postIds.Count > 0 Then
+ For Each __id$ In postIds
+ _TempPostsList.Add(__id)
+ r = Responser.GetResponse(String.Format(SinglePostUrl, __id),, EDP.ReturnValue)
+ If Not r.IsEmptyString Then
+ j = JsonDocument.Parse(r, jErr)
+ If Not j Is Nothing Then
+ If j.Count > 0 Then ObtainMedia(j, __id, j.Value("created_at"))
+ j.Dispose()
+ End If
+ End If
+ Next
End If
End If
- Catch ane As ArgumentNullException When ane.HelpLink = 1
- MyMainLOG = "Username not set for saved Twitter posts"
Catch ex As Exception
- ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
+ ProcessException(ex, Token, "data downloading error (Saved Posts)")
End Try
End Sub
#End Region
@@ -252,18 +256,24 @@ Namespace API.Twitter
If .ListExists Then
For Each n As EContainer In .Self
If n.Value("type") = "animated_gif" Then
- With n({"video_info", "variants"}).XmlIfNothing.ItemF({gifUrl}).XmlIfNothing
- url = .Value("url")
- ff = UrlFile(url)
- If Not ff.IsEmptyString Then
- If GifsDownload And Not _DataNames.Contains(ff) Then
- m = MediaFromData(url, PostID, PostDate,, State, UTypes.Video)
- f = m.File
- If Not f.IsEmptyString And Not GifsPrefix.IsEmptyString Then f.Name = $"{GifsPrefix}{f.Name}" : m.File = f
- If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = $"{GifsSpecialFolder}*"
- _TempMediaList.ListAddValue(m, LNC)
- End If
- Return True
+ With n({"video_info", "variants"})
+ If .ListExists Then
+ With .ItemF({gifUrl})
+ If .ListExists Then
+ url = .Value("url")
+ ff = UrlFile(url)
+ If Not ff.IsEmptyString Then
+ If GifsDownload And Not _DataNames.Contains(ff) Then
+ m = MediaFromData(url, PostID, PostDate,, State, UTypes.Video)
+ f = m.File
+ If Not f.IsEmptyString And Not GifsPrefix.IsEmptyString Then f.Name = $"{GifsPrefix}{f.Name}" : m.File = f
+ If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = $"{GifsSpecialFolder}*"
+ _TempMediaList.ListAddValue(m, LNC)
+ End If
+ Return True
+ End If
+ End If
+ End With
End If
End With
End If
@@ -276,7 +286,7 @@ Namespace API.Twitter
Return False
End Try
End Function
- Private Shared Function GetVideoNodeURL(ByVal w As EContainer) As String
+ Private Function GetVideoNodeURL(ByVal w As EContainer) As String
Dim v As EContainer = w.GetNode(VideoNode)
If v.ListExists Then
Dim l As New List(Of Sizes)
@@ -298,6 +308,18 @@ Namespace API.Twitter
Return String.Empty
End Function
#End Region
+#Region "Gallery-DL Support"
+ Private Function GetBookmarksUrlsFromGalleryDL() As List(Of String)
+ Dim command$ = $"gallery-dl --verbose --simulate --cookies ""{DirectCast(HOST.Source, SiteSettings).CookiesNetscapeFile}"" https://twitter.com/i/bookmarks"
+ Try
+ Using batch As New GDL.GDLBatch With {.TempPostsList = _TempPostsList} : Return GDL.GetUrlsFromGalleryDl(batch, command) : End Using
+ Catch ex As Exception
+ HasError = True
+ LogError(ex, $"GetJson({command})")
+ Return Nothing
+ End Try
+ End Function
+#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
@@ -337,156 +359,19 @@ Namespace API.Twitter
End Try
End Sub
#End Region
-#Region "MD5 support"
- Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
- Private 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 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 Then
- hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL_BASE.IfNullOrEmpty(__data.URL), ErrMD5), ImgFormat, 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_BASE.IfNullOrEmpty(__data.URL), 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$
- For i = existingFiles.Count - 1 To 0 Step -1
- 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
- For i = 0 To _ContentList.Count - 1
- data = _ContentList(i)
- 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
- For i = 0 To existingFiles.Count - 1
- f = existingFiles(i)
- 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
-
- For i = _TempMediaList.Count - 1 To 0 Step -1
- 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
- End If
- End If
- End If
- Next
+#Region "DownloadSingleObject"
+ Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
+ Dim PostID$ = RegexReplace(Data.URL, RParams.DM("(?<=/)\d+", 0))
+ If Not PostID.IsEmptyString Then
+ Dim r$ = Responser.GetResponse(String.Format(SinglePostUrl, PostID),, EDP.ReturnValue)
+ If Not r.IsEmptyString Then
+ Using j As EContainer = JsonDocument.Parse(r)
+ If j.ListExists Then ObtainMedia(j, j.Value("id"), j.Value("created_at"))
+ End Using
End If
- Catch ex As Exception
- ProcessException(ex, Token, "ValidateMD5",, VALIDATE_MD5_ERROR)
- End Try
+ End If
End Sub
#End Region
-#Region "Get video static"
- Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Responser) As IEnumerable(Of UserMedia)
- Try
- If URL.Contains("twitter") Then
- Dim PostID$ = RegexReplace(URL, RParams.DM("(?<=/)\d+", 0))
- If Not PostID.IsEmptyString Then
- Dim r$
- Using rc As Responser = resp.Copy() : r = rc.GetResponse(String.Format(SinglePostUrl, PostID),, EDP.ReturnValue) : End Using
- If Not r.IsEmptyString Then
- Using j As EContainer = JsonDocument.Parse(r)
- If j.ListExists Then
- Dim u$ = GetVideoNodeURL(j)
- If Not u.IsEmptyString Then Return {MediaFromData(u, PostID, String.Empty,,, UTypes.Video)}
- End If
- End Using
- End If
- End If
- End If
- Return Nothing
- Catch ex As Exception
- Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, $"Twitter standalone downloader: fetch media error ({URL})")
- End Try
- End Function
-#End Region
#Region "Picture options"
Private Function GetPictureOption(ByVal w As EContainer) As String
Const P4K As String = "4096x4096"
@@ -541,10 +426,10 @@ Namespace API.Twitter
End Function
#End Region
#Region "Create media"
- Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
- Optional ByVal _PictureOption As String = Nothing,
- Optional ByVal State As UStates = UStates.Unknown,
- Optional ByVal Type As UTypes = UTypes.Undefined) As UserMedia
+ Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
+ Optional ByVal _PictureOption As String = Nothing,
+ Optional ByVal State As UStates = UStates.Unknown,
+ Optional ByVal Type As UTypes = UTypes.Undefined) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}, .Type = Type}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
diff --git a/SCrawler/API/UserDataBind.vb b/SCrawler/API/UserDataBind.vb
index adcb318..86d3b2a 100644
--- a/SCrawler/API/UserDataBind.vb
+++ b/SCrawler/API/UserDataBind.vb
@@ -49,13 +49,10 @@ Namespace API
_CollectionName = NewName
If Count > 0 Then Collections.ForEach(Sub(c) c.CollectionName = NewName)
End Sub
- Friend Overrides Property Name As String
+ Friend Overrides ReadOnly Property Name As String
Get
Return CollectionName
End Get
- Set(ByVal NewCollectionName As String)
- CollectionName = NewCollectionName
- End Set
End Property
Friend Overrides Property FriendlyName As String
Get
@@ -367,7 +364,7 @@ Namespace API
#End Region
#Region "Open site, folder"
Friend Overrides Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
- If Not e.Exists Then e = New ErrorsDescriber(EDP.SendInLog)
+ If Not e.Exists Then e = New ErrorsDescriber(EDP.SendToLog)
If Count > 0 Then Collections.ForEach(Sub(c) c.OpenSite(e))
End Sub
Private ReadOnly RealUser As Predicate(Of IUserData) = Function(u) u.UserModel = UsageModel.Default And Not u.HOST.Key = PathPlugin.PluginKey
@@ -575,7 +572,7 @@ Namespace API
MainFrameObj.ImageHandler(Me, False)
Collections.ListClearDispose
Dispose(False)
- If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
+ If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendToLog)
Return 2
End If
Case 1
@@ -592,7 +589,7 @@ Namespace API
If Collections.All(Function(c) c.CollectionName.IsEmptyString) Then
Settings.Users.Remove(Me)
Collections.Clear()
- If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
+ If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendToLog)
Downloader.UserRemove(Me)
MainFrameObj.ImageHandler(Me, False)
Dispose(False)
diff --git a/SCrawler/API/XVIDEOS/Declarations.vb b/SCrawler/API/XVIDEOS/Declarations.vb
index 4043f31..f174492 100644
--- a/SCrawler/API/XVIDEOS/Declarations.vb
+++ b/SCrawler/API/XVIDEOS/Declarations.vb
@@ -16,7 +16,7 @@ Namespace API.XVIDEOS
Friend ReadOnly Regex_VideoID As RParams = RParams.DMS(".*?www.xvideos.com/(video\d+).*", 1)
Friend ReadOnly Regex_M3U8_Reparse As RParams = RParams.DM("NAME=""(\d+).*?""[\r\n]*?(.+)(?=(|[\r\n]+?))", 0, RegexReturn.List)
Friend ReadOnly Regex_M3U8_Appender As RParams = RParams.DM("(.+)(?=/.+?\.m3u8.*?)", 0)
- Friend ReadOnly Regex_SavedVideosPlaylist As RParams = RParams.DM("
- Friend Class SiteSettings : Inherits SiteSettingsBase : Implements IDomainContainer
+ Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
- Friend Overrides ReadOnly Property Icon As Icon Implements IDomainContainer.Icon
+ Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.XvideosIcon_48
End Get
@@ -26,21 +25,10 @@ Namespace API.XVIDEOS
Return My.Resources.SiteResources.XvideosPic_32
End Get
End Property
-#Region "Domains"
- Private ReadOnly Property IDomainContainer_Site As String Implements IDomainContainer.Site
- Get
- Return Site
- End Get
- End Property
-
Private ReadOnly Property SiteDomains As PropertyValue Implements IDomainContainer.DomainsSettingProp
- Friend ReadOnly Property Domains As List(Of String) Implements IDomainContainer.Domains
- Private ReadOnly Property DomainsTemp As List(Of String) Implements IDomainContainer.DomainsTemp
- Private Property DomainsChanged As Boolean = False Implements IDomainContainer.DomainsChanged
- Private ReadOnly Property DomainsDefault As String = "xvideos.com|xnxx.com" Implements IDomainContainer.DomainsDefault
-#End Region
+ Private ReadOnly Property SiteDomains As PropertyValue
+ Friend ReadOnly Property Domains As DomainsContainer
Friend Property DownloadUHD As PropertyValue
- Private Property Initialized As Boolean = False Implements IDomainContainer.Initialized
0 Then
- If Domains.Exists(Function(d) URL.Contains(d)) Then Return New ExchangeOptions With {.UserName = URL, .Exists = True}
- End If
- Return Nothing
- End Function
- Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
- If Not URL.IsEmptyString And Settings.UseM3U8 Then
- Dim spf$ = String.Empty
- Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
- f.Name = "video"
- f.Extension = "mp4"
- Using resp As Responser = Responser.Copy
- Using user As New UserData With {.HOST = Settings(XvideosSiteKey)}
- DirectCast(user, UserDataBase).User.File = f
- Dim p As UserMedia = user.Download(URL, resp, DownloadUHD.Value, String.Empty)
- If p.State = UserMedia.States.Downloaded Then p.SpecialFolder = spf : Return {p}
- End Using
- End Using
+ If Domains.Domains.Exists(Function(d) URL.Contains(d)) Then Return New ExchangeOptions(Site, URL)
End If
Return Nothing
End Function
diff --git a/SCrawler/API/XVIDEOS/UserData.vb b/SCrawler/API/XVIDEOS/UserData.vb
index 931cacf..05b04c7 100644
--- a/SCrawler/API/XVIDEOS/UserData.vb
+++ b/SCrawler/API/XVIDEOS/UserData.vb
@@ -8,11 +8,11 @@
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
+Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
-Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.XVIDEOS
Friend Class UserData : Inherits UserDataBase
@@ -24,8 +24,8 @@ Namespace API.XVIDEOS
If ParamsArray.ListExists(3) Then
ID = ParamsArray(0)
URL = ParamsArray(1)
- If Not URL.IsEmptyString Then URL = $"https://www.xvideos.com/{URL.StringTrimStart("/")}"
- Title = ParamsArray(2)
+ If Not URL.IsEmptyString Then URL = $"https://www.xvideos.com/{HtmlConverter(URL).StringTrimStart("/")}"
+ Title = TitleHtmlConverter(ParamsArray(2))
End If
Return Me
End Function
@@ -43,6 +43,7 @@ Namespace API.XVIDEOS
Friend Sub New()
SeparateVideoFolder = False
UseInternalM3U8Function = True
+ UseClientTokens = True
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not Settings.UseM3U8 Then MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found" : Exit Sub
@@ -55,6 +56,7 @@ Namespace API.XVIDEOS
End Sub
Private Sub DownloadUserVideo(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
+ Dim isQuickies As Boolean = False
Try
Dim NextPage%, d%
Dim limit% = If(DownloadTopCount, -1)
@@ -77,39 +79,43 @@ Namespace API.XVIDEOS
URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}"
Else 'Quickies
URL = $"https://www.xvideos.com/quickies-api/profilevideos/all/none/N/{ID}/{NextPage}"
+ isQuickies = True
End If
+ If Not j Is Nothing Then j.Dispose()
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
- j = JsonDocument.Parse(r).XmlIfNothing
- With j
- If .Contains("videos") Then
- With .Item("videos")
- If .Count > 0 Then
- NextPage += 1
- For Each jj In .Self
- p = New UserMedia With {
- .Post = jj.Value("id"),
- .URL = $"https://www.xvideos.com/{jj.Value(n).StringTrimStart("/")}"
- }
- If Not p.Post.ID.IsEmptyString And Not jj.Value(n).IsEmptyString Then
- If Not _TempPostsList.Contains(p.Post.ID) Then
- _TempPostsList.Add(p.Post.ID)
- _TempMediaList.Add(p)
- d += 1
- If limit > 0 And d = limit Then Exit Do
- Else
- Exit Do
+ j = JsonDocument.Parse(r)
+ If Not j Is Nothing Then
+ With j
+ If .Contains("videos") Then
+ With .Item("videos")
+ If .Count > 0 Then
+ NextPage += 1
+ For Each jj In .Self
+ p = New UserMedia With {
+ .Post = jj.Value("id"),
+ .URL = $"https://www.xvideos.com/{jj.Value(n).StringTrimStart("/")}"
+ }
+ If Not p.Post.ID.IsEmptyString And Not jj.Value(n).IsEmptyString Then
+ If Not _TempPostsList.Contains(p.Post.ID) Then
+ _TempPostsList.Add(p.Post.ID)
+ _TempMediaList.Add(p)
+ d += 1
+ If limit > 0 And d = limit Then Exit Do
+ Else
+ Exit Do
+ End If
End If
- End If
- Next
- Continue Do
- End If
- End With
- End If
- End With
+ Next
+ Continue Do
+ End If
+ End With
+ End If
+ .Dispose()
+ End With
+ End If
End If
- If Not j Is Nothing Then j.Dispose()
Exit Do
Loop While NextPage < 100
Next
@@ -119,18 +125,12 @@ Namespace API.XVIDEOS
If _TempMediaList.Count > 0 Then
For i% = 0 To _TempMediaList.Count - 1
ThrowAny(Token)
- _TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
+ _TempMediaList(i) = GetVideoData(_TempMediaList(i))
Next
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If
- Catch oex As OperationCanceledException
- Catch dex As ObjectDisposedException
Catch ex As Exception
- If Responser.StatusCode = Net.HttpStatusCode.NotFound Then
- UserExists = False
- Else
- ProcessException(ex, Token, $"data downloading error [{URL}]")
- End If
+ ProcessException(ex, Token, $"data downloading error [{URL}]",, isQuickies)
Finally
If _TempMediaList.ListExists Then _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End Try
@@ -152,8 +152,16 @@ Namespace API.XVIDEOS
URL = $"{MySettings.SavedVideosPlaylist.Value}{If(NextPage = 0, String.Empty, $"/{NextPage}")}"
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Responser.HasError Then
- If Responser.StatusCode = Net.HttpStatusCode.NotFound And NextPage > 0 Then Exit Do
- Throw New Exception(Responser.ErrorText, Responser.ErrorException)
+ If Responser.StatusCode = Net.HttpStatusCode.NotFound Then
+ If NextPage = 0 Then
+ MyMainLOG = $"XVIDEOS saved video playlist {URL} not found."
+ Exit Sub
+ Else
+ Exit Do
+ End If
+ Else
+ Throw New Exception(Responser.ErrorText, Responser.ErrorException)
+ End If
End If
NextPage += 1
If Not r.IsEmptyString Then
@@ -174,7 +182,7 @@ Namespace API.XVIDEOS
If _TempMediaList.Count > 0 Then
For i% = 0 To _TempMediaList.Count - 1
ThrowAny(Token)
- _TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
+ _TempMediaList(i) = GetVideoData(_TempMediaList(i))
Next
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If
@@ -182,19 +190,19 @@ Namespace API.XVIDEOS
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
- Private Function GetVideoData(ByVal Media As UserMedia, ByVal resp As Responser, ByVal DownloadUHD As Boolean) As UserMedia
+ Private Function GetVideoData(ByVal Media As UserMedia) As UserMedia
Try
If Not Media.URL.IsEmptyString Then
- Dim r$ = resp.GetResponse(Media.URL)
+ Dim r$ = Responser.GetResponse(Media.URL)
If Not r.IsEmptyString Then
Dim NewUrl$ = RegexReplace(r, Regex_M3U8)
If Not NewUrl.IsEmptyString Then
Dim appender$ = RegexReplace(NewUrl, Regex_M3U8_Appender)
Dim t$ = If(Media.PictureOption.IsEmptyString, RegexReplace(r, Regex_VideoTitle), Media.PictureOption)
- r = resp.GetResponse(NewUrl)
+ r = Responser.GetResponse(NewUrl)
If Not r.IsEmptyString Then
Dim ls As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_Reparse}, {1, 2})
- If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) Not v.Value.ValueBetween(1, 1080))
+ If ls.ListExists And Not MySettings.DownloadUHD.Value Then ls.RemoveAll(Function(v) Not v.Value.ValueBetween(1, 1080))
If ls.ListExists Then
ls.Sort()
NewUrl = $"{appender}/{ls(0).Data.StringTrimStart("/")}"
@@ -228,31 +236,28 @@ Namespace API.XVIDEOS
Return Nothing
End Try
End Function
- Friend Function Download(ByVal URL As String, ByVal resp As Responser, ByVal DownloadUHD As Boolean, ByVal ID As String)
- Dim m As UserMedia = GetVideoData(New UserMedia(URL, UTypes.VideoPre) With {.Post = ID}, resp, DownloadUHD)
- If Not m.URL.IsEmptyString Then
- Dim f As SFile = m.File
- f.Path = MyFile.PathNoSeparator
- m.State = UStates.Tried
- Try
- f = M3U8.Download(m.URL, m.PictureOption, f)
- m.File = f
- m.State = UStates.Downloaded
- Catch ex As Exception
- m.State = UStates.Missing
- End Try
- End If
- Return m
- End Function
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
- Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
- Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile)
+ Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
+ Dim m As UserMedia = GetVideoData(New UserMedia(Data.URL, UTypes.VideoPre))
+ If Not m.URL.IsEmptyString Then _TempMediaList.Add(m)
+ End Sub
+ 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(Media.URL, Media.PictureOption, DestinationFile, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing))
End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
- Return 0
+ Dim isQuickies As Boolean = False
+ If Not IsNothing(EObj) AndAlso TypeOf EObj Is Boolean Then isQuickies = CBool(EObj)
+ If Responser.StatusCode = Net.HttpStatusCode.NotFound Then
+ UserExists = False
+ Return 1
+ ElseIf isQuickies And Responser.StatusCode = Net.HttpStatusCode.InternalServerError Then
+ Return 1
+ Else
+ Return 0
+ End If
End Function
End Class
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Xhamster/Declarations.vb b/SCrawler/API/Xhamster/Declarations.vb
index 0d07a8c..22ae673 100644
--- a/SCrawler/API/Xhamster/Declarations.vb
+++ b/SCrawler/API/Xhamster/Declarations.vb
@@ -13,7 +13,6 @@ Namespace API.Xhamster
Friend Const XhamsterSiteKey As String = "AndyProgram_XHamster"
Friend ReadOnly HtmlScript As RParams = RParams.DMS("\