Compare commits

..

4 Commits

Author SHA1 Message Date
Andy
ffab035cee 2026.8.7.0
API: updated EditorExchangeOptionsBase and its inheritances
API.Base.SiteSettingsBase: updated 'Responser' creation algorithm
API.Base.UserDataBase: updated 'DownloadContentDefault_ConvertWebp_Impl' function
API.Instagram: added 'USE_GQL_Highlights' property; updated 'DocId' to get highlights and user info; remove 'ValidateExtension'; add 'DownloadContentDefault_ConvertWebp' to convert 'heic' files; fix highlights downloading; update getting username by ID
API.Reddit: fix missing posts downloading
API.ThisVid: fix a bug with updating/adding cookies
API.Twitter: fix post text is not downloaded completely
API.Xhamster: fix some posts are not downloaded
DownloadFeedForm: improve filters; add loading buttons 'Current', 'Favorite' and 'Load'
FeedMedia: fix an issue where post text would not load in older feeds
FeedFilter: add search by labels; fix saving filters when selecting users; fix an issue with the 'TEMP' filter
SiteEditorForm: get a cookies instance from the source
2026-08-07 17:29:35 +03:00
Andy
9b3c172fc3 Update README.md 2026-06-01 11:12:04 +03:00
Andy
9ba78d2fa0 2026.5.13.0
API.Base: add 'IThumbList' interface; add the 'ReparseMissing_ClearList' function to the base class
API.Instagram: protect all necessary controls; fix error getting user info
API.OnlyFans: add the 'CookieDateProvider' class to avoid cookies error
API.PornHub: add image and title additional regex; fix subscription downloading bug
API.ThisVid: add 'ReparseMissing' function
Feed: add the most frequently used buttons to the top
FeedMedia: fix subscription bug
2026-05-13 20:45:18 +03:00
Andy
be97752b7c 2026.3.23.0
API.EditorExchangeOptionsBase: move the 'Apply' function
API.EditorExchangeOptionsBase_P: remove the 'Apply' function
API.UserDataBase: update the 'UserSiteNameUpdate' function; remove the '_ForceSaveUserInfoOnException' property; update the 'DownloadContentDefault_ConvertWebp' function; add the 'DownloadContentDefault_ConvertWebp_TestImg' and 'DownloadContentDefault_ConvertWebp_Impl' functions
API.Bluesky: add the 'EditorExchangeOptions' class; add 'did:' handle for recognizing
API.PornHub: update M3U8 download functions
API.TikTok: fix where gallery-dl would hang when downloading stories
API.Twitter: fix downloading a single media file (standalone downloader) fails
API.Xhamster: add 'webm' to 'jpg' correct conversion
FeedMedia: move the 'ImageRenderer2' class into the 'UserImage' class
UserImage: add the 'ImageRenderer2' class
2026-03-23 17:21:04 +03:00
52 changed files with 980 additions and 263 deletions

View File

