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

2023.10.9.0

Browse Source 
YT.VideoListForm: hide clear and delete buttons in menu; add 'BTT_CLEAR_SELECTED' button
API.Base.TokenBatch: add debug option
API.ALL: fix missing posts
API.JFF: rewrite m3u8 downloader; add ffmpeg requirement for the download; fixed missing posts; fixed download to the date; fixed corrupted files
DownloadableMediaHost: remove thumbnail when removed from list if thumbnail is stored in cache
This commit is contained in:
Andy
2023-10-09 18:52:37 +03:00
parent 61903afe3f
commit 326e61a968
15 changed files with 488 additions and 300 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
SCrawler/API/Base/TokenBatch.vb
View File

@@ -12,6 +12,7 @@ Namespace API.Base
Friend Class TokenBatch : Inherits BatchExecutor
Friend Property TempPostsList As List(Of String)
Protected ReadOnly Token As CancellationToken
Friend Property DebugMode As Boolean = False
Friend Sub New(ByVal _Token As CancellationToken)
MyBase.New(True)
Token = _Token
@@ -22,11 +23,21 @@ Namespace API.Base
End Sub
Protected Overrides Async Sub OutputDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.OutputDataReceiver(Sender, e)
Await Task.Run(Sub() If Token.IsCancellationRequested Then Kill())
Await Task.Run(Sub()
#If DEBUG Then
If DebugMode Then Debug.WriteLineIf(Not e.Data.IsEmptyString, $"Out: {e.Data}")
#End If
If Token.IsCancellationRequested Then Kill()
End Sub)
End Sub
Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.ErrorDataReceiver(Sender, e)
Await Task.Run(Sub() If Token.IsCancellationRequested Then Kill())
Await Task.Run(Sub()
#If DEBUG Then
If DebugMode Then Debug.WriteLineIf(Not e.Data.IsEmptyString, $"Err: {e.Data}")
#End If
If Token.IsCancellationRequested Then Kill()
End Sub)
End Sub
Protected Overridable Async Function Validate(ByVal Value As String) As Task
If Not ProcessKilled AndAlso Await Task.Run(Of Boolean)(Function() Token.IsCancellationRequested OrElse

17
SCrawler/API/Instagram/UserData.vb
View File

@@ -17,6 +17,7 @@ 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.Instagram
Friend Class UserData : Inherits UserDataBase
#Region "XML Names"
@@ -665,7 +666,8 @@ Namespace API.Instagram
Protected DefaultParser_IgnorePass As Boolean = False
Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing) As Boolean
Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) As Boolean
ThrowAny(Token)
If Items.Count > 0 Then
Dim PostIDKV As PostKV
@@ -699,7 +701,7 @@ Namespace API.Instagram
End Select
End If
before = _TempMediaList.Count
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl)
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl, State, Attempts)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False
End If
@@ -737,7 +739,8 @@ Namespace API.Instagram
Protected ObtainMedia_AllowAbstract As Boolean = False
Protected Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
Optional ByVal PostOriginUrl As String = Nothing)
Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Try
Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
@@ -798,7 +801,7 @@ Namespace API.Instagram
If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear()
End If
End If
@@ -815,7 +818,7 @@ Namespace API.Instagram
If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear()
End If
End If
@@ -1049,12 +1052,14 @@ Namespace API.Instagram
#End Region
#Region "Create media"
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing) As UserMedia
Optional ByVal SpecialFolder As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.URL_BASE = PostOriginUrl.IfNullOrEmpty(_URL), .Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, UnixDate32Provider, Nothing) Else m.Post.Date = Nothing
m.SpecialFolder = SpecialFolder
If State = UStates.Missing Then m.State = UStates.Missing : m.Attempts = Attempts
Return m
End Function
#End Region

132
SCrawler/API/JustForFans/M3U8.vb
View File

