[\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
+ End If
+ End Using
+ Next
+ l.Clear()
+ End If
+ End If
+ End If
+ Return True
+ Catch ex As Exception
+ ThrowAny(Token)
+ Return False
+ End Try
+ End Function
+ Private Overloads Function DownloadUserPhotos_PornHub(ByVal Token As CancellationToken) As Boolean
+ Try
+ Dim albumName$
+ Dim page%
+ Dim r$ = Responser.GetResponse(String.Format(PhotoUrlPattern_PornHub, PersonType, NameTrue))
+ If Not r.IsEmptyString Then
+ Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1})
+ If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString)
+ If l.ListExists Then
+ For Each block As PhotoBlock In l
+ If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
+ albumName = block.Data
+ If albumName.IsEmptyString Then
+ albumName = block.AlbumID.Split("/").LastOrDefault.StringTrim
+ Else
+ albumName = HtmlConverter(albumName).StringRemoveWinForbiddenSymbols.StringTrim
+ End If
+ page = 1
+ Do While DownloadUserPhotos_PornHub(page, block.AlbumID, albumName, Token) : page += 1 : Loop
+ Next
+ l.Clear()
+ End If
+ End If
+ Return True
+ Catch ex As Exception
+ ThrowAny(Token)
+ Return False
+ End Try
+ End Function
+ Private Overloads Function DownloadUserPhotos_PornHub(ByVal Page As Integer, ByVal AlbumID As String, ByVal AlbumName As String,
+ ByVal Token As CancellationToken) As Boolean
+ Try
+ Dim r$ = Responser.GetResponse($"https://www.pornhub.com{AlbumID}{IIf(Page = 1, String.Empty, $"?page={Page}")}")
+ If Not r.IsEmptyString Then
+ Dim l As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
+ If l.ListExists Then l.RemoveAll(Function(_url) _url.IsEmptyString)
+ If l.ListExists Then
+ For Each url$ In l
+ ThrowAny(Token)
+ Try
+ r = Responser.GetResponse(url)
+ 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)
+ End If
+ Catch
+ End Try
+ Next
+ l.Clear()
+ Return True
+ End If
+ End If
+ Return False
+ Catch ex As Exception
+ ThrowAny(Token)
+ Return False
+ End Try
+ End Function
+ Private Function DownloadUserPhotos_SavedPosts(ByVal Token As CancellationToken) As Boolean
+ Const HtmlPageNotFoundPhoto$ = "Page Not Found"
+ Dim URL$ = $"https://www.pornhub.com/{PersonType}/{NameTrue}/photos/favorites"
+ Try
+ Dim r$ = Responser.GetResponse(URL)
+ If Not r.IsEmptyString Then
+ 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 m As UserMedia
+ Dim l2 As List(Of UserMedia) = urls.Select(Function(__url) New UserMedia(__url, UTypes.Picture) With {
+ .Post = __url.Split("/").LastOrDefault}).ToList
+ urls.Clear()
+ If l2.ListExists Then l2.RemoveAll(Function(media) media.URL.IsEmptyString)
+ If l2.ListExists Then
+ Dim lBefore% = l2.Count
+ If _TempPostsList.Count > 0 Then l2.RemoveAll(Function(media) _TempPostsList.Contains(media.Post.ID))
+ If l2.Count > 0 Then
+ For i% = 0 To l2.Count - 1
+ m = l2(i)
+ ThrowAny(Token)
+ Try
+ r = Responser.GetResponse(m.URL)
+ If Not r.IsEmptyString Then
+ NewUrl = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto)
+ If Not NewUrl.IsEmptyString Then
+ m.URL = NewUrl
+ m.File = NewUrl
+ _TempPostsList.ListAddValue(m.Post.ID, LNC)
+ Else
+ Throw New Exception
+ End If
+ End If
+ Catch
+ m.State = UserMedia.States.Missing
+ End Try
+ _TempMediaList.ListAddValue(m, LNC)
+ Next
+ End If
+ Return l2.Count = lBefore
+ End If
+ End If
+ End If
+ Return False
+ Catch ex As Exception
+ Return ProcessException(ex, Token, $"photos downloading error [{URL}]")
+ End Try
+ End Function
+#End Region
+#End Region
+#Region "ReparseVideo"
+ Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
+ 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$
+ For i% = _TempMediaList.Count - 1 To 0 Step -1
+ If _TempMediaList(i).Type = UTypes.VideoPre Then
+ m = _TempMediaList(i)
+ ThrowAny(Token)
+ Try
+ URL = m.URL
+ r = Responser.Curl(URL)
+ If Not r.IsEmptyString Then
+ NewUrl = CreateVideoURL(r)
+ If NewUrl.IsEmptyString Then
+ Throw New Exception With {.HelpLink = ERR_NEW_URL}
+ Else
+ m.URL = NewUrl
+ m.Type = UTypes.m3u8
+ _TempMediaList(i) = m
+ End If
+ Else
+ _TempMediaList.RemoveAt(i)
+ End If
+ Catch mid_ex As Exception
+ If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then
+ m.State = UserMedia.States.Missing
+ _TempMediaList(i) = m
+ Else
+ _TempMediaList.RemoveAt(i)
+ End If
+ End Try
+ End If
+ Next
+ End If
+ Catch ex As Exception
+ ProcessException(ex, Token, "video reparsing error", False)
+ End Try
+ End Sub
+#End Region
+#Region "ReparseMissing"
+ Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
+ Dim rList As New List(Of Integer)
+ Try
+ If ContentMissingExists Then
+ Dim m As UserMedia
+ Dim r$
+ Dim eCurl As New ErrorsDescriber(EDP.ReturnValue)
+ For i% = 0 To _ContentList.Count - 1
+ 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)
+ If Not r.IsEmptyString Then
+ Dim NewUrl$ = CreateVideoURL(r)
+ If Not NewUrl.IsEmptyString Then
+ m.URL = NewUrl
+ _TempMediaList.ListAddValue(m, LNC)
+ rList.Add(i)
+ End If
+ End If
+ End If
+ Next
+ End If
+ Catch ex As Exception
+ ProcessException(ex, Token, "missing data downloading error")
+ Finally
+ If rList.Count > 0 Then
+ For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
+ rList.Clear()
+ End If
+ End Try
+ End Sub
+#End Region
+#Region "Download content"
+ 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)
+ End Function
+#End Region
+#Region "CreateVideoURL"
+ Private Shared Function CreateVideoURL(ByVal r As String) As String
+ Try
+ Dim OutStr$ = String.Empty
+ If Not r.IsEmptyString Then
+ Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock)
+ If Not _VarBlock.IsEmptyString Then
+ Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
+ Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
+ If vars.ListExists And compiler.ListExists Then
+ Dim v$
+ Dim i%
+ For Each var$ In compiler
+ i = vars.IndexOf(var)
+ If i >= 0 Then
+ v = vars(i).Value
+ If Not v.IsEmptyString Then OutStr &= v
+ End If
+ Next
+ End If
+ End If
+ End If
+ Return OutStr
+ Catch ex As Exception
+ Return ErrorsDescriber.Execute(EDP.SendInLog, 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 Response, 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
+#End Region
+#Region "Exceptions"
+ 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.Status = Net.WebExceptionStatus.ConnectionClosed Then
+ Return 1
+ ElseIf Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
+ Return 2
+ Else
+ Return 0
+ End If
+ End Function
+#End Region
+ End Class
+End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/PornHub/UserExchangeOptions.vb b/SCrawler/API/PornHub/UserExchangeOptions.vb
new file mode 100644
index 0000000..9ccc4b4
--- /dev/null
+++ b/SCrawler/API/PornHub/UserExchangeOptions.vb
@@ -0,0 +1,23 @@
+' 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.PornHub
+ Friend Class UserExchangeOptions
+ Friend Property DownloadGifs As Boolean
+ Friend Property DownloadPhotoOnlyFromModelHub As Boolean
+ Friend Sub New(ByVal u As UserData)
+ DownloadGifs = u.DownloadGifs
+ DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
+ 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
+ End Sub
+ End Class
+End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Reddit/M3U8.vb b/SCrawler/API/Reddit/M3U8.vb
index 4307d1a..7578d65 100644
--- a/SCrawler/API/Reddit/M3U8.vb
+++ b/SCrawler/API/Reddit/M3U8.vb
@@ -8,7 +8,7 @@
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports SCrawler.API.Reddit.M3U8_Declarations
-Imports PersonalUtilities.Tools.WEB
+Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Reddit
Namespace M3U8_Declarations
diff --git a/SCrawler/API/Reddit/SiteSettings.vb b/SCrawler/API/Reddit/SiteSettings.vb
index a2bea8c..e16387c 100644
--- a/SCrawler/API/Reddit/SiteSettings.vb
+++ b/SCrawler/API/Reddit/SiteSettings.vb
@@ -25,7 +25,7 @@ Namespace API.Reddit
Return My.Resources.SiteResources.RedditPic_512
End Get
End Property
-
+
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend ReadOnly Property UseM3U8 As PropertyValue
@@ -40,6 +40,7 @@ Namespace API.Reddit
UrlPatternUser = "https://www.reddit.com/user/{0}/"
UrlPatternChannel = "https://www.reddit.com/r/{0}/"
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
@@ -55,19 +56,9 @@ Namespace API.Reddit
End Select
Return Nothing
End Function
- Private ReadOnly RedditRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/user/([^/]+)", 1)
- Private ReadOnly RedditRegEx2 As RParams = RParams.DMS(".?u/([^/]+)", 1)
- Private ReadOnly RedditChannelRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/r/([^/]+)", 1)
- Private ReadOnly RedditChannelRegEx2 As RParams = RParams.DMS(".?r/([^/]+)", 1)
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
- Dim s$
- Dim c% = 0
- For Each r As RParams In {RedditRegEx1, RedditRegEx2, RedditChannelRegEx1, RedditChannelRegEx2}
- s = RegexReplace(UserURL, r)
- If Not s.IsEmptyString Then Return New ExchangeOptions(Site, s, c > 1)
- c += 1
- Next
- Return Nothing
+ 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
End Function
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try
@@ -83,7 +74,7 @@ Namespace API.Reddit
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr) & vbCr & vbCr &
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
- DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
+ UpdateRedGifsToken()
Return True
Else
Return False
@@ -91,11 +82,15 @@ Namespace API.Reddit
End If
End If
End If
+ UpdateRedGifsToken()
Return True
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + 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)
@@ -108,8 +103,8 @@ Namespace API.Reddit
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
- Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
- Return $"https://www.reddit.com/comments/{PostID.Split("_").LastOrDefault}/"
+ 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}/"
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 dc1284e..cb84692 100644
--- a/SCrawler/API/Reddit/UserData.vb
+++ b/SCrawler/API/Reddit/UserData.vb
@@ -14,8 +14,8 @@ Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer
-Imports PersonalUtilities.Tools.WEB
-Imports PersonalUtilities.Tools.WebDocuments.JSON
+Imports PersonalUtilities.Tools.Web.Clients
+Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CView = SCrawler.API.Reddit.IRedditView.View
@@ -152,6 +152,8 @@ 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
If ChannelInfo Is Nothing Then
diff --git a/SCrawler/API/Redgifs/Declarations.vb b/SCrawler/API/Redgifs/Declarations.vb
index 1deff2c..3fd01e6 100644
--- a/SCrawler/API/Redgifs/Declarations.vb
+++ b/SCrawler/API/Redgifs/Declarations.vb
@@ -14,6 +14,6 @@ Namespace API.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,
- Function(v) If(CStr(v).IsEmptyString, String.Empty, CStr(v).ToLower.Trim))
+ CType(Function(Input$) Input.StringToLower.StringTrim, Func(Of String, String)))
End Module
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Redgifs/SiteSettings.vb b/SCrawler/API/Redgifs/SiteSettings.vb
index a963252..fc71a92 100644
--- a/SCrawler/API/Redgifs/SiteSettings.vb
+++ b/SCrawler/API/Redgifs/SiteSettings.vb
@@ -11,8 +11,9 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
-Imports PersonalUtilities.Tools.WEB
-Imports PersonalUtilities.Tools.WebDocuments.JSON
+Imports PersonalUtilities.Tools.Web.Clients
+Imports PersonalUtilities.Tools.Web.Cookies
+Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs
@@ -40,11 +41,9 @@ Namespace API.RedGifs
MyBase.New(RedGifsSite, "redgifs.com")
Dim t$ = String.Empty
With Responser
- Dim b As Boolean = Not .UseWebClient Or Not .UseWebClientCookies Or Not .UseWebClientAdditionalHeaders
- .UseWebClient = True
- .UseWebClientCookies = True
- .UseWebClientAdditionalHeaders = True
- If .Headers.Count > 0 AndAlso .Headers.ContainsKey(TokenName) Then t = .Headers(TokenName)
+ Dim b As Boolean = Not .Mode = Response.Modes.WebClient
+ .Mode = Response.Modes.WebClient
+ t = .HeadersValue(TokenName)
If b Then .SaveSettings()
End With
NoCredentialsResponser = New Response($"{SettingsFolderName}\Responser_{RedGifsSite}_NC.xml") With {
@@ -68,10 +67,8 @@ Namespace API.RedGifs
#End Region
#Region "Response updater"
Private Sub UpdateResponse(ByVal Value As String)
- With Responser.Headers
- If .Count = 0 OrElse Not .ContainsKey(TokenName) Then .Add(TokenName, Value) Else .Item(TokenName) = Value
- Responser.SaveSettings()
- End With
+ Responser.HeadersAdd(TokenName, Value)
+ Responser.SaveSettings()
End Sub
#End Region
#Region "Token updaters"
@@ -153,8 +150,8 @@ Namespace API.RedGifs
End If
Return Nothing
End Function
- Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
- Return $"https://www.redgifs.com/watch/{PostID}"
+ 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
Friend Overrides Function BaseAuthExists() As Boolean
Return UpdateTokenIfRequired() AndAlso ACheck(Token.Value)
diff --git a/SCrawler/API/Redgifs/UserData.vb b/SCrawler/API/Redgifs/UserData.vb
index 1042d77..02a2f61 100644
--- a/SCrawler/API/Redgifs/UserData.vb
+++ b/SCrawler/API/Redgifs/UserData.vb
@@ -11,8 +11,8 @@ Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
-Imports PersonalUtilities.Tools.WEB
-Imports PersonalUtilities.Tools.WebDocuments.JSON
+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
@@ -62,7 +62,7 @@ Namespace API.RedGifs
Case DateResult.Exit : Exit Sub
End Select
postID = g.Value("id")
- If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit For
+ If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit Sub
ObtainMedia(g, postID, postDate)
Next
End If
@@ -179,7 +179,7 @@ Namespace API.RedGifs
If Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then
If Responser Is Nothing Then Responser = Host.Responser.Copy
URL = String.Format(PostDataUrl, Obj.ToLower)
- Dim r$ = Responser.DownloadString(URL, EDP.ThrowException)
+ Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then
@@ -206,8 +206,15 @@ Namespace API.RedGifs
If Not Responser Is Nothing AndAlso (Responser.Client.StatusCode = DataGone Or Responser.Client.StatusCode = HttpStatusCode.NotFound) Then
Return New UserMedia With {.State = DataGone}
Else
- Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.RedGifs.UserData.GetDataFromUrlId({URL})]",
- New UserMedia With {.State = UStates.Missing})
+ Dim m As New UserMedia With {.State = UStates.Missing}
+ Dim _errText$ = "API.RedGifs.UserData.GetDataFromUrlId({0})"
+ If Responser.Client.StatusCode = HttpStatusCode.Unauthorized Then
+ _errText = $"RedGifs credentials have expired [{CInt(Responser.Client.StatusCode)}]: {_errText}"
+ MyMainLOG = String.Format(_errText, URL)
+ Return m
+ Else
+ Return ErrorsDescriber.Execute(EDP.SendInLog, ex, String.Format(_errText, URL), m)
+ End If
End If
End Try
End Function
diff --git a/SCrawler/API/TikTok/UserData.vb b/SCrawler/API/TikTok/UserData.vb
index a75048b..6f858bf 100644
--- a/SCrawler/API/TikTok/UserData.vb
+++ b/SCrawler/API/TikTok/UserData.vb
@@ -10,7 +10,7 @@ Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
-Imports PersonalUtilities.Tools.WEB
+Imports PersonalUtilities.Tools.Web.Clients
Namespace API.TikTok
Friend Class UserData : Inherits UserDataBase
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
diff --git a/SCrawler/API/Twitter/Declarations.vb b/SCrawler/API/Twitter/Declarations.vb
index 5febb24..a1a055c 100644
--- a/SCrawler/API/Twitter/Declarations.vb
+++ b/SCrawler/API/Twitter/Declarations.vb
@@ -6,14 +6,21 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
+Imports System.Globalization
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Twitter
Friend Module Declarations
Friend Const TwitterSite As String = "Twitter"
- Friend DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
+ 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"
+ n.TimeSeparator = String.Empty
+ Return New ADateTime(DirectCast(n.Clone, DateTimeFormatInfo)) With {.DateTimeStyle = DateTimeStyles.AssumeUniversal}
+ End Function
End Module
End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/Twitter/SiteSettings.vb b/SCrawler/API/Twitter/SiteSettings.vb
index cf2899d..6040603 100644
--- a/SCrawler/API/Twitter/SiteSettings.vb
+++ b/SCrawler/API/Twitter/SiteSettings.vb
@@ -9,8 +9,9 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
-Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.RegularExpressions
+Imports PersonalUtilities.Tools.Web.Clients
+Imports PersonalUtilities.Tools.Web.Cookies
Namespace API.Twitter
Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -31,7 +32,7 @@ Namespace API.Twitter
Private ReadOnly Property Auth As PropertyValue
Private ReadOnly Property Token As PropertyValue
-
+
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend Overrides ReadOnly Property Responser As Response
Friend Sub New()
@@ -45,10 +46,8 @@ Namespace API.Twitter
If .File.Exists Then
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.LoadSettings()
- With .Headers
- If .ContainsKey(Header_Authorization) Then a = .Item(Header_Authorization)
- If .ContainsKey(Header_Token) Then t = .Item(Header_Token)
- End With
+ a = .HeadersValue(Header_Authorization)
+ t = .HeadersValue(Header_Token)
Else
.ContentType = "application/json"
.Accept = "*/*"
@@ -56,17 +55,15 @@ Namespace API.Twitter
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.Decoders.Add(SymbolsConverter.Converters.Unicode)
- With .Headers
- .Add("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
- .Add("sec-ch-ua-mobile", "?0")
- .Add("sec-fetch-dest", "empty")
- .Add("sec-fetch-mode", "cors")
- .Add("sec-fetch-site", "same-origin")
- .Add(Header_Token, String.Empty)
- .Add("x-twitter-active-user", "yes")
- .Add("x-twitter-auth-type", "OAuth2Session")
- .Add(Header_Authorization, String.Empty)
- End With
+ .HeadersAdd("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
+ .HeadersAdd("sec-ch-ua-mobile", "?0")
+ .HeadersAdd("sec-fetch-dest", "empty")
+ .HeadersAdd("sec-fetch-mode", "cors")
+ .HeadersAdd("sec-fetch-site", "same-origin")
+ .HeadersAdd(Header_Token, String.Empty)
+ .HeadersAdd("x-twitter-active-user", "yes")
+ .HeadersAdd("x-twitter-auth-type", "OAuth2Session")
+ .HeadersAdd(Header_Authorization, String.Empty)
.SaveSettings()
End If
End With
@@ -87,8 +84,8 @@ Namespace API.Twitter
Case NameOf(Token) : f = Header_Token
End Select
If Not f.IsEmptyString Then
- If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
- If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
+ Responser.HeadersRemove(f)
+ If Not CStr(Value).IsEmptyString Then Responser.HeadersAdd(f, CStr(Value))
Responser.SaveSettings()
End If
End If
@@ -103,8 +100,8 @@ Namespace API.Twitter
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 GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
- Return $"https://twitter.com/{UserID}/status/{PostID}"
+ Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
+ Return $"https://twitter.com/{User.Name}/status/{Media.Post.ID}"
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(Token.Value) And ACheck(Auth.Value)
diff --git a/SCrawler/API/Twitter/UserData.vb b/SCrawler/API/Twitter/UserData.vb
index 605de2e..3da25eb 100644
--- a/SCrawler/API/Twitter/UserData.vb
+++ b/SCrawler/API/Twitter/UserData.vb
@@ -11,8 +11,8 @@ Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
-Imports PersonalUtilities.Tools.WEB
-Imports PersonalUtilities.Tools.WebDocuments.JSON
+Imports PersonalUtilities.Tools.Web.Clients
+Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase
diff --git a/SCrawler/API/UserDataBind.vb b/SCrawler/API/UserDataBind.vb
index 8c4058a..4541b06 100644
--- a/SCrawler/API/UserDataBind.vb
+++ b/SCrawler/API/UserDataBind.vb
@@ -8,9 +8,10 @@
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
-Imports PersonalUtilities.Tools
+Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.Messaging
+Imports PersonalUtilities.Tools
Namespace API
Friend Class UserDataBind : Inherits UserDataBase : Implements ICollection(Of IUserData), IMyEnumerator(Of IUserData)
#Region "Events"
@@ -20,6 +21,17 @@ Namespace API
#Region "Declarations"
Friend ReadOnly Property Collections As List(Of IUserData)
#Region "Base class overrides"
+ Friend Overrides ReadOnly Property IsVirtual As Boolean
+ Get
+ Return CollectionModel = UsageModel.Virtual
+ End Get
+ End Property
+ Friend Overrides ReadOnly Property CollectionModel As UsageModel
+ Get
+ If Count > 0 Then Return Item(0).CollectionModel Else Return UsageModel.Default
+ End Get
+ End Property
+ Friend Property CurrentlyEdited As Boolean = False
Private _CollectionName As String = String.Empty
Friend Overrides Property CollectionName As String
Get
@@ -80,10 +92,13 @@ Namespace API
End Sub
Friend Overrides Function GetUserPicture() As Image
If Count > 0 Then
- Return Collections(0).GetPicture
- Else
- Return GetNullPicture(Settings.MaxLargeImageHeight)
+ Dim img As Image
+ For Each u As UserDataBase In Collections
+ img = u.GetPicture(Of Image)(False)
+ If Not img Is Nothing Then Return img
+ Next
End If
+ Return GetNullPicture(Settings.MaxLargeImageHeight)
End Function
#End Region
Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
@@ -102,7 +117,15 @@ Namespace API
End Property
Friend Overrides Property MyFile As SFile
Get
- If Count > 0 Then Return Collections(0).File Else Return Nothing
+ If Count > 0 Then
+ If IsVirtual Then
+ Return GetRealUserFile.IfNullOrEmpty(Collections(0).File)
+ Else
+ Return Collections(0).File
+ End If
+ Else
+ Return Nothing
+ End If
End Get
Set(ByVal NewFile As SFile)
End Set
@@ -120,8 +143,8 @@ Namespace API
End Property
Friend Overrides Property DataMerging As Boolean
Get
- If Count > 0 Then
- Return DirectCast(Collections(0), UserDataBase).DataMerging
+ If Count > 0 AndAlso Collections.Exists(RealUser) Then
+ Return DirectCast(Collections.Find(RealUser), UserDataBase).DataMerging
Else
Return False
End If
@@ -184,6 +207,7 @@ Namespace API
End Property
Friend Overrides Function GetUserInformation() As String
Dim OutStr$ = String.Empty
+ If IsVirtual Then OutStr = "This is a virtual collection."
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), vbNewLine.StringDup(2)))
Return OutStr
End Function
@@ -346,12 +370,36 @@ Namespace API
If Not e.Exists Then e = New ErrorsDescriber(EDP.SendInLog)
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
Friend Overrides Sub OpenFolder()
Try
- If Count > 0 Then GlobalOpenPath(Collections(0).File.CutPath(2))
+ If Count > 0 Then
+ Dim i% = Collections.FindIndex(RealUser)
+ If i = -1 Then i = 0
+ If i >= 0 Then
+ If IsVirtual Or Collections(i).UserModel = UsageModel.Virtual Then
+ Collections(i).OpenFolder()
+ Else
+ GlobalOpenPath(Collections(i).File.CutPath(2))
+ End If
+ End If
+ End If
Catch
End Try
End Sub
+ Friend Function GetRealUserFile() As SFile
+ Dim i% = -1
+ If Count > 0 Then i = Collections.FindIndex(RealUser)
+ If i >= 0 Then Return Collections(i).File Else Return Nothing
+ End Function
+ Friend Function GetRealUserSpecialCollectionPath()
+ Dim _SpecialCollectionPath As SFile = Nothing
+ If Count > 0 And Not IsVirtual Then
+ Dim _RealUser As UserDataBase = Collections.Find(RealUser)
+ If Not _RealUser Is Nothing Then _SpecialCollectionPath = _RealUser.User.SpecialCollectionPath
+ End If
+ Return _SpecialCollectionPath
+ End Function
#End Region
#Region "ICollection Support"
Private ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of IUserData).IsReadOnly
@@ -386,8 +434,8 @@ Namespace API
'''
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
With _Item
- If .MoveFiles(CollectionName) Then
- If DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
+ If .MoveFiles(CollectionName, GetRealUserSpecialCollectionPath()) Then
+ If Not _Item.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
Collections.Add(_Item)
With Collections.Last
If Count > 1 Then
@@ -445,14 +493,9 @@ Namespace API
Private Sub ConsolidateScripts()
If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True)
End Sub
- Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
- If _Items.ListExists Then
- For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
- End If
- End Sub
#End Region
#Region "Move, Merge"
- Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean
+ Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean
Throw New NotImplementedException("Move files is not available in the collection context")
End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
@@ -488,52 +531,69 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical)
Return False
Else
- DirectCast(_Item, UserDataBase).MoveFiles(String.Empty)
+ _Item.MoveFiles(String.Empty, Nothing)
MainFrameObj.ImageHandler(_Item)
AddRemoveBttDeleteHandler(_Item, False)
RaiseEvent OnUserRemoved(_Item)
Return Collections.Remove(_Item)
End If
End Function
- Friend Overrides Function Delete(Optional ByVal Multiple As Boolean = False) As Integer
+ Friend Overrides Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
If Count > 0 Then
Const MsgTitle$ = "Deleting a collection"
- Dim f As SFile
+ Dim f As SFile = Nothing
+ If Not IsVirtual Then
+ f = GetRealUserFile()
+ If Not f.IsEmptyString Then f = f.CutPath(IIf(DataMerging, 1, 2))
+ End If
Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr &
"Are you sure you want to delete the collection and all of its files?", MsgTitle,
- {New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files"},
+ {New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files", .KeyCode = Keys.Enter},
New MsgBoxButton("Split") With {
.ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr &
- "All user data will remain."},
+ "All user data will remain.",
+ .KeyCode = New ButtonKey(Keys.Enter, True)},
"Cancel"}, vbExclamation)
- Select Case If(Multiple, 0, MsgBoxE(m).Index)
+ Dim v%
+ If CollectionValue >= 0 Then
+ v = CollectionValue
+ ElseIf Multiple Then
+ v = 0
+ Else
+ v = MsgBoxE(m)
+ End If
+ Select Case v
Case 0
- f = Collections(0).File.CutPath(IIf(DataMerging, 1, 2)).PathWithSeparator
- Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) c.Delete())
- Downloader.UserRemove(Me)
- MainFrameObj.ImageHandler(Me, False)
- Collections.ListClearDispose
- Dispose(False)
- f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
- Return 2
+ If Collections.All(Function(c As UserDataBase) c.Disposed) Then
+ Settings.Users.Remove(Me)
+ Downloader.UserRemove(Me)
+ MainFrameObj.ImageHandler(Me, False)
+ Collections.ListClearDispose
+ Dispose(False)
+ If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
+ Return 2
+ End If
Case 1
If DataMerging Then
MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation)
Return 0
Else
- f = Collections(0).File.CutPath(2)
- Settings.Users.Remove(Me)
- Collections.ForEach(Sub(c)
- c.MoveFiles(String.Empty)
- MainFrameObj.ImageHandler(c)
+ Collections.ForEach(Sub(ByVal c As IUserData)
+ If c.MoveFiles(String.Empty, Nothing) Then
+ UserListLoader.UpdateUser(Settings.GetUser(c), True)
+ MainFrameObj.ImageHandler(c)
+ End If
End Sub)
- Collections.Clear()
- f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
- Downloader.UserRemove(Me)
- MainFrameObj.ImageHandler(Me, False)
- Dispose(False)
- Return 3
+ 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)
+ Downloader.UserRemove(Me)
+ MainFrameObj.ImageHandler(Me, False)
+ Dispose(False)
+ Return 3
+ End If
End If
Case Else : If Not Multiple Then MsgBoxE({"Operation canceled", MsgTitle})
End Select
@@ -562,9 +622,11 @@ Namespace API
"Deleting a user"}, vbExclamation,,,
{
New MsgBoxButton("Remove") With {
- .ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program."},
+ .ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program.",
+ .KeyCode = Keys.Enter},
New MsgBoxButton("Delete") With {
- .ToolTip = "Delete a user from the collection and erase their data."},
+ .ToolTip = "Delete a user from the collection and erase their data.",
+ .KeyCode = New ButtonKey(Keys.Enter, True)},
"Cancel"
}).Index
Case 0
diff --git a/SCrawler/API/XVIDEOS/Declarations.vb b/SCrawler/API/XVIDEOS/Declarations.vb
index cbd310f..dcbdc58 100644
--- a/SCrawler/API/XVIDEOS/Declarations.vb
+++ b/SCrawler/API/XVIDEOS/Declarations.vb
@@ -10,10 +10,13 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.XVIDEOS
Friend Module Declarations
Friend Const XvideosSiteKey As String = "AndyProgram_XVIDEOS"
- Friend ReadOnly Property M3U8Regex As RParams = RParams.DM("http.+?.m3u8.*?(?=')", 0)
- Friend ReadOnly Property VideoTitleRegex As RParams = RParams.DMS("html5player.setVideoTitle\('(.+)(?='\);)", 1)
- Friend ReadOnly Property VideoID As RParams = RParams.DMS(".*?www.xvideos.com/(video\d+).*", 1)
- Friend ReadOnly Property M3U8Reparse As RParams = RParams.DM("NAME=""(\d+).*?""[\r\n]*?(.+)(?=(|[\r\n]+?))", 0, RegexReturn.List)
- Friend ReadOnly Property M3U8Appender As RParams = RParams.DM("(.+)(?=/.+?\.m3u8.*?)", 0)
+ Private ReadOnly HtmlConverter As Func(Of String, String) = Function(Input) SymbolsConverter.HTML.Decode(Input, EDP.ReturnValue)
+ Friend ReadOnly Regex_M3U8 As RParams = RParams.DM("http.+?.m3u8.*?(?=')", 0)
+ Friend ReadOnly Regex_VideoTitle As RParams = RParams.DMS("html5player.setVideoTitle\('(.+)(?='\);)", 1, EDP.ReturnValue, HtmlConverter)
+ 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("
- Partial Friend Class SettingsForm : 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()
- Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
- Me.LIST_DOMAINS = New System.Windows.Forms.ListBox()
- CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
- CONTAINER_MAIN.ContentPanel.SuspendLayout()
- CONTAINER_MAIN.SuspendLayout()
- Me.SuspendLayout()
- '
- 'CONTAINER_MAIN
- '
- '
- 'CONTAINER_MAIN.ContentPanel
- '
- CONTAINER_MAIN.ContentPanel.Controls.Add(Me.LIST_DOMAINS)
- CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 241)
- 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(384, 291)
- CONTAINER_MAIN.TabIndex = 0
- '
- 'LIST_DOMAINS
- '
- Me.LIST_DOMAINS.Dock = System.Windows.Forms.DockStyle.Fill
- Me.LIST_DOMAINS.FormattingEnabled = True
- Me.LIST_DOMAINS.Location = New System.Drawing.Point(0, 0)
- Me.LIST_DOMAINS.Name = "LIST_DOMAINS"
- Me.LIST_DOMAINS.Size = New System.Drawing.Size(384, 241)
- Me.LIST_DOMAINS.TabIndex = 0
- '
- 'SettingsForm
- '
- Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
- Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
- Me.ClientSize = New System.Drawing.Size(384, 291)
- Me.Controls.Add(CONTAINER_MAIN)
- Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
- Me.Icon = Global.SCrawler.My.Resources.SiteResources.XvideosIcon_48
- Me.KeyPreview = True
- Me.MaximizeBox = False
- Me.MaximumSize = New System.Drawing.Size(400, 330)
- Me.MinimizeBox = False
- Me.MinimumSize = New System.Drawing.Size(400, 330)
- Me.Name = "SettingsForm"
- Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
- Me.Text = "Settings"
- CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
- CONTAINER_MAIN.ResumeLayout(False)
- CONTAINER_MAIN.PerformLayout()
- Me.ResumeLayout(False)
-
- End Sub
- Private WithEvents LIST_DOMAINS As Windows.Forms.ListBox
- End Class
-End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/XVIDEOS/SettingsForm.vb b/SCrawler/API/XVIDEOS/SettingsForm.vb
deleted file mode 100644
index be8ed58..0000000
--- a/SCrawler/API/XVIDEOS/SettingsForm.vb
+++ /dev/null
@@ -1,70 +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 PersonalUtilities.Forms
-Imports PersonalUtilities.Forms.Toolbars
-Namespace API.XVIDEOS
- Friend Class SettingsForm
- Private Const SettingsDesignXmlNode As String = "XvideosSettingsForm"
- Private WithEvents MyDefs As DefaultFormOptions
- Private ReadOnly Property Source As SiteSettings
- Friend Sub New(ByRef s As SiteSettings)
- InitializeComponent()
- Source = s
- MyDefs = New DefaultFormOptions(Me, Settings.Design)
- End Sub
- Private Sub SettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
- With MyDefs
- If Not Settings.Design.Contains(SettingsDesignXmlNode) Then Settings.Design.Add(SettingsDesignXmlNode, String.Empty)
- .MyViewInitialize(Me, Settings.Design(SettingsDesignXmlNode), True)
- .AddEditToolbar()
- .AddOkCancelToolbar()
- If Source.Domains.Count > 0 Then Source.Domains.ForEach(Sub(d) LIST_DOMAINS.Items.Add(d))
- .EndLoaderOperations()
- End With
- End Sub
- Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
- Source.Domains.Clear()
- With LIST_DOMAINS
- If .Items.Count > 0 Then
- For Each i In .Items : Source.Domains.Add(i.ToString) : Next
- End If
- End With
- Source.UpdateDomains()
- MyDefs.CloseForm()
- End Sub
- Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
- Dim nd$ = InputBoxE("Enter a new domain using the pattern [xvideos.com]:", "New domain")
- If Not nd.IsEmptyString Then
- If Not LIST_DOMAINS.Items.Contains(nd) Then
- LIST_DOMAINS.Items.Add(nd)
- Else
- MsgBoxE($"The domain [{nd}] already added")
- End If
- End If
- End Sub
- Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
- Const MsgTitle$ = "Removing domains"
- If _LatestSelected.ValueBetween(0, LIST_DOMAINS.Items.Count - 1) Then
- Dim n$ = LIST_DOMAINS.Items(_LatestSelected)
- If MsgBoxE({$"Are you sure you want to delete the [{n}] domain?", MsgTitle}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
- LIST_DOMAINS.Items.RemoveAt(_LatestSelected)
- MsgBoxE({$"Domain [{n}] removed", MsgTitle})
- Else
- MsgBoxE({"Operation canceled", MsgTitle})
- End If
- Else
- MsgBoxE({"No domain selected", MsgTitle}, vbExclamation)
- End If
- End Sub
- Private _LatestSelected As Integer = -1
- Private Sub LIST_DOMENS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_DOMAINS.SelectedIndexChanged
- _LatestSelected = LIST_DOMAINS.SelectedIndex
- End Sub
- End Class
-End Namespace
\ No newline at end of file
diff --git a/SCrawler/API/XVIDEOS/SiteSettings.vb b/SCrawler/API/XVIDEOS/SiteSettings.vb
index 0c1103a..cbd691e 100644
--- a/SCrawler/API/XVIDEOS/SiteSettings.vb
+++ b/SCrawler/API/XVIDEOS/SiteSettings.vb
@@ -7,15 +7,16 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
+Imports SCrawler.API.BaseObjects
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
-Imports PersonalUtilities.Tools.WEB
+Imports PersonalUtilities.Tools.Web.Clients
Namespace API.XVIDEOS
-
- Friend Class SiteSettings : Inherits SiteSettingsBase
-#Region "Images"
- Friend Overrides ReadOnly Property Icon As Icon
+
+ Friend Class SiteSettings : Inherits SiteSettingsBase : Implements IDomainContainer
+#Region "Declarations"
+ Friend Overrides ReadOnly Property Icon As Icon Implements IDomainContainer.Icon
Get
Return My.Resources.SiteResources.XvideosIcon_48
End Get
@@ -25,58 +26,87 @@ 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
-#Region "Declarations"
- Private Property SiteDomains As PropertyValue
- Public Property DownloadUHD As PropertyValue
- Friend ReadOnly Property Domains As List(Of String)
- Private Const DomainsDefault As String = "xvideos.com|xnxx.com"
- Private _Initialized As Boolean = False
+ Friend Property DownloadUHD As PropertyValue
+ Private Property Initialized As Boolean = False Implements IDomainContainer.Initialized
+
+ Friend ReadOnly Property SavedVideosPlaylist As PropertyValue
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New("XVIDEOS", "www.xvideos.com")
+ Responser.DeclaredError = EDP.ThrowException
Domains = New List(Of String)
+ DomainsTemp = New List(Of String)
SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
DownloadUHD = New PropertyValue(False)
+ SavedVideosPlaylist = New PropertyValue(String.Empty, GetType(String))
End Sub
Friend Overrides Sub EndInit()
- _Initialized = True
- UpdateDomains()
+ Initialized = True
+ DomainContainer.EndInit(Me)
+ DomainsTemp.ListAddList(Domains)
End Sub
#End Region
-#Region "Update"
- Private _DomainsUpdateInProgress As Boolean = False
- Friend Sub UpdateDomains()
- If Not _Initialized Then Exit Sub
- If Not _DomainsUpdateInProgress Then
- _DomainsUpdateInProgress = True
- If Not ACheck(SiteDomains.Value) Then SiteDomains.Value = DomainsDefault
- Domains.ListAddList(CStr(SiteDomains.Value).Split("|"), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
- Domains.ListAddList(DomainsDefault.Split("|"), LAP.NotContainsOnly)
- SiteDomains.Value = Domains.ListToString("|")
- _DomainsUpdateInProgress = False
- End If
+#Region "Edit"
+ Private Property DomainsUpdateInProgress As Boolean = False Implements IDomainContainer.DomainsUpdateInProgress
+ Private Property DomainsUpdatedBySite As Boolean = False Implements IDomainContainer.DomainsUpdatedBySite
+ Friend Sub UpdateDomains() Implements IDomainContainer.UpdateDomains
+ DomainContainer.UpdateDomains(Me)
End Sub
Friend Overrides Sub Update()
- UpdateDomains()
+ DomainContainer.Update(Me)
Responser.SaveSettings()
End Sub
+ Friend Overrides Sub EndEdit()
+ DomainContainer.EndEdit(Me)
+ MyBase.EndEdit()
+ End Sub
+ Friend Overrides Sub OpenSettingsForm()
+ DomainContainer.OpenSettingsForm(Me)
+ End Sub
#End Region
#Region "Download"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
- Return New UserData
+ If What = ISiteSettings.Download.SavedPosts Then
+ Return New UserData With {.IsSavedPosts = True, .User = New UserInfo With {.Name = "XVIDEOS"}}
+ Else
+ Return New UserData
+ End If
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
- Return Settings.UseM3U8
+ If Settings.UseM3U8 Then
+ If What = ISiteSettings.Download.SavedPosts Then
+ Return ACheck(SavedVideosPlaylist.Value) And If(Responser.Cookies?.Count, 0) > 0
+ Else
+ Return True
+ End If
+ Else
+ Return False
+ End If
End Function
#End Region
#Region "User: get, check"
- Friend Overrides Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String
- Dim user$ = UserName.Split("_").FirstOrDefault
- user &= $"/{UserName.Replace($"{user}_", String.Empty)}"
- Return user
+ Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
+ Dim __user$ = User.Name.Split("_").FirstOrDefault
+ __user &= $"/{User.Name.Replace($"{User}_", String.Empty)}"
+ Return __user
End Function
Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)"
Private Const URD As String = ".*?{0}{1}"
@@ -84,9 +114,10 @@ Namespace API.XVIDEOS
If Not UserURL.IsEmptyString Then
If Domains.Count > 0 Then
Dim uName$, uOpt$, fStr$
+ Dim uErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To Domains.Count - 1
fStr = String.Format(URD, Domains(i), UserRegexDefault)
- uName = RegexReplace(UserURL, RParams.DMS(fStr, 2))
+ uName = RegexReplace(UserURL, RParams.DMS(fStr, 2, uErr))
If Not uName.IsEmptyString Then
uOpt = RegexReplace(UserURL, RParams.DMS(fStr, 1))
If Not uOpt.IsEmptyString Then Return New ExchangeOptions(Site, $"{uOpt}_{uName}")
@@ -97,11 +128,6 @@ Namespace API.XVIDEOS
Return Nothing
End Function
#End Region
-#Region "Settings"
- Friend Overrides Sub OpenSettingsForm()
- Using f As New SettingsForm(Me) : f.ShowDialog() : End Using
- End Sub
-#End Region
#Region "Get special data"
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString And Domains.Count > 0 Then
diff --git a/SCrawler/API/XVIDEOS/UserData.vb b/SCrawler/API/XVIDEOS/UserData.vb
index 93260f5..cf4c952 100644
--- a/SCrawler/API/XVIDEOS/UserData.vb
+++ b/SCrawler/API/XVIDEOS/UserData.vb
@@ -10,12 +10,29 @@ Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
-Imports PersonalUtilities.Tools.WEB
-Imports PersonalUtilities.Tools.WebDocuments.JSON
+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
+ Private Structure PlayListVideo : Implements IRegExCreator
+ Friend ID As String
+ Friend URL As String
+ Friend Title As String
+ Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
+ 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).StringRemoveWinForbiddenSymbols.StringTrim
+ End If
+ Return Me
+ End Function
+ Friend Function ToUserMedia() As UserMedia
+ Return New UserMedia(URL, UTypes.VideoPre) With {.Object = Me, .PictureOption = Title, .Post = ID}
+ End Function
+ End Structure
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
@@ -28,71 +45,74 @@ Namespace API.XVIDEOS
UseInternalM3U8Function = True
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
+ If Not Settings.UseM3U8 Then
+ If Not Settings.OS64 Then
+ MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
+ Else
+ MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
+ End If
+ Exit Sub
+ End If
+ If IsSavedPosts Then
+ If Not ACheck(MySettings.SavedVideosPlaylist.Value) Then Throw New ArgumentNullException("SavedVideosPlaylist", "Playlist of saved videos cannot be null")
+ DownloadSavedVideos(Token)
+ Else
+ DownloadUserVideo(Token)
+ End If
+ End Sub
+ Private Sub DownloadUserVideo(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
- If Not Settings.UseM3U8 Then
- If Not Settings.OS64 Then
- MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
- Else
- MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
- End If
- Exit Sub
- End If
-
Dim NextPage% = 0
Dim r$
+ Dim j As EContainer = Nothing
Dim jj As EContainer
- Dim e As ErrorsDescriber = EDP.ThrowException
- Dim user$ = MySettings.GetUserUrl(Name, False)
+ Dim user$ = MySettings.GetUserUrl(Me, False)
Dim p As UserMedia
Dim EnvirSet As Boolean = False
Do
ThrowAny(Token)
URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}"
- r = Responser.GetResponse(URL,, e)
+ r = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
- With JsonDocument.Parse(r).XmlIfNothing
+ 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 = New UserPost With {.ID = jj.Value("id")},
- .URL = $"https://www.xvideos.com{jj.Value("u")}"
+ .Post = jj.Value("id"),
+ .URL = $"https://www.xvideos.com/{jj.Value("u").StringTrimStart("/")}"
}
If Not p.Post.ID.IsEmptyString And Not jj.Value("u").IsEmptyString Then
If Not _TempPostsList.Contains(p.Post.ID) Then
_TempPostsList.Add(p.Post.ID)
_TempMediaList.Add(p)
Else
- .Dispose()
Exit Do
End If
End If
Next
- Else
- .Dispose()
- Exit Do
+ Continue Do
End If
End With
- Else
- .Dispose()
- Exit Do
End If
- .Dispose()
End With
- Else
- Exit Do
End If
- Loop
+ If Not j Is Nothing Then j.Dispose()
+ Exit Do
+ Loop While NextPage < 100
+
+ If Not j Is Nothing Then j.Dispose()
If _TempMediaList.Count > 0 Then
For i% = 0 To _TempMediaList.Count - 1
ThrowAny(Token)
- With _TempMediaList(i) : _TempMediaList(i) = GetVideoData(.URL, Responser, MySettings.DownloadUHD.Value, .Post.ID) : End With
+ _TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
Next
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If
@@ -108,38 +128,80 @@ Namespace API.XVIDEOS
If _TempMediaList.ListExists Then _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End Try
End Sub
- Private Function GetVideoData(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String) As UserMedia
+ Private Sub DownloadSavedVideos(ByVal Token As CancellationToken)
+ Dim URL$ = MySettings.SavedVideosPlaylist.Value
Try
- If Not URL.IsEmptyString Then
- Dim r$ = resp.GetResponse(URL,, EDP.ThrowException)
+ Dim NextPage% = 0
+ Dim __continue As Boolean = True
+ Dim r$
+ Dim data As List(Of PlayListVideo)
+ Dim i%
+ Do
+ ThrowAny(Token)
+ 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)
+ End If
+ NextPage += 1
If Not r.IsEmptyString Then
- Dim m$ = RegexReplace(r, M3U8Regex)
- If Not m.IsEmptyString Then
- Dim appender$ = RegexReplace(m, M3U8Appender)
- Dim t$ = RegexReplace(r, VideoTitleRegex)
- r = resp.GetResponse(m,, EDP.ThrowException)
+ data = RegexFields(Of PlayListVideo)(r, {Regex_SavedVideosPlaylist}, {1, 2, 3}, EDP.ReturnValue)
+ If data.ListExists Then
+ If data.RemoveAll(Function(d) _TempPostsList.Contains(d.ID)) > 0 Then __continue = False
+ If data.ListExists Then
+ _TempPostsList.ListAddList(data.Select(Function(d) d.ID), LNC)
+ i = _TempMediaList.Count
+ _TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC)
+ If _TempMediaList.Count = i Or Not __continue Then Exit Do Else Continue Do
+ End If
+ End If
+ End If
+ Exit Do
+ Loop While NextPage < 100 And __continue
+
+ If _TempMediaList.Count > 0 Then
+ For i% = 0 To _TempMediaList.Count - 1
+ ThrowAny(Token)
+ _TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
+ Next
+ _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
+ End If
+ Catch ex As Exception
+ ProcessException(ex, Token, $"data downloading error [{URL}]")
+ End Try
+ End Sub
+ Private Function GetVideoData(ByVal Media As UserMedia, ByVal resp As Response, ByVal DownloadUHD As Boolean) As UserMedia
+ Try
+ If Not Media.URL.IsEmptyString Then
+ Dim r$ = resp.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)
If Not r.IsEmptyString Then
- Dim ls As List(Of Sizes) = RegexFields(Of Sizes)(r, {M3U8Reparse}, {1, 2})
+ 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 Then
ls.Sort()
- m = $"{appender}/{ls(0).Data}"
+ NewUrl = $"{appender}/{ls(0).Data.StringTrimStart("/")}"
ls.Clear()
- Dim pID$ = ID
- If pID.IsEmptyString Then pID = RegexReplace(r, VideoID)
+ Dim pID$ = Media.Post.ID
+ If pID.IsEmptyString Then pID = RegexReplace(r, Regex_VideoID)
If pID.IsEmptyString Then pID = "0"
- If Not t.IsEmptyString Then t = t.StringRemoveWinForbiddenSymbols(" ")
+ t = t.StringRemoveWinForbiddenSymbols.StringTrim
If t.IsEmptyString Then
t = pID
Else
If t.Length > 100 Then t = Left(t, 100)
End If
- If Not m.IsEmptyString Then
- Return New UserMedia With {
- .Type = UTypes.m3u8,
- .Post = New UserPost With {.ID = pID},
- .URL = m,
+ If Not NewUrl.IsEmptyString Then
+ Return New UserMedia(NewUrl, UTypes.m3u8) With {
+ .Post = pID,
+ .URL_BASE = Media.URL,
.File = $"{t}.mp4",
.PictureOption = appender
}
@@ -151,18 +213,18 @@ Namespace API.XVIDEOS
End If
Return Nothing
Catch ex As Exception
- LogError(ex, $"[XVIDEOS.UserData.GetVideoData({URL})]")
+ LogError(ex, $"[XVIDEOS.UserData.GetVideoData({Media.URL})]")
Return Nothing
End Try
End Function
Friend Function Download(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String)
- Dim m As UserMedia = GetVideoData(URL, resp, DownloadUHD, ID)
+ 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, Settings.FfmpegFile, f)
+ f = M3U8.Download(m.URL, m.PictureOption, f)
m.File = f
m.State = UStates.Downloaded
Catch ex As Exception
@@ -175,7 +237,7 @@ Namespace API.XVIDEOS
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, Settings.FfmpegFile, DestinationFile)
+ Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile)
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
diff --git a/SCrawler/API/Xhamster/Declarations.vb b/SCrawler/API/Xhamster/Declarations.vb
new file mode 100644
index 0000000..0d07a8c
--- /dev/null
+++ b/SCrawler/API/Xhamster/Declarations.vb
@@ -0,0 +1,19 @@
+' 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.Globalization
+Imports PersonalUtilities.Functions.RegularExpressions
+Namespace API.Xhamster
+ Friend Module Declarations
+ Friend Const XhamsterSiteKey As String = "AndyProgram_XHamster"
+ Friend ReadOnly HtmlScript As RParams = RParams.DMS("\