@@ -2,13 +2,74 @@
- [ffmpeg](https://github.com/AAndyProgram/SCrawler/wiki/Settings#ffmpeg) - [ffmpeg](https://github.com/AAndyProgram/SCrawler/wiki/Settings#ffmpeg)
- x64 version - [release](https://github.com/GyanD/codexffmpeg/releases/tag/5.1.2); [zip](https://github.com/GyanD/codexffmpeg/releases/download/5.1.2/ffmpeg-5.1.2-full_build.zip); **version `5.1.2-full_build-www.gyan.dev`** - x64 version - [release](https://github.com/GyanD/codexffmpeg/releases/tag/5.1.2); [zip](https://github.com/GyanD/codexffmpeg/releases/download/5.1.2/ffmpeg-5.1.2-full_build.zip); **version `5.1.2-full_build-www.gyan.dev`**
- x86 version - [release](https://github.com/yt-dlp/FFmpeg-Builds/releases/tag/autobuild-2022-11-30-12-57); [zip](https://github.com/yt-dlp/FFmpeg-Builds/releases/download/autobuild-2022-11-30-12-57/ffmpeg-N-109274-gd7a5f068c2-win32-gpl.zip); **version `N-109457-geeb280f351-20221226`** - x86 version - [release](https://github.com/yt-dlp/FFmpeg-Builds/releases/tag/autobuild-2022-11-30-12-57); [zip](https://github.com/yt-dlp/FFmpeg-Builds/releases/download/autobuild-2022-11-30-12-57/ffmpeg-N-109274-gd7a5f068c2-win32-gpl.zip); **version `N-109457-geeb280f351-20221226`**
- [Gallery-dl](https://github.com/AAndyProgram/SCrawler/wiki/Settings#gallery-dl) - **1.31.6** - [Gallery-dl](https://github.com/AAndyProgram/SCrawler/wiki/Settings#gallery-dl) - **1.32.9**
- [YT-DLP](https://github.com/AAndyProgram/SCrawler/wiki/Settings#yt-dlp) - **2026.02.04.233607** - [YT-DLP](https://github.com/AAndyProgram/SCrawler/wiki/Settings#yt-dlp) - **2026.07.04**
- [Deno](https://github.com/AAndyProgram/SCrawler/wiki/Settings#deno) - latest *(`2.0.0` or higher)* - [Deno](https://github.com/AAndyProgram/SCrawler/wiki/Settings#deno) - latest *(`2.0.0` or higher)*
- [OF-Scraper](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper) - **3.12.9** ([release](https://github.com/datawhores/OF-Scraper/releases/tag/3.12.9)) - [OF-Scraper](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper) - **3.12.9** ([release](https://github.com/datawhores/OF-Scraper/releases/tag/3.12.9))
# 2026 # 2026
## 2026.8.7.0
*2026-08-07*
- Added
- Feed:
- improve filters *(add search by labels)*
- add `Current`, `Favorite` and `Load` buttons to the toolbar
- Minor improvements
- Updated
- gallery-dl up to version **1.32.9**
- yt-dlp up to version **2026.07.04**
- Fixed
- Sites:
- Instagram: **highlights are not downloading**
- Reddit: missing posts are not downloading
- ThisVid: a bug with updating/adding cookies
- Twitter: **post text is not downloaded completely**
- xHamster: some posts are not downloaded
- Feed: the post text is not loading in old feeds
- Minor bugs
## 2026.5.13.0
*2026-05-13*
- Added
- Sites
- ThisVid: download undownloaded videos
- Feed: the most frequently used buttons are added to the top
- Minor improvements
- Updated
- gallery-dl up to version **1.32.0**
- Fixed
- Sites:
- **Instagram: data is not downloading**
- OnlyFans: cookies error
- PornHub: subscriptions are not downloading
- Minor bugs
## 2026.3.23.0
*2026-03-23*
- Added
- Sites:
- Bluesky:
- download models (user options), like in Twitter
- `did` handle for recognizing
- PornHub: `M3U8` download functionality update
- xHamster: add `webm` to `jpg` correct conversion
- Minor improvements
- Updated
- gallery-dl up to version **1.31.9**
- yt-dlp up to version **2026.03.17**
- Fixed
- Sites:
- TikTok: gallery-dl downloads stories slowly when the user has no stories
- Twitter: downloading a single media file (standalone downloader) fails
- Minor bugs
## 2026.2.14.0 ## 2026.2.14.0
*2026-02-14* *2026-02-14*

Binary file not shown.

After

Width:  |  Height:  |  Size: 847 KiB

View File

@@ -1,6 +1,5 @@
<!--
# 🏳️‍🌈 Happy LGBT Pride Month 🎉 # 🏳️‍🌈 Happy LGBT Pride Month 🎉
-->
# 🏳️‍🌈 Social networks crawler 🏳️‍🌈 # 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest) [![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)

View File

@@ -11,6 +11,9 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base Namespace API.Base
Friend Module Declarations Friend Module Declarations
Friend Interface IThumbList
Property Thumbs As List(Of String)
End Interface
Friend Const UserLabelName As String = "User" Friend Const UserLabelName As String = "User"
Friend Const SearchRequestLabelName As String = "Search request" Friend Const SearchRequestLabelName As String = "Search request"
Friend ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly) Friend ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)

View File

@@ -11,6 +11,10 @@ Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Base Namespace API.Base
Friend Class EditorExchangeOptionsBase Friend Class EditorExchangeOptionsBase
Friend Overridable Property SiteKey As String Friend Overridable Property SiteKey As String
<PSetting(Address:=SettingAddress.User, Caption:="Profile exists")>
Friend Overridable Property UserExists As Boolean = True
<PSetting(Address:=SettingAddress.User, Caption:="Profile suspended")>
Friend Overridable Property UserSuspended As Boolean = False
<PSetting(Address:=SettingAddress.User, Caption:=DN.UserNameChangeCaption, ToolTip:=DN.UserNameChangeToolTip)> <PSetting(Address:=SettingAddress.User, Caption:=DN.UserNameChangeCaption, ToolTip:=DN.UserNameChangeToolTip)>
Friend Overridable Property UserName As String = String.Empty Friend Overridable Property UserName As String = String.Empty
<PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextCaption, ToolTip:=DN.DownloadTextTip)> <PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextCaption, ToolTip:=DN.DownloadTextTip)>
@@ -20,6 +24,8 @@ Namespace API.Base
<PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextSpecialFolderCaption, ToolTip:=DN.DownloadTextSpecialFolderTip)> <PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextSpecialFolderCaption, ToolTip:=DN.DownloadTextSpecialFolderTip)>
Friend Overridable Property DownloadTextSpecialFolder As Boolean = False Friend Overridable Property DownloadTextSpecialFolder As Boolean = False
Friend Sub New(ByVal u As UserDataBase) Friend Sub New(ByVal u As UserDataBase)
UserExists = u.UserExists
UserSuspended = u.UserSuspended
UserName = u.NameTrue(True) UserName = u.NameTrue(True)
DownloadText = u.DownloadText DownloadText = u.DownloadText
DownloadTextPosts = u.DownloadTextPosts DownloadTextPosts = u.DownloadTextPosts
@@ -35,6 +41,8 @@ Namespace API.Base
Protected _ApplyBase_Name As Boolean = True Protected _ApplyBase_Name As Boolean = True
Protected _ApplyBase_Text As Boolean = True Protected _ApplyBase_Text As Boolean = True
Friend Sub ApplyBase(ByRef u As UserDataBase) Friend Sub ApplyBase(ByRef u As UserDataBase)
u.UserExists = UserExists
u.UserSuspended = UserSuspended
If _ApplyBase_Name Then u.NameTrue = UserName If _ApplyBase_Name Then u.NameTrue = UserName
If _ApplyBase_Text Then If _ApplyBase_Text Then
u.DownloadText = DownloadText u.DownloadText = DownloadText
@@ -42,5 +50,9 @@ Namespace API.Base
u.DownloadTextSpecialFolder = DownloadTextSpecialFolder u.DownloadTextSpecialFolder = DownloadTextSpecialFolder
End If End If
End Sub End Sub
Friend Overridable Sub Apply(ByRef u As UserDataBase)
ApplyBase(u)
If TypeOf u Is IPSite And TypeOf Me Is IPSite Then DirectCast(u, IPSite).QueryString = DirectCast(Me, IPSite).QueryString
End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -31,10 +31,6 @@ Namespace API.Base
MyBase.New(s) MyBase.New(s)
DisableBase() DisableBase()
End Sub End Sub
Friend Overridable Sub Apply(ByRef u As IPSite)
ApplyBase(u)
u.QueryString = QueryString
End Sub
Protected Overridable Sub DisableBase() Protected Overridable Sub DisableBase()
_ApplyBase_Name = False _ApplyBase_Name = False
_ApplyBase_Text = False _ApplyBase_Text = False

View File

@@ -53,7 +53,12 @@ Namespace API.Base
End Get End Get
End Property End Property
Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger
Friend Overridable ReadOnly Property Responser As Responser Protected _Responser As Responser = Nothing
Friend ReadOnly Property Responser As Responser
Get
Return _Responser
End Get
End Property
Private _UserOptionsExists As Boolean = False Private _UserOptionsExists As Boolean = False
Private _UserOptionsType As Type = Nothing Private _UserOptionsType As Type = Nothing
Protected Overridable Function UserOptionsValid(ByVal Options As Object) As Boolean Protected Overridable Function UserOptionsValid(ByVal Options As Object) As Boolean
@@ -122,6 +127,11 @@ Namespace API.Base
_CookiesNetscapeFile.Name &= "_Cookies_Netscape" _CookiesNetscapeFile.Name &= "_Cookies_Netscape"
_CookiesNetscapeFile.Extension = "txt" _CookiesNetscapeFile.Extension = "txt"
End Sub End Sub
Protected Overridable Sub ChangeResponserOnInit()
End Sub
Friend Overridable Function GetCookieKeeperInstance() As CookieKeeper
Return New CookieKeeper
End Function
#End Region #End Region
#Region "GetInstance" #Region "GetInstance"
Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance
@@ -131,7 +141,8 @@ Namespace API.Base
Site = SiteName Site = SiteName
_Icon = __Icon _Icon = __Icon
_Image = __Image _Image = __Image
Responser = New Responser With {.DeclaredError = EDP.ThrowException} _Responser = New Responser With {.DeclaredError = EDP.ThrowException}
ChangeResponserOnInit()
SettingsVersion = New PropertyValue(0) SettingsVersion = New PropertyValue(0)
DownloadText = New PropertyValue(False) DownloadText = New PropertyValue(False)
DownloadTextPosts = New PropertyValue(False) DownloadTextPosts = New PropertyValue(False)

View File

@@ -360,8 +360,8 @@ Namespace API.Base
Me._UserSiteName = _UserSiteName Me._UserSiteName = _UserSiteName
End Set End Set
End Property End Property
Protected Sub UserSiteNameUpdate(ByVal NewName As String) Protected Sub UserSiteNameUpdate(ByVal NewName As String, Optional ByVal Force As Boolean = False)
If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UpdateUserSiteNameEveryTime) Then UserSiteName = NewName If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UpdateUserSiteNameEveryTime Or Force) Then UserSiteName = NewName
End Sub End Sub
Friend ReadOnly Property UserModel As UsageModel Implements IUserData.UserModel Friend ReadOnly Property UserModel As UsageModel Implements IUserData.UserModel
Get Get
@@ -1030,7 +1030,7 @@ BlockNullPicture:
End Try End Try
End Sub End Sub
Private Sub UpdateUserInformation_Ex() Private Sub UpdateUserInformation_Ex()
If _ForceSaveUserInfoOnException Then UpdateUserInformation() If _ForceSaveUserInfo Then UpdateUserInformation()
End Sub End Sub
Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
UpdateUserInformation(False) UpdateUserInformation(False)
@@ -1207,7 +1207,6 @@ BlockNullPicture:
Protected UseClientTokens As Boolean = False Protected UseClientTokens As Boolean = False
Protected _ForceSaveUserData As Boolean = False Protected _ForceSaveUserData As Boolean = False
Protected _ForceSaveUserInfo As Boolean = False Protected _ForceSaveUserInfo As Boolean = False
Protected _ForceSaveUserInfoOnException As Boolean = False
Private _DownloadInProgress As Boolean = False Private _DownloadInProgress As Boolean = False
Private _EnvirUserExists As Boolean Private _EnvirUserExists As Boolean
Private _EnvirUserSuspended As Boolean Private _EnvirUserSuspended As Boolean
@@ -1227,7 +1226,6 @@ BlockNullPicture:
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime _DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
_ForceSaveUserData = False _ForceSaveUserData = False
_ForceSaveUserInfo = False _ForceSaveUserInfo = False
_ForceSaveUserInfoOnException = False
_EnvirUserExists = UserExists _EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended _EnvirUserSuspended = UserSuspended
_EnvirCreatedByChannel = CreatedByChannel _EnvirCreatedByChannel = CreatedByChannel
@@ -1244,8 +1242,8 @@ BlockNullPicture:
Select Case Caller Select Case Caller
Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(NameTrue) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True Case NameOf(NameTrue) : _EnvirChanged = True : _ForceSaveUserInfo = True
Case NameOf(ID) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True Case NameOf(ID) : _EnvirChanged = True : _ForceSaveUserInfo = True
Case Else : _EnvirChanged = True Case Else : _EnvirChanged = True
End Select End Select
End If End If
@@ -1552,6 +1550,12 @@ BlockNullPicture:
''' </summary> ''' </summary>
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub End Sub
Protected Sub ReparseMissing_ClearList(ByRef rList As List(Of Integer))
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Sub
#End Region #End Region
#Region "MD5 support" #Region "MD5 support"
Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR" Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
@@ -1843,7 +1847,8 @@ BlockNullPicture:
updateDownCount(False) updateDownCount(False)
v.File = DownloadContentDefault_ConvertWebp(ChangeFileNameByProvider(f, v), postProcessWebp) v.File = ChangeFileNameByProvider(f, v)
v.File = DownloadContentDefault_ConvertWebp(v, postProcessWebp)
v.State = UStates.Downloaded v.State = UStates.Downloaded
DownloadContentDefault_PostProcessing(v, f, Token) DownloadContentDefault_PostProcessing(v, f, Token)
If UseMD5Comparison And (v.Type = UTypes.GIF Or v.Type = UTypes.Picture) Then If UseMD5Comparison And (v.Type = UTypes.GIF Or v.Type = UTypes.Picture) Then
@@ -1943,7 +1948,11 @@ stxt:
End Function End Function
Protected Overridable Sub DownloadContentDefault_PostProcessing(ByRef m As UserMedia, ByVal File As SFile, ByVal Token As CancellationToken) Protected Overridable Sub DownloadContentDefault_PostProcessing(ByRef m As UserMedia, ByVal File As SFile, ByVal Token As CancellationToken)
End Sub End Sub
Protected Overridable Function DownloadContentDefault_ConvertWebp(ByVal WebpFile As SFile, ByVal Process As Boolean) As SFile Protected Overridable Function DownloadContentDefault_ConvertWebp(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
Return DownloadContentDefault_ConvertWebp_Impl(m, Process)
End Function
Protected Overridable Function DownloadContentDefault_ConvertWebp_Impl(ByVal m As UserMedia, ByVal Process As Boolean, Optional ByVal ConvertWebpForce As Boolean = False) As SFile
Dim WebpFile As SFile = m.File
Dim f As SFile = WebpFile Dim f As SFile = WebpFile
If Process AndAlso f.Exists Then If Process AndAlso f.Exists Then
f.Path = $"{f.PathWithSeparator}Sources" f.Path = $"{f.PathWithSeparator}Sources"
@@ -1951,7 +1960,7 @@ stxt:
If WebpFile.Copy(f) Then If WebpFile.Copy(f) Then
Dim newFile As SFile = WebpFile Dim newFile As SFile = WebpFile
newFile.Extension = UserImage.ExtJpg newFile.Extension = UserImage.ExtJpg
f = UserImage.ConvertWebp(f, newFile) f = UserImage.ConvertWebp(f, newFile, ConvertWebpForce)
If f.Exists Then WebpFile.Delete(SFO.File, SFODelete.DeletePermanently, EDP.ReturnValue) If f.Exists Then WebpFile.Delete(SFO.File, SFODelete.DeletePermanently, EDP.ReturnValue)
Else Else
f = WebpFile f = WebpFile
@@ -1959,6 +1968,24 @@ stxt:
End If End If
Return f Return f
End Function End Function
Protected Function DownloadContentDefault_ConvertWebp_TestImg(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
If m.Type = UTypes.Picture And Settings.DownloadNativeImageFormat Then
Using testImg As New UserImage.ImageRenderer2(m.File, EDP.ReturnValue)
If testImg.IsWebP Then
Dim f As SFile = m.File
If f.Extension.IsEmptyString OrElse Not f.Extension = UserImage.ExtWebp Then
f.Extension = UserImage.ExtWebp
f = SFile.Rename(m.File, f,, EDP.ReturnValue).IfNullOrEmpty(m.File)
End If
m.File = f
Return DownloadContentDefault_ConvertWebp_Impl(m, True).IfNullOrEmpty(f)
End If
End Using
ElseIf Process Then
Return DownloadContentDefault_ConvertWebp_Impl(m, Process)
End If
Return m.File
End Function
Protected Overridable Function DownloadContentDefault_ProcessDownloadException() As Boolean Protected Overridable Function DownloadContentDefault_ProcessDownloadException() As Boolean
Return True Return True
End Function End Function

View File

@@ -0,0 +1,46 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.Bluesky
Friend Class EditorExchangeOptions : Inherits Base.EditorExchangeOptionsBase
Friend Overrides Property SiteKey As String = BlueskySiteKey
<PSetting(NameOf(SiteSettings.DownloadModelMedia), NameOf(MySettings), Address:=SettingAddress.User)>
Friend Overridable Property DownloadModelMedia As Boolean = False
<PSetting(NameOf(SiteSettings.DownloadModelProfile), NameOf(MySettings), Address:=SettingAddress.User)>
Friend Overridable Property DownloadModelProfile As Boolean = False
Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
DownloadModelMedia = s.DownloadModelMedia.Value
DownloadModelProfile = s.DownloadModelProfile.Value
MySettings = s
End Sub
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
DownloadModelMedia = u.DownloadModelMedia
DownloadModelProfile = u.DownloadModelProfile
MySettings = u.HOST.Source
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
If Not DownloadModelMedia And Not DownloadModelProfile Then
DownloadModelMedia = True
ElseIf DownloadModelMedia Then
DownloadModelProfile = False
Else
DownloadModelMedia = False
End If
With DirectCast(u, UserData)
.DownloadModelMedia = DownloadModelMedia
.DownloadModelProfile = DownloadModelProfile
End With
End Sub
End Class
End Namespace

View File

@@ -26,6 +26,10 @@ Namespace API.Bluesky
<PXML> Friend ReadOnly Property TokenUpdateTime As PropertyValue <PXML> Friend ReadOnly Property TokenUpdateTime As PropertyValue
<PropertyOption(ControlText:="Token update", ControlToolTip:="Token refresh interval (in minutes)." & vbCr & "Default: 120.", IsAuth:=True), PXML, PClonable, HiddenControl> <PropertyOption(ControlText:="Token update", ControlToolTip:="Token refresh interval (in minutes)." & vbCr & "Default: 120.", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property TokenRefreshInterval As PropertyValue Friend ReadOnly Property TokenRefreshInterval As PropertyValue
<PropertyOption(ControlText:="Download model 'Media'", ControlToolTip:="Parse the 'Media' block", Category:=DeclaredNames.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadModelMedia As PropertyValue
<PropertyOption(ControlText:="Download model 'Profile'", ControlToolTip:="Parse the 'Posts' block", Category:=DeclaredNames.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadModelProfile As PropertyValue
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean) Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Bluesky", "bsky.app", AccName, Temp, My.Resources.SiteResources.BlueskyIcon_32, My.Resources.SiteResources.BlueskyPic_32) MyBase.New("Bluesky", "bsky.app", AccName, Temp, My.Resources.SiteResources.BlueskyIcon_32, My.Resources.SiteResources.BlueskyPic_32)
@@ -38,11 +42,14 @@ Namespace API.Bluesky
TokenUpdateTime = New PropertyValue(Now.AddYears(-1)) TokenUpdateTime = New PropertyValue(Now.AddYears(-1))
TokenRefreshInterval = New PropertyValue(120) TokenRefreshInterval = New PropertyValue(120)
DownloadModelMedia = New PropertyValue(True)
DownloadModelProfile = New PropertyValue(False)
_AllowUserAgentUpdate = False _AllowUserAgentUpdate = False
UrlPatternUser = "https://bsky.app/profile/{0}" UrlPatternUser = "https://bsky.app/profile/{0}"
ImageVideoContains = "bsky.app" ImageVideoContains = "bsky.app"
UserRegex = RParams.DMS("bsky.app/profile/([^/\?]+)", 1, EDP.ReturnValue) UserRegex = RParams.DMS("bsky.app/profile/([^/\?]+)", 1, EDP.ReturnValue)
UserOptionsType = GetType(EditorExchangeOptionsBase) UserOptionsType = GetType(EditorExchangeOptions)
End Sub End Sub
Protected Overrides Function UserOptionsValid(ByVal Options As Object) As Boolean Protected Overrides Function UserOptionsValid(ByVal Options As Object) As Boolean
Return DirectCast(Options, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey Return DirectCast(Options, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey
@@ -96,5 +103,10 @@ Namespace API.Bluesky
_TokenUpdating = False _TokenUpdating = False
End Try End Try
End Function End Function
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If Not e.UserName.IsEmptyString AndAlso e.UserName.StartsWith("did:") Then e.UserName = e.UserName.Replace(":", "@")
Return e
End Function
End Class End Class
End Namespace End Namespace

View File

@@ -16,6 +16,11 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Bluesky Namespace API.Bluesky
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML names"
Private Const Name_DownloadModelMedia As String = "DownloadModelMedia"
Private Const Name_DownloadModelProfile As String = "DownloadModelProfile"
Private Const Name_ForceParseProfileInfo As String = "ForceParseProfileInfo"
#End Region
#Region "Declarations" #Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
@@ -28,16 +33,45 @@ Namespace API.Bluesky
End Get End Get
End Property End Property
Private ReadOnly _TmpPosts2 As List(Of String) Private ReadOnly _TmpPosts2 As List(Of String)
Friend Property DownloadModelMedia As Boolean = True
Friend Property DownloadModelProfile As Boolean = False
Private Property ForceParseProfileInfo As Boolean = False
#End Region #End Region
#Region "Loader" #Region "Loader"
Private Sub UpdateUserOptions()
If ID.IsEmptyString AndAlso Not Name.IsEmptyString AndAlso Name.StartsWith("did@") Then
NameTrue = Name.Replace("@", ":")
ID = NameTrue
ForceParseProfileInfo = True
End If
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
If .Contains(Name_DownloadModelMedia) Then
DownloadModelMedia = .Value(Name_DownloadModelMedia).FromXML(Of Boolean)(True)
DownloadModelProfile = .Value(Name_DownloadModelProfile).FromXML(Of Boolean)(False)
Else
DownloadModelMedia = ParseUserMediaOnly
DownloadModelProfile = Not ParseUserMediaOnly
End If
ForceParseProfileInfo = .Value(Name_ForceParseProfileInfo).FromXML(Of Boolean)(False)
Else
If ID.IsEmptyString Then
UpdateUserOptions()
.Value(Name_UserID) = ID
End If
.Add(Name_DownloadModelMedia, DownloadModelMedia.BoolToInteger)
.Add(Name_DownloadModelProfile, DownloadModelProfile.BoolToInteger)
.Add(Name_ForceParseProfileInfo, ForceParseProfileInfo.BoolToInteger)
End If
End With
End Sub End Sub
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptionsBase(Me) With {.SiteKey = BlueskySiteKey} Return New EditorExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase AndAlso If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then DirectCast(Obj, EditorExchangeOptions).Apply(Me)
DirectCast(Obj, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey Then DirectCast(Obj, EditorExchangeOptionsBase).ApplyBase(Me)
End Sub End Sub
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -66,6 +100,13 @@ Namespace API.Bluesky
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TmpPosts2.Clear() _TmpPosts2.Clear()
Try Try
If Not DownloadModelMedia And Not DownloadModelProfile Then
DownloadModelMedia = True
ElseIf DownloadModelMedia Then
DownloadModelProfile = False
Else
DownloadModelMedia = False
End If
If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear() If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear()
UpdateToken(, True) UpdateToken(, True)
_TokenUpdateCount = 0 _TokenUpdateCount = 0
@@ -79,7 +120,7 @@ Namespace API.Bluesky
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
If Not IsSavedPosts And ID.IsEmptyString Then GetProfileInfo(Token) If (Not IsSavedPosts And ID.IsEmptyString) Or ForceParseProfileInfo Then GetProfileInfo(Token)
If Not IsSavedPosts And ID.IsEmptyString Then Throw New ArgumentNullException("ID", "ID is null") If Not IsSavedPosts And ID.IsEmptyString Then Throw New ArgumentNullException("ID", "ID is null")
If UpdateToken() Then If UpdateToken() Then
Dim nextCursor$ = String.Empty Dim nextCursor$ = String.Empty
@@ -91,7 +132,9 @@ Namespace API.Bluesky
n = {"bookmarks"} n = {"bookmarks"}
p = {"item"} p = {"item"}
Else Else
URL = $"https://bsky.social/xrpc/app.bsky.feed.getAuthorFeed?actor={ID_Encoded}&filter=posts_and_author_threads&includePins=false&limit=99" 'posts_and_author_threads
'posts_with_media
URL = $"https://bsky.social/xrpc/app.bsky.feed.getAuthorFeed?actor={ID_Encoded}&filter={IIf(DownloadModelMedia, "posts_with_media", "posts_and_author_threads")}&includePins=false&limit=99"
If Not Cursor.IsEmptyString Then URL &= $"&cursor={SymbolsConverter.ASCII.EncodeSymbolsOnly(Cursor)}" If Not Cursor.IsEmptyString Then URL &= $"&cursor={SymbolsConverter.ASCII.EncodeSymbolsOnly(Cursor)}"
n = {"feed"} n = {"feed"}
p = {"post"} p = {"post"}
@@ -106,7 +149,7 @@ Namespace API.Bluesky
If .ListExists Then If .ListExists Then
For Each post As EContainer In .Self For Each post As EContainer In .Self
With post(p) With post(p)
c = DefaultParser(.Self,, nextCursor) c = DefaultParser(.Self) ',, nextCursor)
Select Case c Select Case c
Case CInt(DateResult.Skip) * -1 : Continue For Case CInt(DateResult.Skip) * -1 : Continue For
Case CInt(DateResult.Exit) * -1 : Exit Sub Case CInt(DateResult.Exit) * -1 : Exit Sub
@@ -238,6 +281,7 @@ Namespace API.Bluesky
#Region "GetProfileInfo" #Region "GetProfileInfo"
Private Sub GetProfileInfo(ByVal Token As CancellationToken) Private Sub GetProfileInfo(ByVal Token As CancellationToken)
Try Try
If ForceParseProfileInfo Then ForceParseProfileInfo = False : _ForceSaveUserInfo = True
If UpdateToken() Then If UpdateToken() Then
Dim r$ = Responser.GetResponse($"https://bsky.social/xrpc/app.bsky.actor.getProfile?actor={ID.IfNullOrEmpty(NameTrue)}") Dim r$ = Responser.GetResponse($"https://bsky.social/xrpc/app.bsky.actor.getProfile?actor={ID.IfNullOrEmpty(NameTrue)}")
TokenUpdateCountReset() TokenUpdateCountReset()
@@ -344,6 +388,9 @@ Namespace API.Bluesky
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload) Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
Protected Overrides Function DownloadContentDefault_ConvertWebp(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
Return DownloadContentDefault_ConvertWebp_TestImg(m, Process)
End Function
#End Region #End Region
#Region "DownloadSingleObject" #Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken) Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)

View File

@@ -68,14 +68,7 @@ Namespace API.Facebook
Return New UserExchangeOptions(Me) Return New UserExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
With DirectCast(Obj, UserExchangeOptions)
ParsePhotoBlock = .ParsePhotoBlock
ParseVideoBlock = .ParseVideoBlock
ParseReelsBlock = .ParseReelsBlock
ParseStoriesBlock = .ParseStoriesBlock
End With
End If
End Sub End Sub
#End Region #End Region
#Region "Loader" #Region "Loader"

View File

@@ -6,9 +6,10 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.Facebook Namespace API.Facebook
Friend Class UserExchangeOptions Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))>
Friend Property ParsePhotoBlock As Boolean = True Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
@@ -19,6 +20,7 @@ Namespace API.Facebook
Friend Property ParseStoriesBlock As Boolean = True Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
MySettings = u.HostCollection.Default.Source MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock ParseVideoBlock = u.ParseVideoBlock
@@ -26,11 +28,21 @@ Namespace API.Facebook
ParseStoriesBlock = u.ParseStoriesBlock ParseStoriesBlock = u.ParseStoriesBlock
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
MySettings = s MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value ParseVideoBlock = s.ParseVideoBlock.Value
ParseReelsBlock = s.ParseReelsBlock.Value ParseReelsBlock = s.ParseReelsBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value ParseStoriesBlock = s.ParseStoriesBlock.Value
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
With DirectCast(u, UserData)
.ParsePhotoBlock = ParsePhotoBlock
.ParseVideoBlock = ParseVideoBlock
.ParseReelsBlock = ParseReelsBlock
.ParseStoriesBlock = ParseStoriesBlock
End With
End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -20,6 +20,7 @@ Namespace API.Instagram
Friend Const PageTokenRegexPatternDefault As String = "\[\],{""token"":""(.*?)""},\d+\]" Friend Const PageTokenRegexPatternDefault As String = "\[\],{""token"":""(.*?)""},\d+\]"
Friend ReadOnly Regex_UserToken_dtsg As RParams = RParams.DMS("DTSGInitialData["":,.\[\]]*?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue) Friend ReadOnly Regex_UserToken_dtsg As RParams = RParams.DMS("DTSGInitialData["":,.\[\]]*?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_UserToken_lsd As RParams = RParams.DMS("LSD["":,.\[\]]*?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue) Friend ReadOnly Regex_UserToken_lsd As RParams = RParams.DMS("LSD["":,.\[\]]*?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_BlockVersionID As RParams = RParams.DMS("""versioningID"":""([^""]+)""", 1, EDP.ReturnValue)
Friend ReadOnly Regex_ProfileID As RParams = RParams.DMS("profilePage_(\d+)", 1, EDP.ReturnValue) Friend ReadOnly Regex_ProfileID As RParams = RParams.DMS("profilePage_(\d+)", 1, EDP.ReturnValue)
Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser, ByVal UpdateWwwClaim As Boolean) Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser, ByVal UpdateWwwClaim As Boolean)
Const r_wwwClaimName$ = "x-ig-set-www-claim" Const r_wwwClaimName$ = "x-ig-set-www-claim"

View File

@@ -70,7 +70,7 @@ Namespace API.Instagram
Friend Const Header_Browser As String = "Sec-Ch-Ua" Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List" Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform_Verion As String = "Sec-Ch-Ua-Platform-Version" Friend Const Header_Platform_Verion As String = "Sec-Ch-Ua-Platform-Version"
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Can be automatically extracted from cookies", IsAuth:=True, AllowNull:=True), PClonable(Clone:=False)> <PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Can be automatically extracted from cookies", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
<CookieValueExtractor(NameOf(HH_CSRF_TOKEN))> <CookieValueExtractor(NameOf(HH_CSRF_TOKEN))>
Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String
@@ -78,7 +78,7 @@ Namespace API.Instagram
End Function End Function
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)> <PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_IG_APP_ID As PropertyValue Friend ReadOnly Property HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=True), PClonable(Clone:=False)> <PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_ASBD_ID As PropertyValue Friend ReadOnly Property HH_ASBD_ID As PropertyValue
'PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True) 'PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True)
<PClonable(Clone:=False)> <PClonable(Clone:=False)>
@@ -89,16 +89,16 @@ Namespace API.Instagram
Return Not v.IsEmptyString AndAlso v = "0" Return Not v.IsEmptyString AndAlso v = "0"
End Get End Get
End Property End Property
<PropertyOption(ControlText:="sec-ch-ua", IsAuth:=True, AllowNull:=True, <PropertyOption(ControlText:="sec-ch-ua", IsAuth:=True, AllowNull:=False,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), PClonable, PXML(OnlyForChecked:=True)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", IsAuth:=True, AllowNull:=True, <PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", IsAuth:=True, AllowNull:=False,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list), PClonable, PXML(OnlyForChecked:=True)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER_EXT As PropertyValue Private ReadOnly Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, AllowNull:=True, LeftOffset:=135, <PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, AllowNull:=False, LeftOffset:=135,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version), PClonable, PXML(OnlyForChecked:=True)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_PLATFORM As PropertyValue Private ReadOnly Property HH_PLATFORM As PropertyValue
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True, <PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=False,
InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), PClonable, PXML(OnlyForChecked:=True)> InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_USER_AGENT As PropertyValue Private ReadOnly Property HH_USER_AGENT As PropertyValue
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
@@ -146,10 +146,12 @@ Namespace API.Instagram
<Provider(NameOf(HH_IG_WWW_CLAIM_UPDATE_INTERVAL), FieldsChecker:=True)> <Provider(NameOf(HH_IG_WWW_CLAIM_UPDATE_INTERVAL), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region #End Region
<PropertyOption(ControlText:="Use GraphQL to download", IsAuth:=True), PXML, PClonable> <PropertyOption(ControlText:="Use GraphQL to download", ControlToolTip:="This feature is in test mode", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property USE_GQL As PropertyValue Friend ReadOnly Property USE_GQL As PropertyValue
<PropertyOption(ControlText:="Use GraphQL to download user data", IsAuth:=True), PXML, PClonable, HiddenControl> <PropertyOption(ControlText:="Use GraphQL to download user data", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property USE_GQL_UserData As PropertyValue Friend ReadOnly Property USE_GQL_UserData As PropertyValue
<PropertyOption(ControlText:="Use GraphQL to download user stories (highlights)", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property USE_GQL_Highlights As PropertyValue
#End Region #End Region
#Region "Download data" #Region "Download data"
<PropertyOption(ControlText:="Download timeline", Category:=CAT_DOWN), PXML, PClonable> <PropertyOption(ControlText:="Download timeline", Category:=CAT_DOWN), PXML, PClonable>
@@ -496,6 +498,7 @@ Namespace API.Instagram
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
USE_GQL = New PropertyValue(False) USE_GQL = New PropertyValue(False)
USE_GQL_UserData = New PropertyValue(True) USE_GQL_UserData = New PropertyValue(True)
USE_GQL_Highlights = New PropertyValue(True)
DownloadTimeline = New PropertyValue(True) DownloadTimeline = New PropertyValue(True)
DownloadTimeline_Def = New PropertyValue(DownloadTimeline.Value, GetType(Boolean)) DownloadTimeline_Def = New PropertyValue(DownloadTimeline.Value, GetType(Boolean))

View File

@@ -27,17 +27,21 @@ Namespace API.Instagram
Token_dtsg = String.Empty Token_dtsg = String.Empty
Token_lsd = String.Empty Token_lsd = String.Empty
End Sub End Sub
Protected Property BlockVersionID As String = String.Empty
#End Region #End Region
#Region "Headers" #Region "Headers"
Friend Const GQL_HEADER_FB_FRINDLY_NAME As String = "x-fb-friendly-name" Friend Const GQL_HEADER_FB_FRINDLY_NAME As String = "x-fb-friendly-name"
Friend Const GQL_HEADER_FB_LSD As String = "x-fb-lsd" Friend Const GQL_HEADER_FB_LSD As String = "x-fb-lsd"
Friend Const GQL_HEADER_BLOCK_VERSION_ID As String = "x-bloks-version-id"
Friend Const GQL_HEADER_ROOT_FIELD_NAME As String = "x-root-field-name"
Friend Const GQL_HEADER_ROOT_FIELD_NAME_Value As String = "fetch__XDTUserDict"
#End Region #End Region
#Region "Data constants" #Region "Data constants"
Private Const GQL_UserData_DocId As String = "7381344031985950" Private Const GQL_UserData_DocId As String = "26672929172408668" '"35710877621861450" '"7381344031985950"
Private Const GQL_UserData_FbFriendlyName As String = "PolarisProfilePageContentQuery" Private Const GQL_UserData_FbFriendlyName As String = "PolarisProfilePageContentQuery"
Private Const GQL_Highlights_DocId As String = "8298007123561120" Private Const GQL_Highlights_DocId As String = "36997000523232338" '"8298007123561120"
Private Const GQL_Highlights_DocId_Second As String = "7559771384111300" Private Const GQL_Highlights_DocId_Second As String = "27618287167780519" '"7559771384111300"
Private Const GQL_Highlights_FbFriendlyName As String = "PolarisProfileStoryHighlightsTrayContentQuery" Private Const GQL_Highlights_FbFriendlyName As String = "PolarisProfileStoryHighlightsTrayContentQuery"
Private Const GQL_Highlights_FbFriendlyName_Second As String = "PolarisStoriesV3HighlightsPageQuery" Private Const GQL_Highlights_FbFriendlyName_Second As String = "PolarisStoriesV3HighlightsPageQuery"
@@ -61,18 +65,32 @@ Namespace API.Instagram
Private Const GQL_URL_Q As String = "https://www.instagram.com/graphql/query" Private Const GQL_URL_Q As String = "https://www.instagram.com/graphql/query"
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Protected Sub UpdateHeadersGQL(ByVal HeaderValue As String) Protected Sub UpdateHeadersGQL(ByVal HeaderValue As String, Optional ByVal Add As Boolean = True)
Responser.Headers.Add(GQL_HEADER_FB_FRINDLY_NAME, HeaderValue) With Responser.Headers
Responser.Headers.Add(GQL_HEADER_FB_LSD, Token_lsd) If Add Then
.Add(GQL_HEADER_FB_FRINDLY_NAME, HeaderValue)
.Add(GQL_HEADER_FB_LSD, Token_lsd)
'.Add(GQL_HEADER_BLOCK_VERSION_ID, BlockVersionID)
'.Add(GQL_HEADER_ROOT_FIELD_NAME, GQL_HEADER_ROOT_FIELD_NAME_Value)
Else
.Remove(GQL_HEADER_FB_FRINDLY_NAME)
.Remove(GQL_HEADER_FB_LSD)
'.Remove(GQL_HEADER_BLOCK_VERSION_ID)
'.Remove(GQL_HEADER_ROOT_FIELD_NAME)
End If
End With
End Sub End Sub
'<Obsolete("Use 'GET' function: 'GetUserData'", False)> '<Obsolete("Use 'GET' function: 'GetUserData'", False)>
Private Function GetUserDataGQL(ByVal Token As CancellationToken) As String Private Function GetUserDataGQL(ByVal Token As CancellationToken) As String
UpdateTokens(Not ValidateBaseTokens())
'Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserData_DocId, Token_lsd, Token_dtsg_Var, GQL_UserData_FbFriendlyName,
' SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""id"":""{ID}"",""relay_header"":false,""render_surface"":""PROFILE""" & "}"))
Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserData_DocId, Token_lsd, Token_dtsg_Var, GQL_UserData_FbFriendlyName, Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserData_DocId, Token_lsd, Token_dtsg_Var, GQL_UserData_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""id"":""{ID}"",""relay_header"":false,""render_surface"":""PROFILE""" & "}")) SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""enable_integrity_filters"":true,""id"":""{ID}"",""__relay_internal__pv__PolarisCannesGuardianExperienceEnabledrelayprovider"":true,""__relay_internal__pv__PolarisCASB976ProfileEnabledrelayprovider"":false,""__relay_internal__pv__PolarisWebSchoolsEnabledrelayprovider"":false,""__relay_internal__pv__PolarisRepostsConsumptionEnabledrelayprovider"":true" & "}"))
UpdateRequestNumber() UpdateRequestNumber()
ChangeResponserMode(True) ChangeResponserMode(True)
UpdateHeadersGQL(GQL_UserData_FbFriendlyName) UpdateHeadersGQL(GQL_UserData_FbFriendlyName)
Dim r$ = Responser.GetResponse(GQL_URL, vars) Dim r$ = Responser.GetResponse(GQL_URL_Q, vars)
Return r Return r
'If Not r.IsEmptyString Then 'If Not r.IsEmptyString Then
' Using j As EContainer = JsonDocument.Parse(r) ' Using j As EContainer = JsonDocument.Parse(r)
@@ -104,6 +122,7 @@ Namespace API.Instagram
Dim vars$ Dim vars$
ThrowAny(Token) ThrowAny(Token)
UpdateTokens(Not ValidateBaseTokens())
UpdateRequestNumber() UpdateRequestNumber()
ChangeResponserMode(True) ChangeResponserMode(True)
@@ -153,7 +172,7 @@ Namespace API.Instagram
Return If(hasNextPage And (Not nextCursor.IsEmptyString AndAlso Not nextCursor.StringToLower = none_cursor), nextCursor, String.Empty) Return If(hasNextPage And (Not nextCursor.IsEmptyString AndAlso Not nextCursor.StringToLower = none_cursor), nextCursor, String.Empty)
End Function End Function
Private Function GetHighlightsGQL_List() As List(Of String) Private Function GetHighlightsGQL_List() As List(Of String)
UpdateTokens(Not ValidateBaseTokens())
Dim nextCursor$ = String.Empty Dim nextCursor$ = String.Empty
Dim hasNextPage As Boolean = False Dim hasNextPage As Boolean = False
Dim i% = -1 Dim i% = -1
@@ -189,7 +208,7 @@ Namespace API.Instagram
Return hList Return hList
End Function End Function
Private Sub GetHighlightsGQL(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken) Private Sub GetHighlightsGQL(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
Const highlightData$ = """first"":50,""initial_reel_id"":""{0}"",""last"":2,""reel_ids"":[{1}]" Const highlightData$ = """initial_reel_id"":""{0}"",""reel_ids"":[{1}],""first"":50,""last"":2,""__relay_internal__pv__PolarisCommunityNoteStoriesLabelEnabledrelayprovider"":true"
Dim tmpList As New List(Of String) Dim tmpList As New List(Of String)
Dim i% = -1 Dim i% = -1
If StoriesList.ListExists Then If StoriesList.ListExists Then
@@ -197,6 +216,7 @@ Namespace API.Instagram
'tmpList.AddRange(StoriesList.Take(10)) 'tmpList.AddRange(StoriesList.Take(10))
tmpList.AddRange(StoriesList.Take(5)) tmpList.AddRange(StoriesList.Take(5))
StoriesList.RemoveRange(0, tmpList.Count) StoriesList.RemoveRange(0, tmpList.Count)
UpdateTokens(Not ValidateBaseTokens())
Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_Highlights_DocId_Second, Token_lsd, Token_dtsg_Var, GQL_Highlights_FbFriendlyName_Second, Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_Highlights_DocId_Second, Token_lsd, Token_dtsg_Var, GQL_Highlights_FbFriendlyName_Second,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(highlightData, tmpList(0), tmpList.Select(Function(hl) $"""{hl}""").ListToString(",")) & "}")) SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(highlightData, tmpList(0), tmpList.Select(Function(hl) $"""{hl}""").ListToString(",")) & "}"))
@@ -223,6 +243,7 @@ Namespace API.Instagram
tmpList.Clear() tmpList.Clear()
End Sub End Sub
Private Sub GetUserStoriesGQL(ByVal Token As CancellationToken) Private Sub GetUserStoriesGQL(ByVal Token As CancellationToken)
UpdateTokens(Not ValidateBaseTokens())
'"{" & $"""user_id"":""{ID}""" & "}" '"{" & $"""user_id"":""{ID}""" & "}"
Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserStories_DocId, Token_lsd, Token_dtsg_Var, GQL_UserStories_FbFriendlyName, Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserStories_DocId, Token_lsd, Token_dtsg_Var, GQL_UserStories_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""reel_ids_arr"":[""{ID}""]" & "}")) SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""reel_ids_arr"":[""{ID}""]" & "}"))
@@ -255,7 +276,7 @@ Namespace API.Instagram
Private Function GetReelsGQL(ByVal Cursor As String) As String Private Function GetReelsGQL(ByVal Cursor As String) As String
GetReelsGQL_SetEnvir = True GetReelsGQL_SetEnvir = True
UpdateTokens(Cursor.IsEmptyString) UpdateTokens(Cursor.IsEmptyString Or Not ValidateBaseTokens())
Dim vars$ = """data"":{""include_feed_video"":true,""page_size"":" & PostNumberPerRequest & ",""target_user_id"":""" & ID & """}" Dim vars$ = """data"":{""include_feed_video"":true,""page_size"":" & PostNumberPerRequest & ",""target_user_id"":""" & ID & """}"
If Not Cursor.IsEmptyString Then vars = $"""after"":""{Cursor}"",""before"":null,{vars},""first"":4,""last"":null" If Not Cursor.IsEmptyString Then vars = $"""after"":""{Cursor}"",""before"":null,{vars},""first"":4,""last"":null"
@@ -268,6 +289,7 @@ Namespace API.Instagram
End Function End Function
''' <summary>Response</summary> ''' <summary>Response</summary>
Private Function GetTaggedGQL(ByVal Cursor As String) As String Private Function GetTaggedGQL(ByVal Cursor As String) As String
UpdateTokens(Not ValidateBaseTokens())
'default count = 12 'default count = 12
'max count = 21 'max count = 21
Dim vars$ Dim vars$
@@ -318,7 +340,12 @@ Namespace API.Instagram
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate")) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
End With End With
End With End With
Dim r$ = Responser.GetResponse(MySiteSettings.GetUserUrl(Me)) Dim r$
If UserNameRequested Then
r = Responser.GetResponse("https://www.instagram.com/")
Else
r = Responser.GetResponse(MySiteSettings.GetUserUrl(Me))
End If
ParseTokens(r, 0) ParseTokens(r, 0)
Catch ex As Exception Catch ex As Exception
Finally Finally
@@ -344,6 +371,7 @@ Namespace API.Instagram
.MatchSub = 1 .MatchSub = 1
.WhatGet = RegexReturn.Value .WhatGet = RegexReturn.Value
End With End With
BlockVersionID = RegexReplace(r, Regex_BlockVersionID)
For Each tt In tokens For Each tt In tokens
If Not Token_lsd.IsEmptyString And Not Token_dtsg.IsEmptyString Then If Not Token_lsd.IsEmptyString And Not Token_dtsg.IsEmptyString Then
Exit For Exit For
@@ -362,6 +390,7 @@ Namespace API.Instagram
Case 1 Case 1
Token_dtsg = RegexReplace(r, Regex_UserToken_dtsg) Token_dtsg = RegexReplace(r, Regex_UserToken_dtsg)
Token_lsd = RegexReplace(r, Regex_UserToken_lsd) Token_lsd = RegexReplace(r, Regex_UserToken_lsd)
BlockVersionID = RegexReplace(r, Regex_BlockVersionID)
End Select End Select
If Not ValidateBaseTokens() And Attempt = 0 Then ParseTokens(r, Attempt + 1) If Not ValidateBaseTokens() And Attempt = 0 Then ParseTokens(r, Attempt + 1)
End If End If