@@ -24,6 +24,7 @@ Namespace API.JustForFans
Private DestinationFile As SFile
Private ReadOnly Thrower As Plugin.IThrower
Private ReadOnly Responser As Responser
Private ReadOnly ResponserInternal As Boolean
Private Const R_VIDEO_REGEX_PATTERN As String = "(#EXT-X-STREAM-INF)(.+)(RESOLUTION=\d+x)(\d+)(.+""\s*)(\S+)(\s*)"
Private ReadOnly REGEX_AUDIO_URL As RParams = RParams.DMS("EXT-X-MEDIA.*?URI=.([^""]+)"".*?TYPE=""AUDIO""", 1, EDP.ReturnValue)
Private ReadOnly REGEX_PLS_FILES As RParams = RParams.DM("EXT-X-MAP:URI=""([^""]+)""|EXTINF.+?[\r\n]{1,2}(.+)", 0, RegexReturn.List, EDP.ReturnValue)
@@ -37,20 +38,24 @@ Namespace API.JustForFans
Private ReadOnly ProgressPre As PreProgress
Private ReadOnly ProgressExists As Boolean
Private ReadOnly UsePreProgress As Boolean
Private Property Token As CancellationToken
#End Region
#Region "Initializer"
Private Sub New(ByVal m As UserMedia, ByVal Destination As SFile, ByVal Resp As Responser, ByVal _Thrower As Plugin.IThrower,
ByVal _Progress As MyProgress, ByVal _UsePreProgress As Boolean)
ByVal _Progress As MyProgress, ByVal _UsePreProgress As Boolean, ByVal _Token As CancellationToken)
Media = m
DataVideo = New List(Of String)
DataAudio = New List(Of String)
DestinationFile = Destination
Thrower = _Thrower
Responser = Resp
'Responser = Resp
Responser = New Responser
ResponserInternal = True
Progress = _Progress
ProgressExists = Not Progress Is Nothing
If ProgressExists Then ProgressPre = New PreProgress(Progress)
UsePreProgress = _UsePreProgress
Token = _Token
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{M3U8Base.TempCacheFolderName}\")
With Cache
.CacheDeleteError = CacheDeletionError(Cache)
@@ -101,49 +106,15 @@ Namespace API.JustForFans
If Not r.IsEmptyString Then
Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
If data.ListExists Then
Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
With (From d As RegexMatchStruct In data
Where Not d.Arr(0).IfNullOrEmpty(d.Arr(1)).IsEmptyString
Select M3U8Base.CreateUrl(appender, d.Arr(0).IfNullOrEmpty(d.Arr(1)))).ToList
If .ListExists Then
File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
Dim tmpCache As CacheKeeper = Cache.NewInstance
Dim tmpFile As SFile = .Item(0)
If tmpFile.Extension.IsEmptyString Then tmpFile.Extension = "ts"
tmpFile.Path = tmpCache.RootDirectory.Path
tmpFile.Separator = "\"
Dim cFile As SFile = tmpFile
cFile.Name = "all"
tmpCache.Validate()
Using bat As New TextSaver
Using b As New BatchExecutor(True) With {.Encoding = Settings.CMDEncoding}
AddHandler b.OutputDataReceived, AddressOf Batch_OutputDataReceived
bat.AppendLine($"chcp {BatchExecutor.UnicodeEncoding}")
bat.AppendLine(BatchExecutor.GetDirectoryCommand(tmpCache))
ProgressChangeMax(.Count * 2 + 1)
For i = 0 To .Count - 1
tmpFile.Name = $"ConPart_{i}"
Thrower.ThrowAny()
Responser.DownloadFile(.Item(i), tmpFile)
ProgressPerform()
tmpCache.AddFile(tmpFile, True)
bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
Next
bat.AppendLine($"""{Settings.FfmpegFile}"" -i {cFile.File} -c copy ""{File}""")
Dim batFile As SFile = bat.SaveAs($"{tmpCache.RootDirectory.PathWithSeparator}command.bat")
b.Execute($"""{batFile}""")
If Not File.Exists Then File = Nothing
End Using
End Using
End If
End With
File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
Using b As New TokenBatch(Token) With {.Encoding = Settings.CMDEncoding, .MainProcessName = "ffmpeg"}
AddHandler b.ErrorDataReceived, AddressOf Batch_OutputDataReceived
ProgressChangeMax(data.Count)
b.ChangeDirectory(Cache.RootDirectory)
b.Execute($"""{Settings.FfmpegFile}"" -i {URL} -vcodec copy -strict -2 ""{File}""")
Token.ThrowIfCancellationRequested()
If Not File.Exists Then File = Nothing
End Using
End If
End If
Catch oex As OperationCanceledException
@@ -155,8 +126,72 @@ Namespace API.JustForFans
$"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
End Try
End Sub
'TODELETE: JFF.M3U8.GetFiles_OLD 20231008
'Private Sub GetFiles_OLD(ByVal URL As String, ByRef File As SFile, ByVal IsAudio As Boolean)
' Try
' Dim r$ = Responser.GetResponse(URL)
' If Not r.IsEmptyString Then
' Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
' If data.ListExists Then
' Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
' With (From d As RegexMatchStruct In data
' Where Not d.Arr(0).IfNullOrEmpty(d.Arr(1)).IsEmptyString
' Select M3U8Base.CreateUrl(appender, d.Arr(0).IfNullOrEmpty(d.Arr(1)).Trim)).ToList
' If .ListExists Then
' File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
' Dim tmpCache As CacheKeeper = Cache.NewInstance
' Dim tmpFile As SFile = .Item(0)
' If tmpFile.Extension.IsEmptyString Then tmpFile.Extension = "ts"
' tmpFile.Path = tmpCache.RootDirectory.Path
' tmpFile.Separator = "\"
' Dim cFile As SFile = tmpFile
' cFile.Name = "all"
' tmpCache.Validate()
' Using bat As New TextSaver
' Using b As New BatchExecutor(True) With {.Encoding = Settings.CMDEncoding}
' AddHandler b.OutputDataReceived, AddressOf Batch_OutputDataReceived
' bat.AppendLine($"chcp {BatchExecutor.UnicodeEncoding}")
' bat.AppendLine(BatchExecutor.GetDirectoryCommand(tmpCache))
' ProgressChangeMax(.Count * 2 + 1)
' Using w As New WebClient
' For i = 0 To .Count - 1
' tmpFile.Name = $"ConPart_{i}"
' Thrower.ThrowAny()
' 'Responser.DownloadFile(.Item(i), tmpFile)
' w.DownloadFile(.Item(i), tmpFile)
' ProgressPerform()
' tmpCache.AddFile(tmpFile, True)
' bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
' Next
' End Using
' bat.AppendLine($"""{Settings.FfmpegFile}"" -i {cFile.File} -c copy ""{File}""")
' Dim batFile As SFile = bat.SaveAs($"{tmpCache.RootDirectory.PathWithSeparator}command.bat")
' b.Execute($"""{batFile}""")
' If Not File.Exists Then File = Nothing
' End Using
' End Using
' End If
' End With
' End If
' End If
' Catch oex As OperationCanceledException
' Throw oex
' Catch dex As ObjectDisposedException
' Throw dex
' Catch ex As Exception
' ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex,
' $"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
' End Try
'End Sub
Private Async Sub Batch_OutputDataReceived(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() ProgressPerform())
Await Task.Run(Sub() If Not e.Data.IsEmptyString AndAlso e.Data.Contains("] Opening") Then ProgressPerform())
End Sub
Private Sub MergeFiles()
Try
@@ -194,8 +229,8 @@ Namespace API.JustForFans
#End Region
#Region "Static Download"
Friend Shared Function Download(ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Resp As Responser, ByVal Thrower As Plugin.IThrower,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Using m As New M3U8(Media, DestinationFile, Resp, Thrower, Progress, UsePreProgress)
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean, ByVal _Token As CancellationToken) As SFile
Using m As New M3U8(Media, DestinationFile, Resp, Thrower, Progress, UsePreProgress, _Token)
m.Download()
If m.DestinationFile.Exists Then Return m.DestinationFile Else Return Nothing
End Using
@@ -210,6 +245,7 @@ Namespace API.JustForFans
DataAudio.Clear()
ProgressPre.DisposeIfReady
Cache.Dispose()
If ResponserInternal Then Responser.DisposeIfReady
End If
disposedValue = True
End If

