' 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.Web.Clients Imports PersonalUtilities.Tools.Web.Documents.JSON Imports UTypes = SCrawler.API.Base.UserMedia.Types Namespace API.PornHub Friend Class UserData : Inherits UserDataBase Private Const UrlPattern As String = "https://www.pornhub.com/{0}" #Region "Declarations" #Region "XML names" Private Const Name_PersonType As String = "PersonType" Private Const Name_NameTrue As String = "NameTrue" Private Const Name_PhotoPageModel As String = "PhotoPageModel" Private Const Name_DownloadUHD As String = "DownloadUHD" Private Const Name_DownloadUploaded As String = "DownloadUploaded" Private Const Name_DownloadTagged As String = "DownloadTagged" Private Const Name_DownloadPrivate As String = "DownloadPrivate" Private Const Name_DownloadFavorite As String = "DownloadFavorite" Private Const Name_DownloadGifs As String = "DownloadGifs" Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub" #End Region #Region "Structures" Private Structure FlashVar : Implements IRegExCreator Friend Name As String Friend Value As String Public Shared Widening Operator CType(ByVal Name As String) As FlashVar Return New FlashVar With {.Name = Name} End Operator Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray If ParamsArray.ListExists(2) Then Name = ParamsArray(0) Value = ParamsArray(1) If Not Value.IsEmptyString Then Value = Value.Replace(""" + """, String.Empty).Replace("""", String.Empty).StringTrim End If Return Me End Function Public Overrides Function Equals(ByVal Obj As Object) As Boolean Return CType(Obj, FlashVar).Name = Name End Function End Structure Private Structure UserVideo : Implements IRegExCreator Friend URL As String Friend ID As String Friend Title As String Friend Type As VideoTypes Friend Function ToUserMedia(Optional ByVal SpecialFolder As String = Nothing) As UserMedia Return New UserMedia(URL, UTypes.VideoPre) With { .File = If(Title.IsEmptyString, .File, New SFile($"{Title}.mp4")), .Post = ID, .SpecialFolder = SpecialFolder } End Function Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray If ParamsArray.ListExists(4) Then URL = ParamsArray(0) ID = RegexReplace(URL, RegexVideo_Video_VideoKey) If ID.IsEmptyString Then URL = String.Empty Else URL = String.Format(UrlPattern, URL.TrimStart("/")) Title = TitleHtmlConverter(ParamsArray(1)) If Not ParamsArray(2).IsEmptyString Then Type = VideoTypes.Private ElseIf Not ParamsArray(3).IsEmptyString Then Type = VideoTypes.Tagged Else Type = VideoTypes.Uploaded End If End If End If Return Me End Function Public Overrides Function Equals(ByVal Obj As Object) As Boolean Return DirectCast(Obj, UserVideo).URL = URL End Function End Structure Private Structure PhotoBlock : Implements IRegExCreator Friend AlbumID As String Friend Data As String Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray If ParamsArray.ListExists(2) Then AlbumID = ParamsArray(0) Data = ParamsArray(1).StringTrim End If Return Me End Function End Structure #End Region #Region "Enums" Private Enum PhotoPageModels As Integer Undefined = 0 PornHubPage = 1 ModelHubPage = 2 End Enum Private Enum VideoTypes Undefined Uploaded [Private] Tagged Favorite End Enum #End Region #Region "Constants" Private Const PersonTypeModel As String = "model" Private Const PersonTypeUser As String = "users" Private Const PersonTypePornstar As String = "pornstar" Private Const PersonTypeCannel As String = "channels" Private Const PersonTypePlaylist As String = "playlist" Private Const PlaylistsLabelName As String = "Playlist" #End Region #Region "Person" Friend Property PersonType As String Friend Property NameTrue As String Friend Overrides Property FriendlyName As String Get If _FriendlyName.IsEmptyString Then Return NameTrue Else Return _FriendlyName End Get Set(ByVal n As String) _FriendlyName = n End Set End Property #End Region #Region "Advanced fields" Friend Overrides ReadOnly Property FeedIsUser As Boolean Get Return IsUser Or SiteMode = SiteModes.Playlists End Get End Property Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined Friend Property DownloadUHD As Boolean = False Friend Property DownloadUploaded As Boolean = True Friend Property DownloadTagged As Boolean = False Friend Property DownloadPrivate As Boolean = False Friend Property DownloadFavorite As Boolean = False Friend Property DownloadGifs As Boolean Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True Friend Overrides ReadOnly Property IsUser As Boolean Get Return SiteMode = SiteModes.User End Get End Property Friend Property SiteMode As SiteModes = SiteModes.User Friend Property QueryString As String Get If IsUser Then Return String.Empty Else Return GetNonUserUrl(0) End If End Get Set(ByVal q As String) UpdateUserOptions(True, q) End Set End Property Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Get Return {SearchRequestLabelName, PlaylistsLabelName} End Get End Property #End Region #Region "ExchangeOptions" 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) DownloadUHD = .DownloadUHD DownloadUploaded = .DownloadUploaded DownloadTagged = .DownloadTagged DownloadPrivate = .DownloadPrivate DownloadFavorite = .DownloadFavorite DownloadGifs = .DownloadGifs DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub QueryString = .QueryString End With End If End Sub #End Region Private ReadOnly Property MySettings As SiteSettings Get Return DirectCast(HOST.Source, SiteSettings) End Get End Property #End Region #Region "Initializer" Friend Sub New() UseInternalM3U8Function = True UseClientTokens = True SessionPosts = New List(Of String) End Sub #End Region #Region "Loader" Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean If Not Force OrElse (Not IsUser AndAlso Not SiteMode = SiteModes.Playlists AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then Dim eObj As Plugin.ExchangeOptions = Nothing If Force Then eObj = MySettings.IsMyUser(NewUrl) If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And Not Name.IsEmptyString And NameTrue.IsEmptyString) Then If Not If(Force, eObj.Options, Options).IsEmptyString Then If (IsUser Or SiteMode = SiteModes.Playlists) And Force Then Return False Else SiteMode = SiteModes.Search Options = If(Force, eObj.Options, Options) If Options.ToLower.StartsWith(PersonTypePlaylist) Then SiteMode = SiteModes.Playlists NameTrue = Options.ToLower.Replace(PersonTypePlaylist, String.Empty).StringTrim.TrimStart("/") Else NameTrue = Options End If If Not Force Then Dim l$ = IIf(SiteMode = SiteModes.Playlists, PlaylistsLabelName, SearchRequestLabelName) Settings.Labels.Add(l) Labels.ListAddValue(l, LNC) Labels.Sort() Return True End If End If Else SiteMode = SiteModes.User Dim n$() = Name.Split("_") If n.ListExists(2) Then NameTrue = Name.Replace($"{n(0)}_", String.Empty) PersonType = n(0) End If End If End If End If Return False End Function Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) With Container If Loading Then PersonType = .Value(Name_PersonType) NameTrue = .Value(Name_NameTrue) PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined) DownloadUHD = .Value(Name_DownloadUHD).FromXML(Of Boolean)(False) DownloadUploaded = .Value(Name_DownloadUploaded).FromXML(Of Boolean)(True) DownloadTagged = .Value(Name_DownloadTagged).FromXML(Of Boolean)(False) DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(False) DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False) DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False) DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True) SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User) UpdateUserOptions() Else If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString .Add(Name_PersonType, PersonType) .Add(Name_NameTrue, NameTrue) .Add(Name_PhotoPageModel, CInt(PhotoPageModel)) .Add(Name_DownloadUHD, DownloadUHD.BoolToInteger) .Add(Name_DownloadUploaded, DownloadUploaded.BoolToInteger) .Add(Name_DownloadTagged, DownloadTagged.BoolToInteger) .Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger) .Add(Name_DownloadFavorite, DownloadFavorite.BoolToInteger) .Add(Name_DownloadGifs, DownloadGifs.BoolToInteger) .Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger) .Add(Name_SiteMode, CInt(SiteMode)) 'Debug.WriteLine(GetNonUserUrl(0)) 'Debug.WriteLine(GetNonUserUrl(2)) End If End With End Sub #End Region #Region "Downloading" #Region "Download override" Private Const PlayListUrlPattern As String = "https://www.pornhub.com/playlist/viewChunked?id={0}&token={1}&page={2}" Private PlaylistToken As String = String.Empty Private ReadOnly SessionPosts As List(Of String) Private _PageVideosRepeat As Integer = 0 Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Try PlaylistToken = String.Empty Responser.ResetStatus() _PageVideosRepeat = 0 SessionPosts.Clear() If IsSavedPosts Then PersonType = PersonTypeUser NameTrue = MySettings.SavedPostsUserName.Value End If Dim limit% = If(DownloadTopCount, -1) If DownloadVideos Then If SiteMode = SiteModes.Playlists Then Responser.Mode = Responser.Modes.Default GetPlaylistToken(Token) DownloadUserVideos(1, VideoTypes.Favorite, False, Token) ElseIf IsSavedPosts Or Not IsUser Or PersonType = PersonTypeUser Then DownloadUserVideos(1, VideoTypes.Favorite, False, Token) Else If DownloadUploaded Then SessionPosts.Clear() DownloadUserVideos(1, VideoTypes.Uploaded, False, Token) End If If DownloadTagged Then SessionPosts.Clear() Dim lBefore% = _TempMediaList.Count DownloadUserVideos(1, VideoTypes.Tagged, False, Token) If PersonType = PersonTypePornstar And lBefore = _TempMediaList.Count Then SessionPosts.Clear() DownloadUserVideos(1, VideoTypes.Tagged, True, Token) End If End If If DownloadPrivate Then SessionPosts.Clear() DownloadUserVideos(1, VideoTypes.Private, False, Token) End If If DownloadFavorite Then SessionPosts.Clear() DownloadUserVideos(1, VideoTypes.Favorite, False, Token) End If End If If _TempMediaList.Count > 0 Then _TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre) If limit > 0 And _TempMediaList.Count > limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd) End If End If If DownloadGifs And Not IsSavedPosts And Not IsSubscription And IsUser Then DownloadUserGifs(Token) If DownloadImages And Not IsSubscription And IsUser Then DownloadUserPhotos(Token) Finally Responser.Mode = Responser.Modes.Default Responser.Method = "GET" ProgressPre.Done() End Try End Sub #End Region #Region "Download video" Friend Function GetNonUserUrl(ByVal Page As Integer) As String If IsUser Then Return String.Empty Else Dim url$ = $"https://www.pornhub.com/{Options}" If Page > 1 Then If url.Contains("?") Then url &= $"&page={Page}" Else url = url.TrimEnd("/") url &= $"?page={Page}" End If End If Return url End If End Function Private Sub DownloadUserVideos(ByVal Page As Integer, ByVal Type As VideoTypes, ByVal SecondMode As Boolean, ByVal Token As CancellationToken) Dim URL$ = String.Empty ProgressPre.ChangeMax(1) Try Dim specFolder$ = String.Empty Dim tryNextPage As Boolean = False Dim limit% = If(DownloadTopCount, -1) Dim cBefore% = _TempMediaList.Count If IsUser Then URL = $"https://www.pornhub.com/{PersonType}/{NameTrue}" If Type = VideoTypes.Uploaded Then URL &= "/videos/upload" ElseIf Type = VideoTypes.Tagged Then If Not SecondMode Then URL &= "/videos" specFolder = "Tagged" ElseIf Type = VideoTypes.Private Then URL &= "/videos/private" specFolder = "Private" ElseIf Type = VideoTypes.Favorite Then URL &= "/videos/favorites" If Not PersonType = PersonTypeUser Then specFolder = "Favorite" Else Throw New ArgumentException($"Type '{Type}' is not implemented in the video download function", "Type") End If If Page > 1 Then URL &= $"?page={Page}" ElseIf SiteMode = SiteModes.Playlists Then If PlaylistToken.IsEmptyString Then Throw New ArgumentNullException("PlaylistToken", "Unable to get 'PlaylistToken'") URL = String.Format(PlayListUrlPattern, NameTrue, PlaylistToken, Page) Else URL = GetNonUserUrl(Page) End If ThrowAny(Token) 'Debug.WriteLine(URL) Dim r$ = Responser.GetResponse(URL) If Not r.IsEmptyString Then Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexUserVideos}, {6, 7, 3, 10}) 'If l.ListExists And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(3, l.Count).ToList If l.ListExists And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(1, l.Count).ToList If l.ListExists Then If IsUser Then If Type = VideoTypes.Favorite Then l.RemoveAll(Function(uv) uv.Type = VideoTypes.Private) ElseIf Not PersonType = PersonTypeCannel Then l.RemoveAll(Function(uv) Not uv.Type = Type) End If End If If l.Count > 0 Then l.RemoveAll(Function(uv) uv.ID.IsEmptyString Or uv.URL.IsEmptyString) If l.Count > 0 Then Dim lBefore% = l.Count Dim nonLastPageDetected As Boolean = False Dim newLastPageIDs As New List(Of String) Dim pageRepeatSet As Boolean = False, prevPostsFound As Boolean = False, newPostsFound As Boolean = False l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean newLastPageIDs.Add(uv.ID) If Not _TempPostsList.Contains(uv.ID) Then _TempPostsList.Add(uv.ID) newPostsFound = True Return False ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.id) Then prevPostsFound = True Return True Else If Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1 'Debug.WriteLine($"[REMOVED]: {uv.Title}") Return True End If End Function) 'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine)) If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1 If prevPostsFound And newPostsFound And pageRepeatSet Then _PageVideosRepeat -= 1 If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia(specFolder))) SessionPosts.ListAddList(newLastPageIDs, LNC) newLastPageIDs.Clear() If limit > 0 And _TempMediaList.Count >= limit Then Exit Sub If _PageVideosRepeat < 2 And ((Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or (Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000))) Then tryNextPage = True l.Clear() End If End If End If If tryNextPage Then DownloadUserVideos(Page + 1, Type, SecondMode, Token) Catch regex_ex As RegexFieldsTextBecameNullException If Not IsSavedPosts Then MyMainLOG = $"{ToStringForLog()}: videos not found. You may need to update your credentials." Catch ex As Exception ProcessException(ex, Token, $"videos downloading error [{URL}]") Finally ProgressPre.Perform() End Try End Sub Private Sub GetPlaylistToken(ByVal Token As CancellationToken) Dim URL$ = GetNonUserUrl(0) Try Dim r$ = Responser.GetResponse(URL) If Not r.IsEmptyString Then PlaylistToken = RegexReplace(r, RegexDataToken) Catch ex As Exception ProcessException(ex, Token, $"token getting error [{URL}]") End Try End Sub #End Region #Region "Download GIF" Private Sub DownloadUserGifs(ByVal Token As CancellationToken) Dim URL$ = $"https://www.pornhub.com/{PersonType}/{NameTrue}/gifs" Try ThrowAny(Token) Dim r$ = Responser.GetResponse(URL) If Not r.IsEmptyString Then Dim n$ Dim m As UserMedia = Nothing Dim l As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {Regex_Gif_Array}, {1}, EDP.ReturnValue) Dim l2 As List(Of String) = Nothing Dim l3 As List(Of String) = Nothing If l.ListExists Then l2 = l.Select(Function(ll) $"gif/{ll.Arr(0).Replace("gif", String.Empty)}").ToList If l2.ListExists Then ProgressPre.ChangeMax(l2.Count) For Each gif$ In l2 If Not _TempPostsList.Contains(gif) Then _TempPostsList.Add(gif) URL = $"https://www.pornhub.com/{gif}" m = New UserMedia(URL, UTypes.Video) With {.Post = gif, .SpecialFolder = "GIFs\"} ProgressPre.Perform() ThrowAny(Token) Try r = Responser.GetResponse(URL) If Not r.IsEmptyString Then If l3.ListExists Then l3.Clear() : l3 = Nothing l3 = RegexReplace(r, Regex_Gif_UrlName) If l3.ListExists(3) Then m.URL = l3(2) m.File = m.URL n = TitleHtmlConverter(l3(1)) If MySettings.DownloadGifsAsMp4.Value Then m.File.Extension = "mp4" If Not n.IsEmptyString Then m.File.Name = n End If End If Catch gif_down_ex As Exception m.State = UserMedia.States.Missing End Try _TempMediaList.ListAddValue(m) End If Next End If If l.ListExists Then l.Clear() If l2.ListExists Then l2.Clear() If l3.ListExists Then l3.Clear() End If Catch ex As Exception ProcessException(ex, Token, $"gifs downloading error [{URL}]") End Try End Sub #End Region #Region "Download photo" Private Function CreatePhotoFile(ByVal URL As String, ByVal File As SFile) As SFile Dim pFile$ = RegexReplace(URL, Regex_Photo_File) If Not pFile.IsEmptyString Then Return New SFile(pFile) Else Return File End Function Private Const PhotoUrlPattern_ModelHub As String = "https://www.modelhub.com/{0}/photos" Private Const PhotoUrlPattern_PornHub As String = "https://www.pornhub.com/{0}/{1}/photos" Private Sub DownloadUserPhotos(ByVal Token As CancellationToken) Try If IsSavedPosts Then DownloadUserPhotos_SavedPosts(Token) ElseIf PersonType = PersonTypeModel Then If PhotoPageModel = PhotoPageModels.Undefined Then If DownloadUserPhotos_ModelHub(Token) Then PhotoPageModel = PhotoPageModels.ModelHubPage ThrowAny(Token) If PhotoPageModel = PhotoPageModels.Undefined AndAlso Not DownloadPhotoOnlyFromModelHub AndAlso DownloadUserPhotos_PornHub(Token) Then PhotoPageModel = PhotoPageModels.PornHubPage Else Select Case PhotoPageModel Case PhotoPageModels.ModelHubPage : DownloadUserPhotos_ModelHub(Token) Case PhotoPageModels.PornHubPage : If Not DownloadPhotoOnlyFromModelHub Then DownloadUserPhotos_PornHub(Token) End Select End If ElseIf Not DownloadPhotoOnlyFromModelHub Then DownloadUserPhotos_PornHub(Token) End If ThrowAny(Token) Catch ex As Exception ProcessException(ex, Token, "photos downloading error") End Try End Sub Private Function DownloadUserPhotos_ModelHub(ByVal Token As CancellationToken) As Boolean Dim URL$ = String.Empty Try Dim j As EContainer Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue) Dim albumName$ If PersonType = PersonTypeModel Then URL = String.Format(PhotoUrlPattern_ModelHub, NameTrue) Dim r$ = Responser.GetResponse(URL) If Not r.IsEmptyString Then Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2}, EDP.ReturnValue) If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString) If l.ListExists Then ProgressPre.ChangeMax(l.Count) Dim albumRegex As RParams = RParams.DMS("", 1, EDP.ReturnValue) For Each block As PhotoBlock In l ProgressPre.Perform() If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For albumRegex.Pattern = "