View File

@@ -177,7 +177,7 @@ Namespace API.Instagram
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions) With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me) .Apply(Me)
GetTimeline = .GetTimeline GetTimeline = .GetTimeline
GetReels = .GetReels GetReels = .GetReels
GetStories = .GetStories GetStories = .GetStories
@@ -333,6 +333,7 @@ Namespace API.Instagram
Private _LastWwwClaim As String = String.Empty Private _LastWwwClaim As String = String.Empty
Private _ResponserGQLMode As Boolean = False Private _ResponserGQLMode As Boolean = False
Private _UseGQL As Boolean = False Private _UseGQL As Boolean = False
Private Const ImgHeic$ = "heic"
Private Sub ChangeResponserMode(ByVal GQL As Boolean, Optional ByVal Force As Boolean = False) Private Sub ChangeResponserMode(ByVal GQL As Boolean, Optional ByVal Force As Boolean = False)
If Not _ResponserGQLMode = GQL Or Force Then If Not _ResponserGQLMode = GQL Or Force Then
_ResponserGQLMode = GQL _ResponserGQLMode = GQL
@@ -362,8 +363,7 @@ Namespace API.Instagram
With .Headers With .Headers
.Remove("origin") .Remove("origin")
.Remove("authority") .Remove("authority")
.Remove(GQL_HEADER_FB_FRINDLY_NAME) UpdateHeadersGQL(String.Empty, False)
.Remove(GQL_HEADER_FB_LSD)
Dim hv$ = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest)).IfNullOrEmpty("empty") Dim hv$ = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest)).IfNullOrEmpty("empty")
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, hv)) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, hv))
hv = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode)).IfNullOrEmpty("cors") hv = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode)).IfNullOrEmpty("cors")
@@ -507,26 +507,26 @@ Namespace API.Instagram
If Not errorFound Then LoadSavePostsKV(False) If Not errorFound Then LoadSavePostsKV(False)
End Try End Try
End Sub End Sub
'TODELETE: ValidateExtension
Protected Sub ValidateExtension() Protected Sub ValidateExtension()
Dim tmpList As List(Of UserMedia) = Nothing 'Dim tmpList As List(Of UserMedia) = Nothing
Try 'Try
Const heic$ = "heic" ' If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = ImgHeic) Then
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then ' Dim m As UserMedia
Dim m As UserMedia ' tmpList = New List(Of UserMedia)
tmpList = New List(Of UserMedia) ' tmpList.ListAddList(_TempMediaList)
tmpList.ListAddList(_TempMediaList) ' _TempMediaList.Clear()
_TempMediaList.Clear() ' For i% = 0 To tmpList.Count - 1
For i% = 0 To tmpList.Count - 1 ' m = tmpList(i)
m = tmpList(i) ' _TempMediaList.Add(m)
_TempMediaList.Add(m) ' If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = ImgHeic Then _
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _ ' m.File.Extension = "jpg" : _TempMediaList.Add(m)
m.File.Extension = "jpg" : _TempMediaList.Add(m) ' Next
Next ' tmpList.Clear()
tmpList.Clear() ' End If
End If 'Catch ex As Exception
Catch ex As Exception ' If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear()
If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear() 'End Try
End Try
End Sub End Sub
Protected Overridable Sub UpdateResponser() Protected Overridable Sub UpdateResponser()
Try Try
@@ -702,8 +702,8 @@ Namespace API.Instagram
If Not IsSavedPosts Then If Not IsSavedPosts Then
If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then UpdateTokens(True) If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then UpdateTokens(True)
If ID.IsEmptyString Or __idIsEmpty Or Not IsVerifiedProfile_Checked Then GetUserData(Token) If ID.IsEmptyString Or __idIsEmpty Or Not IsVerifiedProfile_Checked Then GetUserData(Token)
If ID.IsEmptyString Then UserExists = False : _ForceSaveUserInfoOnException = True : Throw New Plugin.ExitException("can't get user ID") If ID.IsEmptyString Then UserExists = False : _ForceSaveUserInfo = True : Throw New Plugin.ExitException("can't get user ID")
If ForceUpdateUserName Then GetUserNameById() If ForceUpdateUserName Then GetUserNameById(Token)
If ForceUpdateUserInfo Then GetUserData(Token) If ForceUpdateUserInfo Then GetUserData(Token)
End If End If
@@ -1276,6 +1276,7 @@ NextPageBlock:
With j({"data", "user"}) With j({"data", "user"})
If Not ____dataGql Or ID.IsEmptyString Then ID = .Value("id") If Not ____dataGql Or ID.IsEmptyString Then ID = .Value("id")
__idFound = True __idFound = True
If Not .Value("username").IsEmptyString Then NameTrue = .Value("username")
UserSiteNameUpdate(.Value("full_name")) UserSiteNameUpdate(.Value("full_name"))
IsVerifiedProfile = .Value("is_verified").FromXML(Of Boolean)(False) IsVerifiedProfile = .Value("is_verified").FromXML(Of Boolean)(False)
IsVerifiedProfile_Checked = True IsVerifiedProfile_Checked = True
@@ -1308,9 +1309,17 @@ NextPageBlock:
ChangeResponserMode(_UseGQL) ChangeResponserMode(_UseGQL)
End Try End Try
End Sub End Sub
Private Function GetUserNameById() As Boolean Private Function GetUserNameById(ByVal Token As CancellationToken) As Boolean
UserNameRequested = True UserNameRequested = True
If ForceUpdateUserName Then ForceUpdateUserName = False : _ForceSaveUserInfo = True If ForceUpdateUserName Then ForceUpdateUserName = False : _ForceSaveUserInfo = True
If Not ID.IsEmptyString Then
Dim currentName$ = NameTrue
GetUserData(Token)
If Not currentName = NameTrue Then UserNameRequested = False : Return True
End If
Return False
Try Try
If Not ID.IsEmptyString Then If Not ID.IsEmptyString Then
UpdateRequestNumber() UpdateRequestNumber()
@@ -1344,6 +1353,7 @@ NextPageBlock:
#Region "Pinned stories" #Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal GetUserStory As Boolean, ByVal Token As CancellationToken) Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal GetUserStory As Boolean, ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}" Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
Const hPattern$ = "highlight:"
Dim tmpList As IEnumerable(Of String) = Nothing Dim tmpList As IEnumerable(Of String) = Nothing
Dim qStr$, r$ Dim qStr$, r$
Dim i% = -1 Dim i% = -1
@@ -1356,7 +1366,7 @@ NextPageBlock:
If GetUserStory Then If GetUserStory Then
qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}" qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}"
Else Else
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&")) qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids={hPattern}{q.Replace(hPattern, String.Empty)}").ListToString("&"))
End If End If
UpdateRequestNumber() UpdateRequestNumber()
r = Responser.GetResponse(qStr,, EDP.ThrowException) r = Responser.GetResponse(qStr,, EDP.ThrowException)
@@ -1405,21 +1415,34 @@ NextPageBlock:
End If End If
End Sub End Sub
Private Function GetStoriesList() As List(Of String) Private Function GetStoriesList() As List(Of String)
UpdateRequestNumber() If CBool(MySiteSettings.USE_GQL_Highlights.Value) Then
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException) Dim hList As List(Of String) = GetHighlightsGQL_List()
If Not r.IsEmptyString Then If Not _UseGQL Then ChangeResponserMode(_UseGQL)
Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")} Return hList
Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing Else
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing UpdateRequestNumber()
End Using Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")}
Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing
End Using
End If
Return Nothing
End If End If
Return Nothing
End Function End Function
#End Region #End Region
#Region "Download content" #Region "Download content"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Protected Overrides Function DownloadContentDefault_ConvertWebp(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = ImgHeic Then
Return DownloadContentDefault_ConvertWebp_Impl(m, True, True)
Else
Return MyBase.DownloadContentDefault_ConvertWebp(m, Process)
End If
End Function
#End Region #End Region
#Region "Erase" #Region "Erase"
Protected Overrides Sub EraseData_AdditionalDataFiles() Protected Overrides Sub EraseData_AdditionalDataFiles()
@@ -1442,7 +1465,7 @@ NextPageBlock:
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal s As Object = Nothing) As Integer Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then '404 If Responser.StatusCode = HttpStatusCode.NotFound Then '404
If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False If Not UserNameRequested AndAlso GetUserNameById(New CancellationToken) Then Return 1 Else UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Or Responser.StatusCode = HttpStatusCode.Unauthorized Then '400, 401 ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Or Responser.StatusCode = HttpStatusCode.Unauthorized Then '400, 401
HasError = True HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"

View File

@@ -17,5 +17,23 @@ Namespace API.OnlyFans
{{"files", "full", "url"}} {{"files", "full", "url"}}
} }
Friend Property Rules As DynamicRulesEnv Friend Property Rules As DynamicRulesEnv
Friend Class CookieDateProvider : Implements ICustomProvider
Private ReadOnly DefaultProvider As IFormatProvider
Friend Sub New()
DefaultProvider = PersonalUtilities.Tools.Web.Cookies.CookieKeeper.DateProviderDefault
End Sub
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If Not IsNothing(Value) AndAlso TypeOf Value Is String AndAlso Not CStr(Value).IsEmptyString Then
Dim v$ = Value
If v.Contains(",_") Then v = v.Substring(0, v.IndexOf(",_"))
Value = v
End If
Return AConvert(Of Date)(Value, DefaultProvider, Nothing)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("'GetFormat' is not available in the 'CookieDateProvider'")
End Function
End Class
End Module End Module
End Namespace End Namespace

View File

@@ -253,6 +253,7 @@ Namespace API.OnlyFans
.CookiesUpdateMode = CookieKeeper.UpdateModes.Disabled .CookiesUpdateMode = CookieKeeper.UpdateModes.Disabled
.Cookies.ChangedAllowInternalDrop = False .Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False .Cookies.Changed = False
.Cookies.DateProvider = New CookieDateProvider
With .Headers With .Headers
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform)) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile)) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile))