2
SCrawler/API/JustForFans/SiteSettings.vb
View File

@@ -82,7 +82,7 @@ Namespace API.JustForFans
End If
End Sub
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value)
Return Settings.FfmpegFile.Exists And Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value)
End Function
End Class
End Namespace

20
SCrawler/API/JustForFans/UserData.vb
View File

@@ -168,7 +168,8 @@ Namespace API.JustForFans
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
UseResponserClient = True
'TODELETE: UseResponserClient 20231008
'UseResponserClient = True
End Sub
#End Region
#Region "Download functions"
@@ -176,10 +177,13 @@ Namespace API.JustForFans
Private _Limit As Integer = -1
Private FileSerialInstance As FileSerial
Private _UserHash4 As String = String.Empty
Private Sub InitializeFileSerial()
If FileSerialInstance Is Nothing Then FileSerialInstance = New FileSerial(DownloadContentDefault_GetRootDir())
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
_UserHash4 = MySettings.UserHash4.Value
FileSerialInstance = New FileSerial(DownloadContentDefault_GetRootDir())
InitializeFileSerial()
Responser.Cookies.Changed = False
If Not ResponserNoHandlers Is Nothing Then ResponserNoHandlers.Dispose() : ResponserNoHandlers = Nothing
ResponserNoHandlers = Responser.Copy
@@ -233,7 +237,7 @@ Namespace API.JustForFans
Select Case CheckDatesLimit(post.PostDate, Nothing)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
Case DateResult.Exit : If post.Pinned Then Continue For Else Exit Sub
End Select
_DownloadedPostsCount += 1
@@ -290,8 +294,14 @@ Namespace API.JustForFans
Dim rList As New List(Of Integer)
Try
If ContentMissingExists Then
InitializeFileSerial()
Dim r$
Dim m As UserMedia
Dim stateRefill As Func(Of UserMedia, Integer, UserMedia) = Function(ByVal input As UserMedia, ii As Integer) As UserMedia
input.State = UserMedia.States.Missing
input.Attempts = m.Attempts
Return input
End Function
Dim p As PostBlock
Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To _ContentList.Count - 1
@@ -304,7 +314,7 @@ Namespace API.JustForFans
If .ListExists Then
rList.Add(i)
For Each p In .Self
If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance), LNC)
If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance).ListForEachCopy(stateRefill, True), LNC)
Next
End If
End With
@@ -327,7 +337,7 @@ Namespace API.JustForFans
DownloadContentDefault(Token)
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, DestinationFile, ResponserNoHandlers, Me, Progress, Not IsSingleObjectDownload)
Return M3U8.Download(Media, DestinationFile, ResponserNoHandlers, Me, Progress, Not IsSingleObjectDownload, Token)
End Function
#End Region
#Region "DownloadSingleObject"