View File

@@ -66,7 +66,7 @@ Namespace API.OnlyFans
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions) With DirectCast(Obj, UserExchangeOptions)
.ApplyBase(Me) .Apply(Me)
MediaDownloadTimeline = .DownloadTimeline MediaDownloadTimeline = .DownloadTimeline
MediaDownloadStories = .DownloadStories MediaDownloadStories = .DownloadStories
MediaDownloadHighlights = .DownloadHighlights MediaDownloadHighlights = .DownloadHighlights

View File

@@ -6,15 +6,21 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.Pinterest Namespace API.Pinterest
Friend Class EditorExchangeOptions Friend Class EditorExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(Caption:="Get Sub-Boards", ToolTip:="Extract the Sub-Boards from the boards and download them")> <PSetting(Caption:="Get Sub-Boards", ToolTip:="Extract the Sub-Boards from the boards and download them")>
Friend Property ExtractSubBoards As Boolean = True Friend Property ExtractSubBoards As Boolean = True
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
ExtractSubBoards = u.ExtractSubBoards ExtractSubBoards = u.ExtractSubBoards
End Sub End Sub
Friend Sub New() Friend Sub New()
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
DirectCast(u, UserData).ExtractSubBoards = ExtractSubBoards
End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -97,7 +97,7 @@ Namespace API.Pinterest
Return New EditorExchangeOptions(Me) Return New EditorExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then ExtractSubBoards = DirectCast(Obj, EditorExchangeOptions).ExtractSubBoards If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then DirectCast(Obj, EditorExchangeOptions).Apply(Me)
End Sub End Sub
#End Region #End Region
#Region "Download overrides" #Region "Download overrides"

View File

@@ -24,7 +24,12 @@ Namespace API.PornHub
0, RegexOptions.Singleline, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter) 0, RegexOptions.Singleline, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Friend ReadOnly RegexVideo_Video_VideoKey As RParams = RParams.DMS("viewkey=([\w\d]+)", 1, EDP.ReturnValue) Friend ReadOnly RegexVideo_Video_VideoKey As RParams = RParams.DMS("viewkey=([\w\d]+)", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue) Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle2 As RParams = RParams.DMS("\<title\>([^\<]+)\</title>", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle3 As RParams = RParams.DMS("videoTitle...([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle_NoTitle As RParams = RParams.DMS("(?<=(\=|/))([\w\d]+)(?=(\?|\&|\Z))", 2, EDP.ReturnValue)
Friend ReadOnly RegexDataToken As RParams = RParams.DMS("data-token=""([^""]+)", 1, EDP.ReturnValue) Friend ReadOnly RegexDataToken As RParams = RParams.DMS("data-token=""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoAdditImg As RParams = RParams.DMS("twitter.image..content=""([^""]+)""", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoAdditImg2 As RParams = RParams.DMS("thumbnailUrl""[^""]*?""([^""]+)""", 1, EDP.ReturnValue)
#End Region #End Region
#Region "Declarations M3U8" #Region "Declarations M3U8"
Friend ReadOnly Regex_M3U8_FilesList As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]*?(.+?m3u8.*)", 0, RegexReturn.List, EDP.ReturnValue) Friend ReadOnly Regex_M3U8_FilesList As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]*?(.+?m3u8.*)", 0, RegexReturn.List, EDP.ReturnValue)

View File

@@ -22,7 +22,7 @@ Namespace API.PornHub
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_FilesList}, {1, 2}, EDP.ReturnValue) Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_FilesList}, {1, 2}, EDP.ReturnValue)
Dim file$ Dim file$
If files.ListExists Then files.RemoveAll(Function(f) f.Value = 0 Or (Not DownloadUHD And f.Value > 1080)) If files.ListExists Then files.RemoveAll(Function(f) f.Value = 0 Or (Not DownloadUHD And f.Value > 1080) Or (f.Data.IsEmptyString OrElse f.Data.Contains("""")))
If files.ListExists Then If files.ListExists Then
files.Sort() files.Sort()
file = files(0).Data file = files(0).Data

View File

@@ -6,13 +6,14 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Security.Policy
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.PornHub Namespace API.PornHub
Friend Class UserData : Inherits UserDataBase : Implements IPSite Friend Class UserData : Inherits UserDataBase : Implements IPSite
@@ -96,6 +97,9 @@ Namespace API.PornHub
Return Me Return Me
End Function End Function
End Structure End Structure
Private Structure PHObj : Implements IThumbList
Friend Property Thumbs As List(Of String) Implements IThumbList.Thumbs
End Structure
#End Region #End Region
#Region "Enums" #Region "Enums"
Private Enum VideoTypes Private Enum VideoTypes
@@ -258,7 +262,6 @@ Namespace API.PornHub
Private _PageVideosRepeat As Integer = 0 Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
UpdateM3U8URLS = False
PlaylistToken = String.Empty PlaylistToken = String.Empty
Responser.ResetStatus() Responser.ResetStatus()
_PageVideosRepeat = 0 _PageVideosRepeat = 0
@@ -648,6 +651,21 @@ Namespace API.PornHub
#End Region #End Region
#End Region #End Region
#Region "ReparseVideo" #Region "ReparseVideo"
Private Function GetVideoTitle(ByVal r As String, ByVal URL As String) As String
Dim tmpName$ = String.Empty
Dim rr As RParams
For i As Byte = 0 To 3
Select Case i
Case 0 : rr = RegexVideoPageTitle
Case 1 : rr = RegexVideoPageTitle2
Case 2 : rr = RegexVideoPageTitle3
Case Else : rr = RegexVideoPageTitle_NoTitle
End Select
tmpName = RegexReplace(IIf(i = 3, URL, r), rr)
If Not tmpName.IsEmptyString Then Exit For
Next
Return tmpName
End Function
Protected Overloads Overrides Sub ReparseVideo(ByVal Token As CancellationToken) Protected Overloads Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then If IsSubscription Then
ReparseVideoSubscriptions(Token) ReparseVideoSubscriptions(Token)
@@ -663,6 +681,7 @@ Namespace API.PornHub
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia Dim m As UserMedia
Dim r$, NewUrl$, tmpName$ Dim r$, NewUrl$, tmpName$
Dim isCurl%
ProgressPre.ChangeMax(_TempMediaList.Count) ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform() ProgressPre.Perform()
@@ -671,27 +690,30 @@ Namespace API.PornHub
ThrowAny(Token) ThrowAny(Token)
Try Try
URL = m.URL URL = m.URL
r = Responser.Curl(URL) For isCurl = 1 To 0 Step -1
If Not r.IsEmptyString Then If CBool(isCurl) Then r = Responser.Curl(URL) Else r = Responser.GetResponse(URL)
NewUrl = CreateVideoURL(r) If Not r.IsEmptyString Then
If NewUrl.IsEmptyString Then NewUrl = CreateVideoURL(r)
Throw New Exception With {.HelpLink = ERR_NEW_URL} If NewUrl.IsEmptyString Then
Else Throw New Exception With {.HelpLink = ERR_NEW_URL}
m.URL = NewUrl Else
m.Type = UTypes.m3u8 m.URL = NewUrl
If CreateFileName Then m.Type = UTypes.m3u8
tmpName = RegexReplace(r, RegexVideoPageTitle) If CreateFileName Then
If Not tmpName.IsEmptyString Then tmpName = GetVideoTitle(r, URL)
If Not Data Is Nothing Then Data.Title = tmpName If Not tmpName.IsEmptyString Then
m.File.Name = TitleHtmlConverter(tmpName) If Not Data Is Nothing Then Data.Title = tmpName
m.File.Extension = "mp4" m.File.Name = TitleHtmlConverter(tmpName)
m.File.Extension = "mp4"
End If
End If End If
_TempMediaList(i) = m
End If End If
_TempMediaList(i) = m Exit For
ElseIf Not CBool(isCurl) Then
_TempMediaList.RemoveAt(i)
End If End If
Else Next
_TempMediaList.RemoveAt(i)
End If
Catch mid_ex As Exception Catch mid_ex As Exception
If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then
m.State = UserMedia.States.Missing m.State = UserMedia.States.Missing
@@ -713,6 +735,10 @@ Namespace API.PornHub
Dim m As UserMedia Dim m As UserMedia
Dim r$, URL$, tmpName$, thumb$ Dim r$, URL$, tmpName$, thumb$
Dim c% = 0 Dim c% = 0
Dim thumbObj As PHObj
Dim thumbAdded As Boolean
Dim rp As RParams
Dim rpa() As RParams = {RegexVideoAdditImg, RegexVideoAdditImg2}
Dim rErr As New ErrorsDescriber(EDP.ReturnValue) Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
Progress.Maximum += _TempMediaList.Count Progress.Maximum += _TempMediaList.Count
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
@@ -727,10 +753,24 @@ Namespace API.PornHub
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
m.Type = UTypes.m3u8 m.Type = UTypes.m3u8
thumbObj = New PHObj With {.Thumbs = New List(Of String)}
thumbAdded = False
thumb = RegexReplace(r, Regex_VideosThumb_OG_IMAGE) thumb = RegexReplace(r, Regex_VideosThumb_OG_IMAGE)
If Not thumb.IsEmptyString Then m.URL = thumb If Not thumb.IsEmptyString Then m.URL = thumb : thumbAdded = True
For Each rp In rpa
thumb = RegexReplace(r, rp)
If Not thumb.IsEmptyString Then
If Not thumbAdded Then
m.URL = thumb
thumbAdded = True
Else
thumbObj.Thumbs.Add(thumb)
End If
End If
Next
If thumbObj.Thumbs.Count > 0 Then m.Object = thumbObj
tmpName = RegexReplace(r, RegexVideoPageTitle) tmpName = GetVideoTitle(r, URL)
If Not tmpName.IsEmptyString Then If Not tmpName.IsEmptyString Then
m.File.Name = TitleHtmlConverter(tmpName) m.File.Name = TitleHtmlConverter(tmpName)
m.File.Extension = "mp4" m.File.Extension = "mp4"
@@ -785,39 +825,34 @@ Namespace API.PornHub
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error") ProcessException(ex, Token, "missing data downloading error")
Finally Finally
If rList.Count > 0 Then ReparseMissing_ClearList(rList)
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Download content" #Region "Download content"
Private UpdateM3U8URLS As Boolean = False
Private UpdateM3U8URLS_Error As Boolean = False
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Try : DownloadContentDefault(Token) : Finally : UpdateM3U8URLS = False : End Try DownloadContentDefault(Token)
End Sub End Sub
Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile ByVal Token As CancellationToken) As SFile
UpdateM3U8URLS_Error = False Return DownloadM3U8(URL, Media, DestinationFile, Token, 0)
Return DownloadM3U8(URL, Media, DestinationFile, Token, UpdateM3U8URLS)
End Function End Function
Private Overloads Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, Private Overloads Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken, ByVal Second As Boolean) As SFile ByVal Token As CancellationToken, ByVal Round As Integer) As SFile
Const MaxRound% = 2
Try Try
If Second Then If Round > 0 Then
Dim r$ = Responser.Curl(Media.URL_BASE,, EDP.ReturnValue) Dim r$ = Responser.Curl(Media.URL_BASE,, EDP.ReturnValue)
If Not r.IsEmptyString Then Media.URL = CreateVideoURL(r).IfNullOrEmpty(URL) : URL = Media.URL If Not r.IsEmptyString Then Media.URL = CreateVideoURL(r).IfNullOrEmpty(URL) : URL = Media.URL
End If End If
Dim f As SFile = M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload) Dim f As SFile = M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload)
If Not f.Exists And Not Second Then UpdateM3U8URLS = True : f = DownloadM3U8(URL, Media, DestinationFile, Token, True) If Not f.Exists Then f = Nothing
If f.IsEmptyString And Round < MaxRound Then f = DownloadM3U8(URL, Media, DestinationFile, Token, Round + 1)
Return f Return f
Catch ex As Exception Catch ex As Exception
If Not UpdateM3U8URLS_Error Then If Round < MaxRound Then
UpdateM3U8URLS_Error = True
Thread.Sleep(1000) Thread.Sleep(1000)
Return DownloadM3U8(URL, Media, DestinationFile, Token, True) Return DownloadM3U8(URL, Media, DestinationFile, Token, Round + 1)
End If End If
Return Nothing Return Nothing
End Try End Try
@@ -917,7 +952,6 @@ Namespace API.PornHub
#End Region #End Region
#Region "DownloadSingleObject" #Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken) Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
UpdateM3U8URLS = False
_TempMediaList.Add(New UserMedia(Data.URL, UTypes.VideoPre)) _TempMediaList.Add(New UserMedia(Data.URL, UTypes.VideoPre))
ReparseVideo(Token, True, Data) ReparseVideo(Token, True, Data)
End Sub End Sub

View File

@@ -44,7 +44,7 @@ Namespace API.PornHub
DownloadGifs = Not v = CheckState.Unchecked DownloadGifs = Not v = CheckState.Unchecked
MySettings = s MySettings = s
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As IPSite) Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u) MyBase.Apply(u)
With DirectCast(u, UserData) With DirectCast(u, UserData)
.DownloadUHD = DownloadUHD .DownloadUHD = DownloadUHD

View File

@@ -136,7 +136,7 @@ Namespace API.Reddit
DownloadTextSpecialFolder = .DownloadTextSpecialFolder DownloadTextSpecialFolder = .DownloadTextSpecialFolder
RedGifsAccount = .RedGifsAccount RedGifsAccount = .RedGifsAccount
RedditAccount = .RedditAccount RedditAccount = .RedditAccount
If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).ApplyBase(Me) If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).Apply(Me)
End With End With
End If End If
End Sub End Sub
@@ -1022,11 +1022,11 @@ Namespace API.Reddit
If .ListExists AndAlso ParseContainer(.Self, m.Post.ID, String.Empty,,, GetTextDocument(.Self)) Then If .ListExists AndAlso ParseContainer(.Self, m.Post.ID, String.Empty,,, GetTextDocument(.Self)) Then
If lastCount <> _TempMediaList.Count Then If lastCount <> _TempMediaList.Count Then
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1 For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
m2 = _TempMediaList(i) m2 = _TempMediaList(li)
m2.Post.Date = m.Post.Date m2.Post.Date = m.Post.Date
m2.State = UStates.Missing m2.State = UStates.Missing
m2.Attempts = m.Attempts m2.Attempts = m.Attempts
_TempMediaList(i) = m2 _TempMediaList(li) = m2
Next Next
End If End If
rList.Add(i) rList.Add(i)

View File

@@ -7,6 +7,8 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.ThisVid Namespace API.ThisVid
Friend Module Declarations Friend Module Declarations
Friend Const ThisVidSiteKey As String = "AndyProgram_ThisVid" Friend Const ThisVidSiteKey As String = "AndyProgram_ThisVid"
@@ -22,5 +24,27 @@ Namespace API.ThisVid
Friend ReadOnly RegExVideosThumb1 As RParams = RParams.DMS("preview_url:\s*'([^""']+)'", 1, EDP.ReturnValue) Friend ReadOnly RegExVideosThumb1 As RParams = RParams.DMS("preview_url:\s*'([^""']+)'", 1, EDP.ReturnValue)
Friend ReadOnly RegExVideosThumb2 As RParams = RParams.DMS("preview_url1:\s*'([^""']+)'", 1, EDP.ReturnValue) Friend ReadOnly RegExVideosThumb2 As RParams = RParams.DMS("preview_url1:\s*'([^""']+)'", 1, EDP.ReturnValue)
Friend ReadOnly RegExVideoTitle As RParams = RParams.DMS("meta property=.og:title..content=""([^""]*)""", 1, EDP.ReturnValue) Friend ReadOnly RegExVideoTitle As RParams = RParams.DMS("meta property=.og:title..content=""([^""]*)""", 1, EDP.ReturnValue)
Friend Class CookieKeeper2 : Inherits CookieKeeper
Public Overrides Function Update(Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
If Count > 0 Then
If Not ConvertToContainer(_Container, CookieList, EDP.ReturnValue) Then CookieList.RemoveAt(CookieList.Count - 1) Else Return True
End If
Return MyBase.Update(e)
End Function
End Class
Friend Class Responser2 : Inherits Responser
Friend Sub New()
MyBase.New
ChangeCookieKeeper()
End Sub
Friend Sub New(ByVal f As SFile)
MyBase.New(f)
ChangeCookieKeeper()
End Sub
Private Sub ChangeCookieKeeper()
_Cookies = New CookieKeeper2
Reset()
End Sub
End Class
End Module End Module
End Namespace End Namespace

View File

@@ -50,6 +50,14 @@ Namespace API.ThisVid
UrlPatternUser = "https://thisvid.com/members/{0}/" UrlPatternUser = "https://thisvid.com/members/{0}/"
ImageVideoContains = "https://thisvid.com/videos/" ImageVideoContains = "https://thisvid.com/videos/"
End Sub End Sub
Protected Overrides Sub ChangeResponserOnInit()
_Responser.DisposeIfReady(False)
_Responser = Nothing
_Responser = New Responser2 With {.DeclaredError = EDP.ThrowException}
End Sub
Friend Overrides Function GetCookieKeeperInstance() As CookieKeeper
Return New CookieKeeper2
End Function
#End Region #End Region
#Region "GetInstance" #Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider

View File

@@ -403,6 +403,30 @@ Namespace API.ThisVid
End Sub End Sub
#End Region #End Region
#Region "ReparseVideo" #Region "ReparseVideo"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If Not IsSubscription And ContentMissingExists Then
Dim m As UserMedia
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
m.URL = m.URL_BASE
m.Type = UserMedia.Types.VideoPre
_TempMediaList.ListAddValue(m, LNC)
rList.Add(i)
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
ReparseMissing_ClearList(rList)
End Try
End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken) Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then If IsSubscription Then
ReparseVideoSubscriptions(Token) ReparseVideoSubscriptions(Token)
@@ -440,11 +464,12 @@ Namespace API.ThisVid
If n.IsEmptyString Then n = u.Post.ID If n.IsEmptyString Then n = u.Post.ID
If n.IsEmptyString Then n = "VideoFile" If n.IsEmptyString Then n = "VideoFile"
u.File = $"{n}.mp4" u.File = $"{n}.mp4"
If u.URL.IsEmptyString OrElse (Not u.Post.ID.IsEmptyString AndAlso _TempPostsList.Contains(u.Post.ID)) Then If Not u.State = UserMedia.States.Missing AndAlso
(u.URL.IsEmptyString OrElse (Not u.Post.ID.IsEmptyString AndAlso _TempPostsList.Contains(u.Post.ID))) Then
_TempMediaList.RemoveAt(i) _TempMediaList.RemoveAt(i)
Else Else
u.Type = UserMedia.Types.Video u.Type = UserMedia.Types.Video
_TempPostsList.Add(u.Post.ID) _TempPostsList.ListAddValue(u.Post.ID, LNC)
_TempMediaList(i) = u _TempMediaList(i) = u
End If End If
e.Dispose() e.Dispose()

View File

@@ -35,7 +35,7 @@ Namespace API.ThisVid
DifferentFolders = u.DifferentFolders DifferentFolders = u.DifferentFolders
MySettings = u.HOST.Source MySettings = u.HOST.Source
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As IPSite) Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u) MyBase.Apply(u)
With DirectCast(u, UserData) With DirectCast(u, UserData)
.DownloadPublic = DownloadPublic .DownloadPublic = DownloadPublic

View File

@@ -55,7 +55,7 @@ Namespace API.ThreadsNet
Return New EditorExchangeOptionsBase(Me) Return New EditorExchangeOptionsBase(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase Then DirectCast(Obj, EditorExchangeOptionsBase).ApplyBase(Me) If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase Then DirectCast(Obj, EditorExchangeOptionsBase).Apply(Me)
End Sub End Sub
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -184,7 +184,6 @@ Namespace API.ThreadsNet
If uex.UserNotFound Then If uex.UserNotFound Then
UserExists = False UserExists = False
_ForceSaveUserInfo = True _ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
ElseIf ThrowEx Then ElseIf ThrowEx Then
Throw New ExitException(uex.ErrMessage) With {.SimpleLogLine = True} Throw New ExitException(uex.ErrMessage) With {.SimpleLogLine = True}
Else Else
@@ -404,7 +403,6 @@ Namespace API.ThreadsNet
If _IdChanged Then If _IdChanged Then
If Not idStr.IsEmptyString Then UserDescriptionUpdate(idStr, True, True, True) If Not idStr.IsEmptyString Then UserDescriptionUpdate(idStr, True, True, True)
_ForceSaveUserInfo = True _ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
End If End If
End If End If
Return Valid Return Valid

View File

@@ -80,20 +80,7 @@ Namespace API.TikTok
Return New UserExchangeOptions(Me) Return New UserExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
With DirectCast(Obj, UserExchangeOptions)
.ApplyBase(Me)
GetTimeline = .GetTimeline
GetStoriesUser = .GetStoriesUser
GetReposts = .GetReposts
RemoveTagsFromTitle = .RemoveTagsFromTitle
TitleUseNative = .TitleUseNative
TitleAddVideoID = .TitleAddVideoID
TitleUseRegexForTitle = .TitleUseRegexForTitle
TitleUseRegexForTitle_Value = .TitleUseRegexForTitle_Value
TitleUseGlobalRegexOptions = .TitleUseGlobalRegexOptions
End With
End If
End Sub End Sub
#End Region #End Region
#Region "Loader" #Region "Loader"
@@ -192,10 +179,14 @@ Namespace API.TikTok
UserCache.DisposeIfReady(False) UserCache.DisposeIfReady(False)
UserCache = Nothing UserCache = Nothing
End Sub End Sub
Private StoryStatus As Boolean = True
Private StoryStatusFound As Boolean = False
Protected Overloads Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overloads Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ValidateCache() ValidateCache()
StoryStatus = True
StoryStatusFound = False
If GetTimeline Then DownloadDataF(Sections.Timeline, Token) If GetTimeline Then DownloadDataF(Sections.Timeline, Token)
If GetStoriesUser Then DownloadDataF(Sections.UserStories, Token) If GetStoriesUser And StoryStatus Then DownloadDataF(Sections.UserStories, Token)
If GetReposts Then DownloadDataF(Sections.Reposts, Token) If GetReposts Then DownloadDataF(Sections.Reposts, Token)
End Sub End Sub
Protected Overloads Sub DownloadDataF(ByVal Section As Sections, ByVal Token As CancellationToken) Protected Overloads Sub DownloadDataF(ByVal Section As Sections, ByVal Token As CancellationToken)
@@ -271,8 +262,8 @@ Namespace API.TikTok
Else Else
.TempPostsList = New List(Of String) .TempPostsList = New List(Of String)
End If End If
.Execute(CreateGDLCommand(URL, gdlCmd)) .Execute(CreateGDLCommand(URL, gdlCmd,,,, CObj(IIf(Section = Sections.Timeline, dateAfter, Nothing))))
If Not PhotosDownloaded Then _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True If Not PhotosDownloaded Then _ForceSaveUserInfo = True
PhotosDownloaded = True PhotosDownloaded = True
End With End With
End Using End Using
@@ -436,6 +427,10 @@ Namespace API.TikTok
End If End If
End With End With
Else Else
If Section = Sections.Timeline And Not StoryStatusFound And j.ContainsF({0, "webapp.user-detail", "userInfo", "user"}, "UserStoryStatus") Then
StoryStatusFound = True
StoryStatus = j.ItemF({0, "webapp.user-detail", "userInfo", "user"}, "UserStoryStatus").Value.FromXML(Of Boolean)(False)
End If
With j.ItemF({0, "webapp.video-detail", "itemInfo", "itemStruct"}) With j.ItemF({0, "webapp.video-detail", "itemInfo", "itemStruct"})
If .ListExists Then If .ListExists Then
postID = .Value("id") postID = .Value("id")
@@ -604,13 +599,17 @@ Namespace API.TikTok
#End Region #End Region
#Region "GDL Support" #Region "GDL Support"
Private Function CreateGDLCommand(ByVal URL As String, Optional ByVal SectionCommand As String = Nothing, Private Function CreateGDLCommand(ByVal URL As String, Optional ByVal SectionCommand As String = Nothing,
Optional ByVal IsDownload As Boolean = False, Optional ByVal Output As SFile = Nothing) As String Optional ByVal IsDownload As Boolean = False, Optional ByVal Output As SFile = Nothing,
Optional ByVal DateBefore As Date? = Nothing, Optional ByVal DateAfter As Date? = Nothing) As String
Dim command$ = $"""{Settings.GalleryDLFile}"" " Dim command$ = $"""{Settings.GalleryDLFile}"" "
If Not IsDownload Then If Not IsDownload Then
command &= "--verbose --no-download --no-skip --write-pages " command &= "--verbose --no-download --no-skip --write-pages "
Else Else
command &= $"--dest ""{Output.PathNoSeparator}"" " command &= $"--dest ""{Output.PathNoSeparator}"" "
End If End If
If DateBefore.HasValue Or DateAfter.HasValue Then
With If(DateAfter, DateBefore).Value : command &= $"--filter ""date {IIf(DateAfter.HasValue, ">", "<")} datetime({ .Year}, { .Month}, { .Day}) or terminate()"" " : End With
End If
If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then command &= "--no-mtime " If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then command &= "--no-mtime "
command &= $"{SectionCommand} {URL}" command &= $"{SectionCommand} {URL}"
Return command Return command

View File

@@ -6,10 +6,11 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.TikTok Namespace API.TikTok
Friend Class UserExchangeOptions : Inherits Base.EditorExchangeOptionsBase Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.GetTimeline), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.GetTimeline), NameOf(MySettings))>
Friend Property GetTimeline As Boolean Friend Property GetTimeline As Boolean
<PSetting(NameOf(SiteSettings.GetStoriesUser), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.GetStoriesUser), NameOf(MySettings))>
@@ -57,5 +58,19 @@ Namespace API.TikTok
TitleUseRegexForTitle = s.TitleUseRegexForTitle.Value TitleUseRegexForTitle = s.TitleUseRegexForTitle.Value
TitleUseRegexForTitle_Value = s.TitleUseRegexForTitle_Value.Value TitleUseRegexForTitle_Value = s.TitleUseRegexForTitle_Value.Value
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
With DirectCast(u, UserData)
.GetTimeline = GetTimeline
.GetStoriesUser = GetStoriesUser
.GetReposts = GetReposts
.RemoveTagsFromTitle = RemoveTagsFromTitle
.TitleUseNative = TitleUseNative
.TitleAddVideoID = TitleAddVideoID
.TitleUseRegexForTitle = TitleUseRegexForTitle
.TitleUseRegexForTitle_Value = TitleUseRegexForTitle_Value
.TitleUseGlobalRegexOptions = TitleUseGlobalRegexOptions
End With
End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -17,6 +17,10 @@ Namespace API.Twitter
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue) Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly StatusRegEx As RParams = RParams.DM(".*?(twitter|x)\.com/\S+/status/\d+", 0, EDP.ReturnValue) Friend ReadOnly StatusRegEx As RParams = RParams.DM(".*?(twitter|x)\.com/\S+/status/\d+", 0, EDP.ReturnValue)
Friend ReadOnly BroadcastsUrls As Object() = {"entities", "urls", 0, "expanded_url"} Friend ReadOnly BroadcastsUrls As Object() = {"entities", "urls", 0, "expanded_url"}
Friend ReadOnly RichTextNode As New List(Of String()) From {
{{"content", "itemContent", "tweet_results", "result", "note_tweet", "note_tweet_results", "result", "text"}},
{{"item", "itemContent", "tweet_results", "result", "note_tweet", "note_tweet_results", "result", "text"}}
}
Friend ReadOnly GdlLimitRegEx As RParams = RParams.DM("Waiting until[\s\W\d\:]+\(rate limit\)", 0, RegexOptions.IgnoreCase, EDP.ReturnValue) Friend ReadOnly GdlLimitRegEx As RParams = RParams.DM("Waiting until[\s\W\d\:]+\(rate limit\)", 0, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly GdlPostCoutNumberNodes As String() = {"data", "user", "result", "legacy", "statuses_count"} Friend ReadOnly GdlPostCoutNumberNodes As String() = {"data", "user", "result", "legacy", "statuses_count"}
Private Function GetDateProvider() As ADateTime Private Function GetDateProvider() As ADateTime

View File

@@ -66,6 +66,7 @@ Namespace API.Twitter
MySettings = s MySettings = s
End Sub End Sub
Friend Sub New(ByVal s As Mastodon.SiteSettings) Friend Sub New(ByVal s As Mastodon.SiteSettings)
MyBase.New(s)
GifsDownload = s.GifsDownload.Value GifsDownload = s.GifsDownload.Value
GifsSpecialFolder = s.GifsSpecialFolder.Value GifsSpecialFolder = s.GifsSpecialFolder.Value
GifsPrefix = s.GifsPrefix.Value GifsPrefix = s.GifsPrefix.Value

View File

@@ -123,7 +123,7 @@ Namespace API.Twitter
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions) With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me) .Apply(Me)
GifsDownload = .GifsDownload GifsDownload = .GifsDownload
GifsSpecialFolder = .GifsSpecialFolder GifsSpecialFolder = .GifsSpecialFolder
GifsPrefix = .GifsPrefix GifsPrefix = .GifsPrefix
@@ -442,7 +442,7 @@ Namespace API.Twitter
End If End If
End If End If
Else Else
ObtainMedia(nn, PostID, PostDate) ObtainMedia(nn, PostID, PostDate,,,, ee)
End If End If
End If End If
End If End If
@@ -523,7 +523,7 @@ Namespace API.Twitter
With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"}) With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"})
If .ListExists Then If .ListExists Then
If ID = .Value("id_str") Then If ID = .Value("id_str") Then
UserSiteNameUpdate(.Value("name")) UserSiteNameUpdate(.Value("name"), True)
UserDescriptionUpdate(.Value("description")) UserDescriptionUpdate(.Value("description"))
icon = .Value({"custom_banner_media", "media_info"}, "original_img_url"). icon = .Value({"custom_banner_media", "media_info"}, "original_img_url").
@@ -543,12 +543,12 @@ Namespace API.Twitter
If .ListExists Then If .ListExists Then
If ID.IsEmptyString Then ID = .Value("rest_id") If ID.IsEmptyString Then ID = .Value("rest_id")
icon = .Value({"avatar"}, "image_url") icon = .Value({"avatar"}, "image_url")
UserSiteNameUpdate(.Value({"core"}, "name")) UserSiteNameUpdate(.Value({"core"}, "name"), True)
Dim tScreenName$ = .Value({"core"}, "screen_name") Dim tScreenName$ = .Value({"core"}, "screen_name")
With .Item({"legacy"}) With .Item({"legacy"})
If .ListExists Then If .ListExists Then
If onlyUpdateUser Then If onlyUpdateUser Then
If Not NameTrue = tScreenName Or 1 = 1 Then If Not NameTrue = tScreenName Then
Dim uStr$ = $"username changed from '{NameTrue}' to '{tScreenName}'" Dim uStr$ = $"username changed from '{NameTrue}' to '{tScreenName}'"
LogError(Nothing, uStr) LogError(Nothing, uStr)
UserDescriptionUpdate(uStr, True, True, True) UserDescriptionUpdate(uStr, True, True, True)
@@ -556,7 +556,7 @@ Namespace API.Twitter
NameTrue = tScreenName NameTrue = tScreenName
End If End If
If .Value("screen_name").IfNullOrEmpty(tScreenName).StringToLower = NameTrue.ToLower Then If .Value("screen_name").IfNullOrEmpty(tScreenName).StringToLower = NameTrue.ToLower Then
UserSiteNameUpdate(.Value("name")) UserSiteNameUpdate(.Value("name"), True)
UserDescriptionUpdate(.Value("description")) UserDescriptionUpdate(.Value("description"))
If icon.IsEmptyString Then icon = .Value("profile_image_url_https") If icon.IsEmptyString Then icon = .Value("profile_image_url_https")
@@ -717,7 +717,7 @@ nextpIndx:
With jj(node) With jj(node)
If .ListExists Then If .ListExists Then
id = .Value("id_str") id = .Value("id_str")
If _TempPostsList.Contains(id) Then j.Dispose() : Exit Sub Else ObtainMedia(.Self, id, .Value("created_at")) If _TempPostsList.Contains(id) Then j.Dispose() : Exit Sub Else ObtainMedia(.Self, id, .Value("created_at"),,,, jj)
Exit For Exit For
End If End If
End With End With
@@ -738,11 +738,27 @@ nextpIndx:
#End Region #End Region
#Region "Obtain media" #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, Optional ByVal SpecialFolder As String = Nothing) Optional ByVal Attempts As Integer = 0, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal RootElem As EContainer = Nothing)
Dim s As EContainer = e({"extended_entities", "media"}) 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", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"}) If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
Dim txt$ = If(DownloadText, e.Value("full_text"), String.Empty) Dim txt$ = String.Empty
If DownloadText Then
txt = e.Value("full_text")
If RootElem.ListExists Then
For Each n As String() In RichTextNode
With RootElem(n)
If Not .Self Is Nothing AndAlso Not .Value.IsEmptyString Then
If Not txt.IsEmptyString AndAlso .Value.Contains(txt) Then txt = String.Empty
If txt.IsEmptyString Then txt = .Value Else txt = $"{ .Value}{vbCr}{vbCr}----{vbCr}{vbCr}{txt}"
Exit For
End If
End With
Next
End If
End If
Dim mUrl$ Dim mUrl$
Dim media As UserMedia Dim media As UserMedia
@@ -1190,10 +1206,12 @@ nextpIndx:
Dim cache As CacheKeeper = Nothing Dim cache As CacheKeeper = Nothing
Try Try
If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then
Const __entries$ = "entries"
Dim m As UserMedia, mTmp As UserMedia Dim m As UserMedia, mTmp As UserMedia
Dim PostDate$ Dim PostDate$
Dim nodes As List(Of String()) = GetContainerSubnodes() Dim nodes As List(Of String()) = GetContainerSubnodes()
Dim node$() Dim node$()
Dim entriesNode As Predicate(Of EContainer) = Function(ee) ee.Contains(__entries)
Dim j As EContainer, n As EContainer Dim j As EContainer, n As EContainer
Dim f As SFile Dim f As SFile
Dim i%, ii% Dim i%, ii%
@@ -1229,7 +1247,7 @@ nextpIndx:
f = GDLRenameFile(files(ii), ii) f = GDLRenameFile(files(ii), ii)
j = JsonDocument.Parse(f.GetText) j = JsonDocument.Parse(f.GetText)
If Not j Is Nothing Then If Not j Is Nothing Then
With j.ItemF({"data", 0, "instructions", 0, "entries"}) With j.ItemF({"data", 0, "instructions", entriesNode, __entries})
If .ListExists Then If .ListExists Then
If IsSingleObjectDownload Or DownloadBroadcasts Then If IsSingleObjectDownload Or DownloadBroadcasts Then
mTmp = ExtractBroadcast(.Self, m.Post.ID, String.Empty, nodes) mTmp = ExtractBroadcast(.Self, m.Post.ID, String.Empty, nodes)
@@ -1244,7 +1262,7 @@ nextpIndx:
If .ListExists Then If .ListExists Then
PostDate = String.Empty PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder) ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder, n)
rList.ListAddValue(i, LNC) rList.ListAddValue(i, LNC)
End If End If
End With End With

View File

@@ -109,7 +109,7 @@ Namespace API.Xhamster
End Function End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
With DirectCast(User, UserData) With DirectCast(User, UserData)
If Not .SiteMode = SiteModes.User Then If Not .SiteMode = SiteModes.User OrElse .IsCreator Then
Return .GetNonUserUrl(0) Return .GetNonUserUrl(0)
Else Else
Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, UserOption), .NameTrue) Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, UserOption), .NameTrue)

View File

@@ -53,7 +53,7 @@ Namespace API.Xhamster
End Property End Property
Friend Property QueryString As String Implements IPSite.QueryString Friend Property QueryString As String Implements IPSite.QueryString
Get Get
If SiteMode = SiteModes.User Then If SiteMode = SiteModes.User And Not IsCreator Then
Return String.Empty Return String.Empty
Else Else
Return GetNonUserUrl(0) Return GetNonUserUrl(0)
@@ -73,7 +73,7 @@ Namespace API.Xhamster
End Structure End Structure
Private ReadOnly _TempPhotoData As List(Of UserMedia) Private ReadOnly _TempPhotoData As List(Of UserMedia)
Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean
If Not Force OrElse (Not SiteMode = SiteModes.User AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then If Not Force OrElse (Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then
Dim eObj As Plugin.ExchangeOptions = Nothing Dim eObj As Plugin.ExchangeOptions = Nothing
If Force Then eObj = MySettings.IsMyUser(NewUrl) If Force Then eObj = MySettings.IsMyUser(NewUrl)
If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And NameTrue(True).IsEmptyString) Then If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And NameTrue(True).IsEmptyString) Then
@@ -193,7 +193,7 @@ Namespace API.Xhamster
End Sub End Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Friend Function GetNonUserUrl(ByVal Page As Integer) As String Friend Function GetNonUserUrl(ByVal Page As Integer, Optional ByVal GetShorts As Boolean = False) As String
Const newest$ = "/newest" Const newest$ = "/newest"
If SiteMode = SiteModes.User And Not IsCreator Then If SiteMode = SiteModes.User And Not IsCreator Then
Return String.Empty Return String.Empty
@@ -210,8 +210,10 @@ Namespace API.Xhamster
End Select End Select
url &= $"/{NameTrue}" url &= $"/{NameTrue}"
If GetShorts And (SiteMode = SiteModes.User Or IsCreator) Then url &= "/shorts"
Dim args$ = Arguments Dim args$ = Arguments
If (args.IsEmptyString OrElse Not args.Contains(newest)) And Not SiteMode = SiteModes.Search Then url &= newest If (args.IsEmptyString OrElse Not args.Contains(newest)) And Not SiteMode = SiteModes.Search And Not IsCreator Then url &= newest
If Page > 1 Then If Page > 1 Then
If args.IsEmptyString Then If args.IsEmptyString Then
If SiteMode = SiteModes.Search Then If SiteMode = SiteModes.Search Then
@@ -288,7 +290,10 @@ Namespace API.Xhamster
End If End If
ElseIf Not SiteMode = SiteModes.Search Then ElseIf Not SiteMode = SiteModes.Search Then
If IsVideo Then If IsVideo Then
If GetMoments Then containerNodes.Add({"momentListComponent", "videoThumbProps"}) If GetMoments Then
containerNodes.Add({"momentListComponent", "videoThumbProps"})
containerNodes.Add({"momentsComponent", "videoListProps", "videoThumbProps"})
End If
containerNodes.Add({"trendingVideoListComponent", "models"}) containerNodes.Add({"trendingVideoListComponent", "models"})
containerNodes.Add({"pagesCategoryComponent", "trendingVideoListProps", "models"}) containerNodes.Add({"pagesCategoryComponent", "trendingVideoListProps", "models"})
containerNodes.Add({"trendingVideoSectionComponent", "videoModels"}) containerNodes.Add({"trendingVideoSectionComponent", "videoModels"})
@@ -298,6 +303,7 @@ Namespace API.Xhamster
containerNodes.Add({"videoListComponent", "videoThumbProps"}) containerNodes.Add({"videoListComponent", "videoThumbProps"})
Else Else
containerNodes.Add({"userGalleriesCollection"}) containerNodes.Add({"userGalleriesCollection"})
containerNodes.Add({"contentComponent", "items"})
End If End If
End If End If
@@ -310,7 +316,7 @@ Namespace API.Xhamster
URL = GetNonUserUrl(Page) URL = GetNonUserUrl(Page)
containerNodes.Add({"searchResult", "models"}) containerNodes.Add({"searchResult", "models"})
ElseIf IsCreator Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then ElseIf IsCreator Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then
URL = GetNonUserUrl(Page) URL = GetNonUserUrl(Page, IsCreator And GetMoments)
Else Else
URL = $"https://xhamster.com/{SiteSettings.UserOption}/{NameTrue}/{If(GetMoments, "moments", IIf(IsVideo, "videos", "photos"))}{IIf(Page = 1, String.Empty, $"/{Page}")}" URL = $"https://xhamster.com/{SiteSettings.UserOption}/{NameTrue}/{If(GetMoments, "moments", IIf(IsVideo, "videos", "photos"))}{IIf(Page = 1, String.Empty, $"/{Page}")}"
End If End If
@@ -799,6 +805,9 @@ Namespace API.Xhamster
Using ytdlp As New YTDLP.YTDLPBatch(TokenPersonal,, DestinationFile) : ytdlp.Encoding = Settings.CMDEncoding : ytdlp.Execute(cmd) : End Using Using ytdlp As New YTDLP.YTDLPBatch(TokenPersonal,, DestinationFile) : ytdlp.Encoding = Settings.CMDEncoding : ytdlp.Execute(cmd) : End Using
Return DestinationFile Return DestinationFile
End Function End Function
Protected Overrides Function DownloadContentDefault_ConvertWebp(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
Return DownloadContentDefault_ConvertWebp_TestImg(m, Process)
End Function
#End Region #End Region
#Region "Create media" #Region "Create media"
Private Function ExtractMedia(ByVal j As EContainer, ByVal t As UTypes, Optional ByVal UrlNode As String = "pageURL", Private Function ExtractMedia(ByVal j As EContainer, ByVal t As UTypes, Optional ByVal UrlNode As String = "pageURL",

View File

@@ -13,7 +13,6 @@ Namespace API.Xhamster
<PSetting(Address:=SettingAddress.User, Caption:=SiteSettings.GetMomentsCaption)> <PSetting(Address:=SettingAddress.User, Caption:=SiteSettings.GetMomentsCaption)>
Friend Property GetMoments As Boolean = False Friend Property GetMoments As Boolean = False
Friend Sub New() Friend Sub New()
MyBase.New
End Sub End Sub
Friend Sub New(ByVal u As IPSite) Friend Sub New(ByVal u As IPSite)
MyBase.New(DirectCast(u, UserData)) MyBase.New(DirectCast(u, UserData))
@@ -23,7 +22,7 @@ Namespace API.Xhamster
MyBase.New(s) MyBase.New(s)
GetMoments = s.GetMoments.Value GetMoments = s.GetMoments.Value
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As IPSite) Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u) MyBase.Apply(u)
DirectCast(u, UserData).GetMoments = GetMoments DirectCast(u, UserData).GetMoments = GetMoments
End Sub End Sub

View File

@@ -121,6 +121,7 @@ Namespace API.YouTube
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions) With DirectCast(Obj, UserExchangeOptions)
.Apply(Me)
DownloadYTVideos = .DownloadVideos DownloadYTVideos = .DownloadVideos
DownloadYTShorts = .DownloadShorts DownloadYTShorts = .DownloadShorts
DownloadYTPlaylists = .DownloadPlaylists DownloadYTPlaylists = .DownloadPlaylists