13
SCrawler/API/Mastodon/UserData.vb
View File

@@ -190,7 +190,8 @@ Namespace API.Mastodon
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try
End Sub
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal BaseUrl As String = Nothing)
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal BaseUrl As String = Nothing,
Optional ByVal SourceMedia As UserMedia = Nothing)
Dim t As UTypes = UTypes.Undefined
Select Case e.Value("type")
Case "video" : t = UTypes.Video
@@ -207,7 +208,13 @@ Namespace API.Mastodon
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = GifsSpecialFolder
If Not GifsPrefix.IsEmptyString Then m.File.Name = $"{GifsPrefix}{m.File.Name}"
End If
If Not m.URL.IsEmptyString Then _TempMediaList.ListAddValue(m, LNC)
If Not m.URL.IsEmptyString Then
If SourceMedia.State = UStates.Missing Then
m.State = UStates.Missing
m.Attempts = SourceMedia.Attempts
End If
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End If
End Sub
@@ -261,7 +268,7 @@ Namespace API.Mastodon
If Not j Is Nothing Then
PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE)
ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE, m)
rList.Add(i)
j.Dispose()
End If

7
SCrawler/API/OnlyFans/UserData.vb
View File

@@ -380,6 +380,11 @@ Namespace API.OnlyFans
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim stateRefill As Func(Of UserMedia, Integer, UserMedia) = Function(ByVal input As UserMedia, ii As Integer) As UserMedia
input.State = UStates.Missing
input.Attempts = m.Attempts
Return input
End Function
Dim mList As List(Of UserMedia)
Dim mediaResult As Boolean
Dim r$, path$, postDate$
@@ -402,7 +407,7 @@ Namespace API.OnlyFans
mediaResult = False
mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult)
If mediaResult Then
_TempMediaList.ListAddList(mList, LNC)
_TempMediaList.ListAddList(mList.ListForEachCopy(stateRefill, True), LNC)
rList.Add(i)
mList.Clear()
End If