View File

@@ -8,7 +8,7 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.YouTube Namespace API.YouTube
Friend Class UserExchangeOptions Friend Class UserExchangeOptions : Inherits SCrawler.API.Base.EditorExchangeOptionsBase
<PSetting(Caption:="Download videos")> <PSetting(Caption:="Download videos")>
Friend Property DownloadVideos As Boolean Friend Property DownloadVideos As Boolean
<PSetting(Caption:="Download shorts")> <PSetting(Caption:="Download shorts")>
@@ -23,7 +23,14 @@ Namespace API.YouTube
Friend Property UseCookies As Boolean Friend Property UseCookies As Boolean
<PSetting(Caption:="Channel ID", Address:=SettingAddress.User)> <PSetting(Caption:="Channel ID", Address:=SettingAddress.User)>
Friend Property ChannelID As String Friend Property ChannelID As String
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadText As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextPosts As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextSpecialFolder As Boolean
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
_ApplyBase_Name = False
_ApplyBase_Text = False
DownloadVideos = u.DownloadYTVideos DownloadVideos = u.DownloadYTVideos
DownloadShorts = u.DownloadYTShorts DownloadShorts = u.DownloadYTShorts
DownloadPlaylists = u.DownloadYTPlaylists DownloadPlaylists = u.DownloadYTPlaylists
@@ -33,6 +40,9 @@ Namespace API.YouTube
ChannelID = u.ChannelID ChannelID = u.ChannelID
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
_ApplyBase_Name = False
_ApplyBase_Text = False
DownloadVideos = s.DownloadVideos.Value DownloadVideos = s.DownloadVideos.Value
DownloadShorts = s.DownloadShorts.Value DownloadShorts = s.DownloadShorts.Value
DownloadPlaylists = s.DownloadPlaylists.Value DownloadPlaylists = s.DownloadPlaylists.Value

View File