2
SCrawler/API/Reddit/UserData.vb
View File

@@ -877,6 +877,8 @@ Namespace API.Reddit
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
m2 = _TempMediaList(i)
m2.Post.Date = m.Post.Date
m2.State = UStates.Missing
m2.Attempts = m.Attempts
_TempMediaList(i) = m2
Next
End If

9
SCrawler/API/Redgifs/UserData.vb
View File

@@ -74,10 +74,10 @@ Namespace API.RedGifs
#Region "Media obtain, extract"
Private Sub ObtainMedia(ByVal j As EContainer, ByVal PostID As String,
Optional ByVal PostDateStr As String = Nothing, Optional ByVal PostDateDate As Date? = Nothing,
Optional ByVal State As UStates = UStates.Unknown)
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Dim tMedia As UserMedia = ExtractMedia(j)
If Not tMedia.Type = UTypes.Undefined Then _
_TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State))
_TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State, Attempts))
End Sub
Private Shared Function ExtractMedia(ByVal j As EContainer) As UserMedia
If Not j Is Nothing Then
@@ -122,7 +122,7 @@ Namespace API.RedGifs
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
If If(j("gif")?.Count, 0) > 0 Then
ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing)
ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing, u.Attempts)
rList.Add(i)
End If
End If
@@ -229,7 +229,7 @@ Namespace API.RedGifs
#End Region
#Region "Create media"
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
ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates, Optional ByVal Attempts As Integer = 0) 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))
@@ -241,6 +241,7 @@ Namespace API.RedGifs
m.Post.Date = Nothing
End If
m.State = State
m.Attempts = Attempts
Return m
End Function
#End Region

11
SCrawler/API/Twitter/UserData.vb
View File

@@ -392,7 +392,8 @@ Namespace API.Twitter
End Sub
#End Region
#Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown)
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0)
Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
@@ -406,7 +407,7 @@ Namespace API.Twitter
Dim dName$ = UrlFile(mUrl)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture), LNC)
_TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture, Attempts), LNC)
End If
End If
End If
@@ -712,7 +713,7 @@ Namespace API.Twitter
If .ListExists Then
PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing)
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts)
rList.ListAddValue(i, LNC)
End If
End With
@@ -804,7 +805,8 @@ Namespace API.Twitter
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
Optional ByVal Type As UTypes = UTypes.Undefined,
Optional ByVal Attempts As Integer = 0) 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))
@@ -813,6 +815,7 @@ Namespace API.Twitter
End If
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing
m.State = State
m.Attempts = Attempts
Return m
End Function
#End Region

2
SCrawler/API/Xhamster/UserData.vb
View File

@@ -456,6 +456,8 @@ Namespace API.Xhamster
m2 = Nothing
If GetM3U8(m2, m.URL_BASE) Then
m2.URL_BASE = m.URL_BASE
m2.State = UserMedia.States.Missing
m2.Attempts = m.Attempts
_TempMediaList.ListAddValue(m2, LNC)
rList.Add(i)
End If

5
SCrawler/PluginsEnvironment/Hosts/DownloadableMediaHost.vb
View File

@@ -41,6 +41,11 @@ Namespace Plugin.Hosts
FileSetManually = True
End Set
End Property
Public Overrides Sub Delete(ByVal RemoveFiles As Boolean)
MyBase.Delete(RemoveFiles)
If Not RemoveFiles And Not Settings.STDownloader_SnapshotsKeepWithFiles And Settings.STDownloader_SnapShotsCachePermamnent Then _
ThumbnailFile.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None)
End Sub
Friend Sub New(ByVal URL As String, ByVal OutputFile As SFile)
Me.URL = URL
Me.File = OutputFile