@@ -26,7 +26,19 @@ Namespace DownloadObjects
Friend WithEvents MyDefs As DefaultFormOptions Friend WithEvents MyDefs As DefaultFormOptions
Private WithEvents MyRange As RangeSwitcherToolbar(Of UserMediaD) Private WithEvents MyRange As RangeSwitcherToolbar(Of UserMediaD)
Private ReadOnly DataList As List(Of UserMediaD) Private ReadOnly DataList As List(Of UserMediaD)
#Region "Buttons"
Private WithEvents BTT_DELETE_SELECTED As ToolStripButton Private WithEvents BTT_DELETE_SELECTED As ToolStripButton
Private WithEvents BTT_COPY_SELECTED_T As ToolStripButton
Private WithEvents BTT_MOVE_SELECTED_T As ToolStripButton
Private WithEvents BTT_FAV_T As ToolStripButton
Private WithEvents BTT_FEED_ADD_T As ToolStripDropDownButton
Private WithEvents BTT_SELECT_ALL_T As ToolStripButton
Private WithEvents BTT_SELECT_NONE_T As ToolStripButton
Private WithEvents BTT_INVERT_T As ToolStripButton
Private WithEvents BTT_LOAD_CURRENT_T As ToolStripButton
Private WithEvents BTT_LOAD_FAV_T As ToolStripButton
Private WithEvents BTT_LOAD_T As ToolStripDropDownButton
#End Region
Private DataRows As Integer = 10 Private DataRows As Integer = 10
Private DataColumns As Integer = 1 Private DataColumns As Integer = 1
Private FeedEndless As Boolean = False Private FeedEndless As Boolean = False
@@ -65,8 +77,10 @@ Namespace DownloadObjects
If Not CurrentFilter Is Nothing Then If Not CurrentFilter Is Nothing Then
With CurrentFilter With CurrentFilter
If .Types.Count > 0 AndAlso Not .Types.Any(Function(t) FilterTypesConversion(t, d)) Then Return False If .Types.Count > 0 AndAlso Not .Types.Any(Function(t) FilterTypesConversion(t, d)) Then Return False
#Disable Warning BC42109 #Disable Warning BC42109, BC42104
If .Sites.Count > 0 AndAlso Not .Sites.Contains(d.UserInfo.Site) Then Return False
If .Users.Count > 0 AndAlso Not .Users.Contains(d.UserInfo) Then Return False If .Users.Count > 0 AndAlso Not .Users.Contains(d.UserInfo) Then Return False
If .Labels.Count > 0 AndAlso d.User.Labels.Count > 0 AndAlso Not d.User.Labels.ListContains(.Labels) Then Return False
#Enable Warning #Enable Warning
End With End With
End If End If
@@ -157,13 +171,84 @@ Namespace DownloadObjects
MyRange = New RangeSwitcherToolbar(Of UserMediaD)(ToolbarTOP) MyRange = New RangeSwitcherToolbar(Of UserMediaD)(ToolbarTOP)
DataList = New List(Of UserMediaD) DataList = New List(Of UserMediaD)
LoadedFeedNames = New List(Of String) LoadedFeedNames = New List(Of String)
BTT_DELETE_SELECTED = New ToolStripButton With { BTT_DELETE_SELECTED = New ToolStripButton With {
.Text = "Delete selected", .Text = "Delete",
.AutoToolTip = True, .AutoToolTip = True,
.ToolTipText = "Delete marked files", .ToolTipText = "Delete selected files",
.Image = My.Resources.DeletePic_24, .Image = My.Resources.DeletePic_24,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText .DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
} }
BTT_COPY_SELECTED_T = New ToolStripButton With {
.Text = "Copy",
.AutoToolTip = True,
.ToolTipText = "Copy selected files",
.Image = My.Resources.PastePic_32,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_MOVE_SELECTED_T = New ToolStripButton With {
.Text = "Move",
.AutoToolTip = True,
.ToolTipText = "Move selected files",
.Image = My.Resources.CutPic_48,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_FAV_T = New ToolStripButton With {
.Text = "Favorite",
.AutoToolTip = True,
.ToolTipText = "Add checked to Favorite",
.Image = My.Resources.HeartPic_32,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_FEED_ADD_T = New ToolStripDropDownButton With {
.Text = "Add",
.AutoToolTip = True,
.ToolTipText = "Add checked to special feed..." & vbCr & "Right click to add to multiple feeds",
.Image = My.Resources.RSSPic_512,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_LOAD_CURRENT_T = New ToolStripButton With {
.Text = "Current",
.AutoToolTip = True,
.ToolTipText = "Load current feed",
.Image = My.Resources.ArrowDownPic_Blue_24,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_LOAD_FAV_T = New ToolStripButton With {
.Text = "Favorite",
.AutoToolTip = True,
.ToolTipText = "Load Favorite",
.Image = My.Resources.HeartPic_32,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_LOAD_T = New ToolStripDropDownButton With {
.Text = "Load",
.AutoToolTip = True,
.ToolTipText = "Load special feed..." & vbCr & "Right click to load multiple feeds",
.Image = My.Resources.RSSPic_512,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_SELECT_ALL_T = New ToolStripButton With {
.Text = "All",
.AutoToolTip = True,
.ToolTipText = "Select all",
.DisplayStyle = ToolStripItemDisplayStyle.Text
}
BTT_SELECT_NONE_T = New ToolStripButton With {
.Text = "None",
.AutoToolTip = True,
.ToolTipText = "Select none",
.DisplayStyle = ToolStripItemDisplayStyle.Text
}
BTT_INVERT_T = New ToolStripButton With {
.Text = "Invert",
.AutoToolTip = True,
.ToolTipText = "Invert selection",
.DisplayStyle = ToolStripItemDisplayStyle.Text
}
FILTERS = New FeedFilterCollection FILTERS = New FeedFilterCollection
BTT_FILTER.Image = My.Resources.FilterPic BTT_FILTER.Image = My.Resources.FilterPic
BTT_FILTER_SIMPLE.Image = My.Resources.FilterPic BTT_FILTER_SIMPLE.Image = My.Resources.FilterPic
@@ -189,17 +274,29 @@ Namespace DownloadObjects
.ToolTip(RCI.GoTo) = "GoTo (Ctrl+G)" .ToolTip(RCI.GoTo) = "GoTo (Ctrl+G)"
.AddThisToolbar() .AddThisToolbar()
End With End With
ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED}) ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED,
New ToolStripSeparator, BTT_COPY_SELECTED_T, BTT_MOVE_SELECTED_T,
New ToolStripSeparator, BTT_FAV_T, BTT_FEED_ADD_T,
New ToolStripSeparator, BTT_LOAD_CURRENT_T, BTT_LOAD_FAV_T, BTT_LOAD_T,
New ToolStripSeparator, BTT_SELECT_ALL_T, BTT_SELECT_NONE_T, BTT_INVERT_T})
With Settings With Settings
With .Feeds With .Feeds
.Load() .Load()
AddHandler .FeedAdded, AddressOf Feed_FeedAdded AddHandler .FeedAdded, AddressOf Feed_FeedAdded
AddHandler .FeedRemoved, AddressOf Feed_FeedRemoved AddHandler .FeedRemoved, AddressOf Feed_FeedRemoved
If .Count = 0 OrElse (.Count = 1 AndAlso .Item(0).IsFavorite) Then
BTT_FEED_ADD_T.Enabled = False
BTT_FEED_ADD_T.Visible = False
BTT_LOAD_T.Enabled = False
BTT_LOAD_T.Visible = False
End If
If .Count > 0 Then If .Count > 0 Then
For Each feed As FeedSpecial In .Self For Each feed As FeedSpecial In .Self
If Not feed.IsFavorite Then If Not feed.IsFavorite Then
AddNewFeedItem(BTT_LOAD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD) AddNewFeedItem(BTT_LOAD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD)
AddNewFeedItem(BTT_LOAD_T, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD)
AddNewFeedItem(BTT_FEED_ADD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD) AddNewFeedItem(BTT_FEED_ADD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD)
AddNewFeedItem(BTT_FEED_ADD_T, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD)
AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE) AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE)
AddNewFeedItem(BTT_FEED_REMOVE_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE) AddNewFeedItem(BTT_FEED_REMOVE_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE)
AddNewFeedItem(BTT_FEED_DELETE_SPEC, feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE) AddNewFeedItem(BTT_FEED_DELETE_SPEC, feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE)
@@ -268,11 +365,11 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Feeds handlers" #Region "Feeds handlers"
Private Overloads Sub AddNewFeedItem(ByVal Destination As ToolStripMenuItem, ByVal Feed As FeedSpecial, ByVal Image As Image, Private Overloads Sub AddNewFeedItem(Of T As ToolStripDropDownItem)(ByVal Destination As T, ByVal Feed As FeedSpecial, ByVal Image As Image,
ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False) ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False)
AddNewFeedItem(Destination, ToolbarTOP, Feed, Image, Handler, Insert) AddNewFeedItem(Destination, ToolbarTOP, Feed, Image, Handler, Insert)
End Sub End Sub
Friend Overloads Shared Function AddNewFeedItem(ByVal Destination As ToolStripMenuItem, ByVal Toolbar As ToolStrip, Friend Overloads Shared Function AddNewFeedItem(ByVal Destination As ToolStripDropDownItem, ByVal Toolbar As ToolStrip,
ByVal Feed As FeedSpecial, ByVal Image As Image, ByVal Feed As FeedSpecial, ByVal Image As Image,
ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False) As ToolStripMenuItem ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False) As ToolStripMenuItem
Dim item As New ToolStripMenuItem(Feed.Name, Image) With {.Tag = Feed} Dim item As New ToolStripMenuItem(Feed.Name, Image) With {.Tag = Feed}
@@ -289,6 +386,7 @@ Namespace DownloadObjects
Private Sub Feed_FeedAdded(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial) Private Sub Feed_FeedAdded(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
AddNewFeedItem(BTT_LOAD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD, True) AddNewFeedItem(BTT_LOAD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD, True)
AddNewFeedItem(BTT_FEED_ADD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True) AddNewFeedItem(BTT_FEED_ADD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True)
AddNewFeedItem(BTT_FEED_ADD_T, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True)
AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE, True) AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE, True)
AddNewFeedItem(BTT_FEED_REMOVE_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE, True) AddNewFeedItem(BTT_FEED_REMOVE_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE, True)
AddNewFeedItem(BTT_FEED_DELETE_SPEC, Feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE, True) AddNewFeedItem(BTT_FEED_DELETE_SPEC, Feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE, True)
@@ -297,14 +395,15 @@ Namespace DownloadObjects
Private Overloads Sub Feed_FeedRemoved(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial) Private Overloads Sub Feed_FeedRemoved(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
Feed_FeedRemoved(BTT_LOAD_SPEC, Feed) Feed_FeedRemoved(BTT_LOAD_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_ADD_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_ADD_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_ADD_T, Feed)
Feed_FeedRemoved(BTT_FEED_REMOVE_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_REMOVE_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_DELETE_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_DELETE_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_CLEAR_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_CLEAR_SPEC, Feed)
End Sub End Sub
Private Overloads Sub Feed_FeedRemoved(ByVal Destination As ToolStripMenuItem, ByVal Feed As FeedSpecial) Private Overloads Sub Feed_FeedRemoved(ByVal Destination As ToolStripDropDownItem, ByVal Feed As FeedSpecial)
Feed_FeedRemoved(Destination, ToolbarTOP, Feed) Feed_FeedRemoved(Destination, ToolbarTOP, Feed)
End Sub End Sub
Friend Overloads Shared Sub Feed_FeedRemoved(ByVal Destination As ToolStripMenuItem, ByVal Toolbar As ToolStrip, ByVal Feed As FeedSpecial) Friend Overloads Shared Sub Feed_FeedRemoved(ByVal Destination As ToolStripDropDownItem, ByVal Toolbar As ToolStrip, ByVal Feed As FeedSpecial)
Try Try
With Destination With Destination
ControlInvokeFast(Toolbar, .Self, ControlInvokeFast(Toolbar, .Self,
@@ -479,7 +578,7 @@ Namespace DownloadObjects
#Region "Toolbar controls" #Region "Toolbar controls"
#Region "Feed" #Region "Feed"
#Region "Load" #Region "Load"
Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click, BTT_LOAD_CURRENT_T.Click
FeedChangeMode(FeedModes.Current) FeedChangeMode(FeedModes.Current)
RefillList(True, False) RefillList(True, False)
End Sub End Sub
@@ -594,7 +693,7 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Move/Copy" #Region "Move/Copy"
Private Sub BTT_COPY_MOVE_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_TO.Click, BTT_MOVE_TO.Click Private Sub BTT_COPY_MOVE_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_TO.Click, BTT_MOVE_TO.Click, BTT_COPY_SELECTED_T.Click, BTT_MOVE_SELECTED_T.Click
MoveCopyFiles(True, sender, Nothing, Nothing) MoveCopyFiles(True, sender, Nothing, Nothing)
End Sub End Sub
Private Sub BTT_COPY_MOVE_SPEC_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_SPEC_TO.Click, BTT_MOVE_SPEC_TO.Click Private Sub BTT_COPY_MOVE_SPEC_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_SPEC_TO.Click, BTT_MOVE_SPEC_TO.Click
@@ -604,7 +703,7 @@ Namespace DownloadObjects
ByVal FeedMediaData As FeedMedia, Optional ByVal GetChecked As Boolean = True) As Boolean ByVal FeedMediaData As FeedMedia, Optional ByVal GetChecked As Boolean = True) As Boolean
Dim MsgTitle$ = "Copy/Move checked files" Dim MsgTitle$ = "Copy/Move checked files"
Try Try
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso (Sender Is BTT_COPY_TO OrElse Sender Is BTT_COPY_SPEC_TO) Dim isCopy As Boolean = Not Sender Is Nothing AndAlso (Sender Is BTT_COPY_TO OrElse Sender Is BTT_COPY_SPEC_TO OrElse Sender Is BTT_COPY_SELECTED_T)
Dim moveOptions As FeedMoveCopyTo = Nothing Dim moveOptions As FeedMoveCopyTo = Nothing
Dim ff As SFile = Nothing, ffInit As SFile = Nothing, df As SFile = Nothing Dim ff As SFile = Nothing, ffInit As SFile = Nothing, df As SFile = Nothing
Dim data As IEnumerable(Of UserMediaD) = Nothing Dim data As IEnumerable(Of UserMediaD) = Nothing
@@ -967,10 +1066,13 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Load fav, spec" #Region "Load fav, spec"
Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click, BTT_LOAD_FAV_T.Click
FeedChangeMode(FeedModes.Special, {FeedSpecial.FavoriteName}) FeedChangeMode(FeedModes.Special, {FeedSpecial.FavoriteName})
RefillSpecialFeedsData(False) RefillSpecialFeedsData(False)
End Sub End Sub
Private Sub BTT_LOAD_T_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_LOAD_T.MouseDown
If e.Button = MouseButtons.Right Then BTT_LOAD_SPEC_Click(sender, e)
End Sub
Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(False) With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then If .ListExists Then
@@ -1004,7 +1106,7 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Add remove fav spec" #Region "Add remove fav spec"
Private Sub BTT_FEED_ADD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_FAV.Click, BTT_FEED_ADD_FAV_REMOVE.Click Private Sub BTT_FEED_ADD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_FAV.Click, BTT_FEED_ADD_FAV_REMOVE.Click, BTT_FAV_T.Click
Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If m.ListExists Then If m.ListExists Then
Settings.Feeds.Favorite.Add(m) Settings.Feeds.Favorite.Add(m)
@@ -1018,6 +1120,9 @@ Namespace DownloadObjects
If FeedMode = FeedModes.Special Then FeedRemoveCheckedMedia(m, {FeedSpecial.FavoriteName}.ToList,,, False) If FeedMode = FeedModes.Special Then FeedRemoveCheckedMedia(m, {FeedSpecial.FavoriteName}.ToList,,, False)
End If End If
End Sub End Sub
Private Sub BTT_FEED_ADD_T_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_FEED_ADD_T.MouseDown
If e.Button = MouseButtons.Right Then BTT_FEED_ADD_SPEC_Click(sender, e)
End Sub
Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click, BTT_FEED_ADD_SPEC_REMOVE.Click Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click, BTT_FEED_ADD_SPEC_REMOVE.Click
Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If c.ListExists Then If c.ListExists Then
@@ -1276,10 +1381,10 @@ Namespace DownloadObjects
End Try End Try
End Sub End Sub
#End Region #End Region
Private Sub BTT_CHECK_ALL_NONE_Click(sender As Object, e As EventArgs) Handles BTT_CHECK_ALL.Click, BTT_CHECK_NONE.Click, BTT_CHECK_INVERT.Click Private Sub BTT_CHECK_ALL_NONE_Click(sender As Object, e As EventArgs) Handles BTT_CHECK_ALL.Click, BTT_CHECK_NONE.Click, BTT_CHECK_INVERT.Click, BTT_SELECT_ALL_T.Click, BTT_SELECT_NONE_T.Click, BTT_INVERT_T.Click
Try Try
Dim checked As Boolean = sender Is BTT_CHECK_ALL Dim checked As Boolean = sender Is BTT_CHECK_ALL Or sender Is BTT_SELECT_ALL_T
Dim isInvert As Boolean = sender Is BTT_CHECK_INVERT Dim isInvert As Boolean = sender Is BTT_CHECK_INVERT Or sender Is BTT_INVERT_T
ControlInvokeFast(TP_DATA, Sub() ControlInvokeFast(TP_DATA, Sub()
With TP_DATA With TP_DATA
If .Controls.Count > 0 Then If .Controls.Count > 0 Then

View File

@@ -18,24 +18,28 @@ Namespace DownloadObjects
Private Const Name_Types As String = "Types" Private Const Name_Types As String = "Types"
Private Const Name_Users As String = "Users" Private Const Name_Users As String = "Users"
Private Const Name_Sites As String = "Sites" Private Const Name_Sites As String = "Sites"
Private Const Name_Labels As String = "Labels"
#End Region #End Region
#Region "Properties" #Region "Properties"
Friend Property Name As String Friend Property Name As String
Friend ReadOnly Property Types As List(Of UTypes) Friend ReadOnly Property Types As List(Of UTypes)
Friend ReadOnly Property Users As List(Of UserInfo) Friend ReadOnly Property Users As List(Of UserInfo)
Friend ReadOnly Property Sites As List(Of String) Friend ReadOnly Property Sites As List(Of String)
Friend ReadOnly Property Labels As List(Of String)
#End Region #End Region
#Region "Initializers" #Region "Initializers"
Friend Sub New() Friend Sub New()
Types = New List(Of UTypes) Types = New List(Of UTypes)
Users = New List(Of UserInfo) Users = New List(Of UserInfo)
Sites = New List(Of String) Sites = New List(Of String)
Labels = New List(Of String)
End Sub End Sub
Friend Sub New(ByVal e As EContainer) Friend Sub New(ByVal e As EContainer)
Me.New Me.New
Name = e.Value(Name_Name) Name = e.Value(Name_Name)
Types.ListAddList(e.Value(Name_Types).StringToList(Of Integer)(",")) Types.ListAddList(e.Value(Name_Types).StringToList(Of Integer)(","))
Sites.ListAddList(e.Value(Name_Sites).StringToList(Of String)("|")) Sites.ListAddList(e.Value(Name_Sites).StringToList(Of String)("|"))
Labels.ListAddList(e.Value(Name_Labels).StringToList(Of String)("|"))
If If(e(Name_Users)?.Count, 0) > 0 Then If If(e(Name_Users)?.Count, 0) > 0 Then
Users.ListAddList(e(Name_Users), LAP.IgnoreICopier) Users.ListAddList(e(Name_Users), LAP.IgnoreICopier)
Users.RemoveAll(Function(u) Not u.File.Exists) Users.RemoveAll(Function(u) Not u.File.Exists)
@@ -75,8 +79,9 @@ Namespace DownloadObjects
ee.Add(New EContainer(Name_Name, Name)) ee.Add(New EContainer(Name_Name, Name))
ee.Add(New EContainer(Name_Types, Types.ListToString(","))) ee.Add(New EContainer(Name_Types, Types.ListToString(",")))
ee.Add(New EContainer(Name_Sites, Sites.ListToString("|"))) ee.Add(New EContainer(Name_Sites, Sites.ListToString("|")))
ee.Add(New EContainer(Name_Labels, Labels.ListToString("|")))
If Users.Count > 0 Then If Users.Count > 0 Then
ee.Add(New EContainer(Name_Users, String.Empty)) ee.Add(New EContainer(Name_Users, String.Empty) With {.AllowSameNames = True})
ee(Name_Users).AddRange(Users) ee(Name_Users).AddRange(Users)
End If End If
Return ee Return ee
@@ -95,6 +100,8 @@ Namespace DownloadObjects
Users.ListAddList(.Users, LAP.NotContainsOnly) Users.ListAddList(.Users, LAP.NotContainsOnly)
Sites.Clear() Sites.Clear()
Sites.ListAddList(.Sites, LAP.NotContainsOnly) Sites.ListAddList(.Sites, LAP.NotContainsOnly)
Labels.Clear()
Labels.ListAddList(.Labels, LAP.NotContainsOnly)
End With End With
Return Me Return Me
End Function End Function
@@ -126,8 +133,15 @@ Namespace DownloadObjects
End Get End Get
Set(ByVal f As FeedFilter) Set(ByVal f As FeedFilter)
_TEMP = f _TEMP = f
If _TEMP Is Nothing And _CurrentFilterName.IsEmptyString And Not _CurrentFilterNameLast.IsEmptyString Then _ If _TEMP Is Nothing Then
_CurrentFilterName = _CurrentFilterNameLast If Not _CurrentFilterNameLast.IsEmptyString Then
_CurrentFilterName = _CurrentFilterNameLast
Else
_CurrentFilterName = String.Empty
End If
Else
_CurrentFilterName = String.Empty
End If
End Set End Set
End Property End Property
Friend ReadOnly Property Current(Optional ByVal Any As Boolean = True, Optional ByVal GetTemp As Boolean = True) As FeedFilter Friend ReadOnly Property Current(Optional ByVal Any As Boolean = True, Optional ByVal GetTemp As Boolean = True) As FeedFilter

View File

@@ -30,6 +30,8 @@ Namespace DownloadObjects
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(FeedFilterForm)) Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(FeedFilterForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel() Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.CH_T_ALL = New System.Windows.Forms.CheckBox() Me.CH_T_ALL = New System.Windows.Forms.CheckBox()
Me.CH_T_IMG = New System.Windows.Forms.CheckBox() Me.CH_T_IMG = New System.Windows.Forms.CheckBox()
@@ -43,6 +45,7 @@ Namespace DownloadObjects
Me.LIST_USERS = New System.Windows.Forms.CheckedListBox() Me.LIST_USERS = New System.Windows.Forms.CheckedListBox()
Me.TXT_NAME = New PersonalUtilities.Forms.Controls.TextBoxExtended() Me.TXT_NAME = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_SITE = New PersonalUtilities.Forms.Controls.TextBoxExtended() Me.TXT_SITE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_LABELS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_TYPES = New System.Windows.Forms.TableLayoutPanel() TP_TYPES = New System.Windows.Forms.TableLayoutPanel()
TP_USERS = New System.Windows.Forms.TableLayoutPanel() TP_USERS = New System.Windows.Forms.TableLayoutPanel()
@@ -55,6 +58,7 @@ Namespace DownloadObjects
TP_USERS_2.SuspendLayout() TP_USERS_2.SuspendLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout() Me.SuspendLayout()
' '
'CONTAINER_MAIN 'CONTAINER_MAIN
@@ -78,16 +82,18 @@ Namespace DownloadObjects
Me.TP_MAIN.ColumnCount = 1 Me.TP_MAIN.ColumnCount = 1
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Controls.Add(TP_TYPES, 0, 1) Me.TP_MAIN.Controls.Add(TP_TYPES, 0, 1)
Me.TP_MAIN.Controls.Add(TP_USERS, 0, 3) Me.TP_MAIN.Controls.Add(TP_USERS, 0, 4)
Me.TP_MAIN.Controls.Add(Me.TXT_NAME, 0, 0) Me.TP_MAIN.Controls.Add(Me.TXT_NAME, 0, 0)
Me.TP_MAIN.Controls.Add(Me.TXT_SITE, 0, 2) Me.TP_MAIN.Controls.Add(Me.TXT_SITE, 0, 2)
Me.TP_MAIN.Controls.Add(Me.TXT_LABELS, 0, 3)
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0) Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Name = "TP_MAIN" Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 4 Me.TP_MAIN.RowCount = 5
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(522, 336) Me.TP_MAIN.Size = New System.Drawing.Size(522, 336)
Me.TP_MAIN.TabIndex = 0 Me.TP_MAIN.TabIndex = 0
@@ -178,13 +184,13 @@ Namespace DownloadObjects
TP_USERS.Controls.Add(TP_USERS_2, 0, 0) TP_USERS.Controls.Add(TP_USERS_2, 0, 0)
TP_USERS.Controls.Add(Me.LIST_USERS, 0, 1) TP_USERS.Controls.Add(Me.LIST_USERS, 0, 1)
TP_USERS.Dock = System.Windows.Forms.DockStyle.Fill TP_USERS.Dock = System.Windows.Forms.DockStyle.Fill
TP_USERS.Location = New System.Drawing.Point(0, 81) TP_USERS.Location = New System.Drawing.Point(0, 109)
TP_USERS.Margin = New System.Windows.Forms.Padding(0) TP_USERS.Margin = New System.Windows.Forms.Padding(0)
TP_USERS.Name = "TP_USERS" TP_USERS.Name = "TP_USERS"
TP_USERS.RowCount = 2 TP_USERS.RowCount = 2
TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_USERS.Size = New System.Drawing.Size(522, 255) TP_USERS.Size = New System.Drawing.Size(522, 227)
TP_USERS.TabIndex = 3 TP_USERS.TabIndex = 3
' '
'TP_USERS_2 'TP_USERS_2
@@ -206,7 +212,7 @@ Namespace DownloadObjects
TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_USERS_2.Size = New System.Drawing.Size(522, 25) TP_USERS_2.Size = New System.Drawing.Size(522, 25)
TP_USERS_2.TabIndex = 0 TP_USERS_2.TabIndex = 4
' '
'CH_U_USE 'CH_U_USE
' '
@@ -258,8 +264,8 @@ Namespace DownloadObjects
Me.LIST_USERS.FormattingEnabled = True Me.LIST_USERS.FormattingEnabled = True
Me.LIST_USERS.Location = New System.Drawing.Point(3, 28) Me.LIST_USERS.Location = New System.Drawing.Point(3, 28)
Me.LIST_USERS.Name = "LIST_USERS" Me.LIST_USERS.Name = "LIST_USERS"
Me.LIST_USERS.Size = New System.Drawing.Size(516, 224) Me.LIST_USERS.Size = New System.Drawing.Size(516, 196)
Me.LIST_USERS.TabIndex = 1 Me.LIST_USERS.TabIndex = 5
' '
'TXT_NAME 'TXT_NAME
' '
@@ -298,6 +304,25 @@ Namespace DownloadObjects
Me.TXT_SITE.TabIndex = 2 Me.TXT_SITE.TabIndex = 2
Me.TXT_SITE.TextBoxReadOnly = True Me.TXT_SITE.TextBoxReadOnly = True
' '
'TXT_LABELS
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Edit"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Edit
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Name = "Clear"
ActionButton5.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_LABELS.Buttons.Add(ActionButton4)
Me.TXT_LABELS.Buttons.Add(ActionButton5)
Me.TXT_LABELS.CaptionText = "Labels"
Me.TXT_LABELS.CaptionWidth = 40.0R
Me.TXT_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_LABELS.Location = New System.Drawing.Point(3, 84)
Me.TXT_LABELS.Name = "TXT_LABELS"
Me.TXT_LABELS.Size = New System.Drawing.Size(516, 22)
Me.TXT_LABELS.TabIndex = 3
Me.TXT_LABELS.TextBoxReadOnly = True
'
'FeedFilterForm 'FeedFilterForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -317,6 +342,7 @@ Namespace DownloadObjects
TP_USERS_2.PerformLayout() TP_USERS_2.PerformLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False) Me.ResumeLayout(False)
End Sub End Sub
@@ -333,5 +359,6 @@ Namespace DownloadObjects
Private WithEvents TXT_NAME As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_NAME As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TP_MAIN As TableLayoutPanel Private WithEvents TP_MAIN As TableLayoutPanel
Private WithEvents TXT_SITE As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_SITE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_LABELS As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class End Class
End Namespace End Namespace

View File

@@ -133,7 +133,7 @@
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25 wgAADsIBFShKgAAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2 DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value> </value>
@@ -185,7 +185,7 @@
RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP
lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l
f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK
j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEwAACxMBAJqcGAAAAZlJREFUOE9j+P//PwOp j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEQAACxEBf2RfkQAAAZlJREFUOE9j+P//PwOp
eL2joz2MjSGJDztZWbGtcHTcuNrB4dx8W9tikgwQVxVnPXRo/9ObXZ3/7+bl/l/l7PxxkY1NJIZCbNhc eL2joz2MjSGJDztZWbGtcHTcuNrB4dx8W9tikgwQVxVnPXRo/9ObXZ3/7+bl/l/l7PxxkY1NJIZCbNhc
U5Q9ozX9f/fS/v+vXr76f3XmzP9LPDxOMjAwqGIoRsc60iysF5ZFfd25acl/wxKX/w1T6n+uXbvm+9T+ U5Q9ozX9f/fS/v+vXr76f3XmzP9LPDxOMjAwqGIoRsc60iysF5ZFfd25acl/wxKX/w1T6n+uXbvm+9T+
xiCQPIYGZKwhzsh0ZHbg189X2////3/gJ8gQkEtgmvEaIM/PwLJzgvfnd+ea/v//sf7/10ed/3qyTFA0 xiCQPIYGZKwhzsh0ZHbg189X2////3/gJ8gQkEtgmvEaIM/PwLJzgvfnd+ea/v//sf7/10ed/3qyTFA0
@@ -198,7 +198,72 @@
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25 wgAADsIBFShKgAAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAACH
DwAAjA8AAP1SAACBQAAAfXkAAOmLAAA85QAAGcxzPIV3AAAKOWlDQ1BQaG90b3Nob3AgSUNDIHByb2Zp
bGUAAEjHnZZ3VFTXFofPvXd6oc0w0hl6ky4wgPQuIB0EURhmBhjKAMMMTWyIqEBEEREBRZCggAGjoUis
iGIhKKhgD0gQUGIwiqioZEbWSnx5ee/l5ffHvd/aZ+9z99l7n7UuACRPHy4vBZYCIJkn4Ad6ONNXhUfQ
sf0ABniAAaYAMFnpqb5B7sFAJC83F3q6yAn8i94MAUj8vmXo6U+ng/9P0qxUvgAAyF/E5mxOOkvE+SJO
yhSkiu0zIqbGJIoZRomZL0pQxHJijlvkpZ99FtlRzOxkHlvE4pxT2clsMfeIeHuGkCNixEfEBRlcTqaI
b4tYM0mYzBXxW3FsMoeZDgCKJLYLOKx4EZuImMQPDnQR8XIAcKS4LzjmCxZwsgTiQ7mkpGbzuXHxArou
S49uam3NoHtyMpM4AoGhP5OVyOSz6S4pyalMXjYAi2f+LBlxbemiIluaWltaGpoZmX5RqP+6+Dcl7u0i
vQr43DOI1veH7a/8UuoAYMyKarPrD1vMfgA6tgIgd/8Pm+YhACRFfWu/8cV5aOJ5iRcIUm2MjTMzM424
HJaRuKC/6386/A198T0j8Xa/l4fuyollCpMEdHHdWClJKUI+PT2VyeLQDf88xP848K/zWBrIieXwOTxR
RKhoyri8OFG7eWyugJvCo3N5/6mJ/zDsT1qca5Eo9Z8ANcoISN2gAuTnPoCiEAESeVDc9d/75oMPBeKb
F6Y6sTj3nwX9+65wifiRzo37HOcSGExnCfkZi2viawnQgAAkARXIAxWgAXSBITADVsAWOAI3sAL4gWAQ
DtYCFogHyYAPMkEu2AwKQBHYBfaCSlAD6kEjaAEnQAc4DS6Ay+A6uAnugAdgBIyD52AGvAHzEARhITJE
geQhVUgLMoDMIAZkD7lBPlAgFA5FQ3EQDxJCudAWqAgqhSqhWqgR+hY6BV2ArkID0D1oFJqCfoXewwhM
gqmwMqwNG8MM2An2hoPhNXAcnAbnwPnwTrgCroOPwe3wBfg6fAcegZ/DswhAiAgNUUMMEQbigvghEUgs
wkc2IIVIOVKHtCBdSC9yCxlBppF3KAyKgqKjDFG2KE9UCIqFSkNtQBWjKlFHUe2oHtQt1ChqBvUJTUYr
oQ3QNmgv9Cp0HDoTXYAuRzeg29CX0HfQ4+g3GAyGhtHBWGE8MeGYBMw6TDHmAKYVcx4zgBnDzGKxWHms
AdYO64dlYgXYAux+7DHsOewgdhz7FkfEqeLMcO64CBwPl4crxzXhzuIGcRO4ebwUXgtvg/fDs/HZ+BJ8
Pb4LfwM/jp8nSBN0CHaEYEICYTOhgtBCuER4SHhFJBLVidbEACKXuIlYQTxOvEIcJb4jyZD0SS6kSJKQ
tJN0hHSedI/0ikwma5MdyRFkAXknuZF8kfyY/FaCImEk4SXBltgoUSXRLjEo8UISL6kl6SS5VjJHslzy
pOQNyWkpvJS2lIsUU2qDVJXUKalhqVlpirSptJ90snSxdJP0VelJGayMtoybDFsmX+awzEWZMQpC0aC4
UFiULZR6yiXKOBVD1aF6UROoRdRvqP3UGVkZ2WWyobJZslWyZ2RHaAhNm+ZFS6KV0E7QhmjvlygvcVrC
WbJjScuSwSVzcopyjnIcuUK5Vrk7cu/l6fJu8onyu+U75B8poBT0FQIUMhUOKlxSmFakKtoqshQLFU8o
3leClfSVApXWKR1W6lOaVVZR9lBOVd6vfFF5WoWm4qiSoFKmclZlSpWiaq/KVS1TPaf6jC5Ld6In0Svo
PfQZNSU1TzWhWq1av9q8uo56iHqeeqv6Iw2CBkMjVqNMo1tjRlNV01czV7NZ874WXouhFa+1T6tXa05b
RztMe5t2h/akjpyOl06OTrPOQ12yroNumm6d7m09jB5DL1HvgN5NfVjfQj9ev0r/hgFsYGnANThgMLAU
vdR6KW9p3dJhQ5Khk2GGYbPhqBHNyMcoz6jD6IWxpnGE8W7jXuNPJhYmSSb1Jg9MZUxXmOaZdpn+aqZv
xjKrMrttTjZ3N99o3mn+cpnBMs6yg8vuWlAsfC22WXRbfLS0suRbtlhOWWlaRVtVWw0zqAx/RjHjijXa
2tl6o/Vp63c2ljYCmxM2v9ga2ibaNtlOLtdZzllev3zMTt2OaVdrN2JPt4+2P2Q/4qDmwHSoc3jiqOHI
dmxwnHDSc0pwOub0wtnEme/c5jznYuOy3uW8K+Lq4Vro2u8m4xbiVun22F3dPc692X3Gw8Jjncd5T7Sn
t+duz2EvZS+WV6PXzAqrFetX9HiTvIO8K72f+Oj78H26fGHfFb57fB+u1FrJW9nhB/y8/Pb4PfLX8U/z
/z4AE+AfUBXwNNA0MDewN4gSFBXUFPQm2Dm4JPhBiG6IMKQ7VDI0MrQxdC7MNaw0bGSV8ar1q66HK4Rz
wzsjsBGhEQ0Rs6vdVu9dPR5pEVkQObRGZ03WmqtrFdYmrT0TJRnFjDoZjY4Oi26K/sD0Y9YxZ2O8Yqpj
ZlgurH2s52xHdhl7imPHKeVMxNrFlsZOxtnF7YmbineIL4+f5rpwK7kvEzwTahLmEv0SjyQuJIUltSbj
kqOTT/FkeIm8nhSVlKyUgVSD1ILUkTSbtL1pM3xvfkM6lL4mvVNAFf1M9Ql1hVuFoxn2GVUZbzNDM09m
SWfxsvqy9bN3ZE/kuOd8vQ61jrWuO1ctd3Pu6Hqn9bUboA0xG7o3amzM3zi+yWPT0c2EzYmbf8gzySvN
e70lbEtXvnL+pvyxrR5bmwskCvgFw9tst9VsR23nbu/fYb5j/45PhezCa0UmReVFH4pZxde+Mv2q4quF
nbE7+0ssSw7uwuzi7Rra7bD7aKl0aU7p2B7fPe1l9LLCstd7o/ZeLV9WXrOPsE+4b6TCp6Jzv+b+Xfs/
VMZX3qlyrmqtVqreUT13gH1g8KDjwZYa5ZqimveHuIfu1nrUttdp15UfxhzOOPy0PrS+92vG140NCg1F
DR+P8I6MHA082tNo1djYpNRU0gw3C5unjkUeu/mN6zedLYYtta201qLj4Ljw+LNvo78dOuF9ovsk42TL
d1rfVbdR2grbofbs9pmO+I6RzvDOgVMrTnV32Xa1fW/0/ZHTaqerzsieKTlLOJt/duFczrnZ86nnpy/E
XRjrjup+cHHVxds9AT39l7wvXbnsfvlir1PvuSt2V05ftbl66hrjWsd1y+vtfRZ9bT9Y/NDWb9nffsPq
RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP
lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l
f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK
j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEAAACxABrSO9dQAAAZlJREFUOE9j+P//PwOp
eL2joz2MjSGJDztZWbGtcHTcuNrB4dx8W9tikgwQVxVnPXRo/9ObXZ3/7+bl/l/l7PxxkY1NJIZCbNhc
U5Q9ozX9f/fS/v+vXr76f3XmzP9LPDxOMjAwqGIoRsc60iysF5ZFfd25acl/wxKX/w1T6n+uXbvm+9T+
xiCQPIYGZKwhzsh0ZHbg189X2////3/gJ8gQkEtgmvEaIM/PwLJzgvfnd+ea/v//sf7/10ed/3qyTFA0
4zRAhoeBeXOn66c3J2r+//+64v+3B23/sWnGaoA0DwPbumbHT4/35v///23R/x/363FqxjBAWZSDeU6h
xdt727P+/38z8f/XO5V4NaMYICXAwbyuKeLW9Q0J//6/7vn/80YeQc0oBiyrdVh9c33B9//32159vZr2
hxjNcAPUZQTd766v+f3/4uz/n3Y1/19S6feSGM1gA1iZGPgXVQef/H+i7//xqWm/JlVG3CRWM9gAIwO9
xl1T8/83xVufE+fnqEBXQAgzKCmrXJGVkmhjYGDQR5ckBgMAtlm0SiCu/g8AAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wQAADsEBuJFr7QAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2 DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value> </value>

View File

@@ -6,6 +6,7 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base Imports PersonalUtilities.Forms.Controls.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
@@ -105,6 +106,7 @@ Namespace DownloadObjects
End If End If
UpdateSitesText() UpdateSitesText()
UpdateLabelsText()
.EndLoaderOperations() .EndLoaderOperations()
RefillList(True) RefillList(True)
@@ -143,21 +145,29 @@ Namespace DownloadObjects
Return DirectCast(Obj, DataUserTmp).UserInfo Return DirectCast(Obj, DataUserTmp).UserInfo
End Function End Function
End Structure End Structure
Private SitePredicate As Predicate(Of IUserData) = Function(d) MyFilter.Sites.Count = 0 OrElse MyFilter.Sites.Contains(d.Site)
Private LabelPredicate As Predicate(Of IUserData) = Function(d) MyFilter.Labels.Count = 0 OrElse MyFilter.Labels.ListContains(d.Labels)
Private Sub RefillList(Optional ByVal Init As Boolean = False) Private Sub RefillList(Optional ByVal Init As Boolean = False)
If Not MyDefs.Initializing Then If Not MyDefs.Initializing Then
If Not Init Then ApplyFilter() If Not Init Then ApplyFilter()
LIST_USERS.Items.Clear() LIST_USERS.Items.Clear()
Dim dataUsers As New List(Of DataUserTmp) Dim dataUsers As New List(Of DataUserTmp)
If CH_U_SHOW_ALL.Checked Or MyData.Count = 0 Then If CH_U_SHOW_ALL.Checked Or MyData.Count = 0 Then
dataUsers.ListAddList(Settings.UsersList) 'dataUsers.ListAddList(Settings.UsersList)
Else If Settings.Users.Count > 0 Then dataUsers.ListAddList(From __d As IUserData In Settings.GetUsers(Function(____d) True)
dataUsers.ListAddList(MyData.Select(Function(d) d.UserInfo), LAP.NotContainsOnly) Where SitePredicate(__d) And LabelPredicate(__d)
Select DirectCast(__d, UserDataBase).User)
ElseIf MyData.Count > 0 Then
'dataUsers.ListAddList(MyData.Select(Function(d) d.UserInfo), LAP.NotContainsOnly)
dataUsers.ListAddList((From __d As IUserData In MyData.Select(Function(____d) ____d.User)
Where SitePredicate(__d) And LabelPredicate(__d)
Select DirectCast(__d, UserDataBase).User), LAP.NotContainsOnly)
End If End If
Dim i% Dim i%
If dataUsers.Count > 0 Then If dataUsers.Count > 0 Then
dataUsers.Sort() dataUsers.Sort()
With MyFilter With MyFilter
If .Sites.Count > 0 Then dataUsers.RemoveAll(Function(d) Not .Sites.Contains(d.UserInfo.Site)) 'If .Sites.Count > 0 Then dataUsers.RemoveAll(Function(d) Not .Sites.Contains(d.UserInfo.Site))
If dataUsers.Count > 0 Then If dataUsers.Count > 0 Then
dataUsers.ForEach(Sub(d) LIST_USERS.Items.Add(d, True)) dataUsers.ForEach(Sub(d) LIST_USERS.Items.Add(d, True))
If .Users.Count > 0 Then If .Users.Count > 0 Then
@@ -243,10 +253,30 @@ Namespace DownloadObjects
End Select End Select
If refill Then RefillList() If refill Then RefillList()
End Sub End Sub
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As Object, ByVal e As ActionButtonEventArgs) Handles TXT_LABELS.ActionOnButtonClick
Dim refill As Boolean = False
Select Case e.DefaultButton
Case ActionButton.DefaultButtons.Edit
Using f As New LabelsForm(MyFilter.Labels, False)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
refill = Not MyFilter.Labels.ListEquals(f.LabelsList)
MyFilter.Labels.ListAddList(f.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
UpdateLabelsText()
End If
End Using
Case ActionButton.DefaultButtons.Clear : refill = MyFilter.Labels.Count > 0 : MyFilter.Labels.Clear() : UpdateLabelsText()
End Select
If refill Then RefillList()
End Sub
Private Sub UpdateSitesText() Private Sub UpdateSitesText()
TXT_SITE.Clear() TXT_SITE.Clear()
TXT_SITE.Text = MyFilter.Sites.ListToString TXT_SITE.Text = MyFilter.Sites.ListToString
End Sub End Sub
Private Sub UpdateLabelsText()
TXT_LABELS.Clear()
TXT_LABELS.Text = MyFilter.Labels.ListToString
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -12,6 +12,7 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD
Imports ImageRenderer2 = SCrawler.UserImage.ImageRenderer2
Namespace DownloadObjects Namespace DownloadObjects
<ToolboxItem(False), DesignTimeVisible(False)> <ToolboxItem(False), DesignTimeVisible(False)>
Public Class FeedMedia Public Class FeedMedia
@@ -154,10 +155,12 @@ Namespace DownloadObjects
End Function End Function
#End Region #End Region
#Region "Initializers" #Region "Initializers"
Private Sub FileCheckSpecialFolders(ByRef f As SFile, ByVal ExtractText As Boolean) Private Sub FileCheckSpecialFolders(ByRef f As SFile, ByVal ExtractText As Boolean, ByVal OrigFile As SFile)
If Not File.Exists Then If Not File.Exists Then
If ExtractText Then If ExtractText Then
f.Path = $"{File.Path.CSFilePS}{UserDataBase.PostTextSpecialFolderDefault}" f.Path = $"{File.Path.CSFilePS}{UserDataBase.PostTextSpecialFolderDefault}"
If Not f.Exists Then f.Path = OrigFile.Path
If Not f.Exists Then f.Path = $"{OrigFile.Path.CSFilePS}{UserDataBase.PostTextSpecialFolderDefault}"
ElseIf Media.Data.Type = UserMedia.Types.Video Then ElseIf Media.Data.Type = UserMedia.Types.Video Then
f.Path = $"{File.Path.CSFilePS}Video" f.Path = $"{File.Path.CSFilePS}Video"
End If End If
@@ -166,42 +169,6 @@ Namespace DownloadObjects
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
End Sub End Sub
Private Class ImageRenderer2 : Inherits ImageRenderer
Friend NativeFormat As String = Nothing
Friend ImgErr As Exception = Nothing
Friend Sub New(ByVal ImgPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing)
MyBase.New()
Try
If ImgPath.Exists(SFO.File, False) Then
OriginalImageBytes = SFile.GetBytes(ImgPath, EDP.ThrowException)
Try
OriginalImage = GetImage(OriginalImageBytes)
Catch exInternal As Exception
HasError = True
ImgErr = exInternal
NativeFormat = GetTrueFormat(OriginalImageBytes, EDP.ReturnValue)
End Try
End If
Address = ImgPath
Catch ex As Exception
HasError = True
NativeFormat = GetTrueFormat(OriginalImageBytes, EDP.ReturnValue)
If Not e.Exists Then e = EDP.ThrowException
ErrorsDescriber.Execute(e, ex, $"ImageRenderer2.New({ImgPath})")
End Try
End Sub
Friend Shared Function GetTrueFormat(ByVal Img() As Byte, Optional ByVal e As ErrorsDescriber = Nothing) As String
Try
Using ms As New MemoryStream(Img, 0, Img.Length)
Return System.Windows.Media.Imaging.BitmapDecoder.Create(ms, Windows.Media.Imaging.BitmapCreateOptions.PreservePixelFormat,
Windows.Media.Imaging.BitmapCacheOption.OnLoad).Metadata.Format
End Using
Catch ex As Exception
If Not e.Exists Then e = EDP.ThrowException
Return ErrorsDescriber.Execute(e, ex, "[ImageRenderer2.GetTrueFormat()]")
End Try
End Function
End Class
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer, ByVal IsSession As Boolean, ByVal ExtractText As Boolean) Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer, ByVal IsSession As Boolean, ByVal ExtractText As Boolean)
Try Try
InitializeComponent() InitializeComponent()
@@ -239,7 +206,17 @@ Namespace DownloadObjects
End With End With
If Not imgFile.Exists Then If Not imgFile.Exists Then
Settings.Cache.Validate() Settings.Cache.Validate()
If GetWebFile(Media.Data.URL, imgFile, EDP.None) AndAlso imgFile.Exists Then File = UserImage.ConvertWebp(imgFile, Nothing) If GetWebFile(Media.Data.URL, imgFile, EDP.None) AndAlso imgFile.Exists Then
File = UserImage.ConvertWebp(imgFile, Nothing)
ElseIf Not IsNothing(Media.Data.Object) AndAlso TypeOf Media.Data.Object Is IThumbList AndAlso
DirectCast(Media.Data.Object, IThumbList).Thumbs.ListExists Then
With DirectCast(Media.Data.Object, IThumbList).Thumbs
For Each __tmpUrl$ In .Self
If GetWebFile(__tmpUrl, imgFile, EDP.None) AndAlso imgFile.Exists Then _
File = UserImage.ConvertWebp(imgFile, Nothing) : Exit For
Next
End With
End If
Else Else
File = imgFile File = imgFile
End If End If
@@ -249,18 +226,18 @@ Namespace DownloadObjects
LBL_TITLE.Dispose() LBL_TITLE.Dispose()
TP_MAIN.RowStyles(1).Height = 0 TP_MAIN.RowStyles(1).Height = 0
File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File) File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File)
FileCheckSpecialFolders(File, ExtractText) FileCheckSpecialFolders(File, ExtractText, Media.Data.File)
End If End If
If Not File.Exists And Not IsSubscription Then If Not File.Exists And Not IsSubscription Then
If Not Media.Data.SpecialFolder.IsEmptyString Then If Not Media.Data.SpecialFolder.IsEmptyString Then
File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File) File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File)
File.Path = $"{File.Path.CSFilePS}{Media.Data.SpecialFolder}".CSFileP File.Path = $"{File.Path.CSFilePS}{Media.Data.SpecialFolder}".CSFileP
FileCheckSpecialFolders(File, ExtractText) FileCheckSpecialFolders(File, ExtractText, Media.Data.File)
End If End If
End If End If
If File.Exists Then If File.Exists Or IsSubscription Then
Information = $"Type: {IIf(ExtractText, UserMedia.Types.Text.ToString, Media.Data.Type.ToString)}" Information = $"Type: {IIf(ExtractText, UserMedia.Types.Text.ToString, Media.Data.Type.ToString)}"
Information.StringAppendLine($"File: {File.File}") Information.StringAppendLine($"File: {File.File}")
Information.StringAppendLine($"Address: {File}") Information.StringAppendLine($"Address: {File}")
@@ -291,7 +268,7 @@ Namespace DownloadObjects
Dim webpConverted As Boolean = False Dim webpConverted As Boolean = False
Dim isWebp As Boolean = False Dim isWebp As Boolean = False
tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing,,, webpConverted) tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing,,, webpConverted)
If tmpMediaFile.IsEmptyString Then Throw New ArgumentNullException With {.HelpLink = 1} If tmpMediaFile.IsEmptyString And Not IsSubscription Then Throw New ArgumentNullException With {.HelpLink = 1}
Try Try
For kConv As Byte = 0 To 1 For kConv As Byte = 0 To 1
If kConv = 1 Then tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing, True, isWebp, webpConverted) If kConv = 1 Then tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing, True, isWebp, webpConverted)

View File

@@ -250,7 +250,14 @@ Namespace Editors
MyDefs = New DefaultFormOptions(Me, Settings.Design) MyDefs = New DefaultFormOptions(Me, Settings.Design)
Host = h Host = h
CookiesControlsInteraction = New List(Of PropertyValueHost) CookiesControlsInteraction = New List(Of PropertyValueHost)
If Not Host.Responser Is Nothing Then Cookies = Host.Responser.Cookies.Copy If Not Host.Source Is Nothing AndAlso TypeOf Host.Source Is API.Base.SiteSettingsBase Then Cookies = DirectCast(Host.Source, API.Base.SiteSettingsBase).GetCookieKeeperInstance
If Not Host.Responser Is Nothing Then
If Cookies Is Nothing Then
Cookies = Host.Responser.Cookies.Copy
Else
Cookies.Copy(Host.Responser.Cookies)
End If
End If
LabelControls = New List(Of Label) LabelControls = New List(Of Label)
Host.BeginEdit() Host.BeginEdit()
End Sub End Sub

View File

@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below: ' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2026.2.14.0")> <Assembly: AssemblyVersion("2026.8.7.0")>
<Assembly: AssemblyFileVersion("2026.2.14.0")> <Assembly: AssemblyFileVersion("2026.8.7.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -194,6 +194,7 @@
<Compile Include="API\Base\TokenBatch.vb" /> <Compile Include="API\Base\TokenBatch.vb" />
<Compile Include="API\Base\YTDLP.vb" /> <Compile Include="API\Base\YTDLP.vb" />
<Compile Include="API\Bluesky\Declarations.vb" /> <Compile Include="API\Bluesky\Declarations.vb" />
<Compile Include="API\Bluesky\EditorExchangeOptions.vb" />
<Compile Include="API\Bluesky\M3U8.vb" /> <Compile Include="API\Bluesky\M3U8.vb" />
<Compile Include="API\Bluesky\SiteSettings.vb" /> <Compile Include="API\Bluesky\SiteSettings.vb" />
<Compile Include="API\Bluesky\UserData.vb" /> <Compile Include="API\Bluesky\UserData.vb" />

View File

@@ -150,4 +150,45 @@ Friend Class UserImage : Inherits ImageRenderer
Private Shared Function ConvertWebpTryImageMagick(ByVal InitFile As SFile, ByVal DestFile As SFile) As Boolean Private Shared Function ConvertWebpTryImageMagick(ByVal InitFile As SFile, ByVal DestFile As SFile) As Boolean
Return ImageRendererExt.ConvertWebp(InitFile, DestFile, EDP.SendToLog + EDP.ReturnValue) Return ImageRendererExt.ConvertWebp(InitFile, DestFile, EDP.SendToLog + EDP.ReturnValue)
End Function End Function
Friend Class ImageRenderer2 : Inherits ImageRenderer
Friend NativeFormat As String = Nothing
Friend ImgErr As Exception = Nothing
Friend ReadOnly Property IsWebP As Boolean
Get
Return NativeFormat.IfNullOrEmpty(ExtJpg).ToLower = ExtWebp
End Get
End Property
Friend Sub New(ByVal ImgPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing)
MyBase.New()
Try
If ImgPath.Exists(SFO.File, False) Then
OriginalImageBytes = SFile.GetBytes(ImgPath, EDP.ThrowException)
Try
OriginalImage = GetImage(OriginalImageBytes)
Catch exInternal As Exception
HasError = True
ImgErr = exInternal
NativeFormat = GetTrueFormat(OriginalImageBytes, EDP.ReturnValue)
End Try
End If
Address = ImgPath
Catch ex As Exception
HasError = True
NativeFormat = GetTrueFormat(OriginalImageBytes, EDP.ReturnValue)
If Not e.Exists Then e = EDP.ThrowException
ErrorsDescriber.Execute(e, ex, $"ImageRenderer2.New({ImgPath})")
End Try
End Sub
Friend Shared Function GetTrueFormat(ByVal Img() As Byte, Optional ByVal e As ErrorsDescriber = Nothing) As String
Try
Using ms As New MemoryStream(Img, 0, Img.Length)
Return System.Windows.Media.Imaging.BitmapDecoder.Create(ms, Windows.Media.Imaging.BitmapCreateOptions.PreservePixelFormat,
Windows.Media.Imaging.BitmapCacheOption.OnLoad).Metadata.Format
End Using
Catch ex As Exception
If Not e.Exists Then e = EDP.ThrowException
Return ErrorsDescriber.Execute(e, ex, "[ImageRenderer2.GetTrueFormat()]")
End Try
End Function
End Class
End Class End Class