2026.1.17.0

UserDataBase: move GLD functions from 'Twitter'
Instagram: add 'Reposts' and 'Likes' to the 'Sections' enum
OnlyFans: update the regex in 'DynamicRulesEnv'; handling error 502
PornHub: fix videos aren't downloading
ThreadsNet: add user name and description extraction
TikTok: fix downloading new videos; add downloading 'Stories' and 'Reposts'
Twitter: move GLD functions to 'UserDataBase'
Xhamster: fix a bug when adding new users; fix incorrect cache location
Download groups: add excluded groups
MainFrame: fix the 'Feed' tooltip
This commit is contained in:
Andy
2026-01-17 20:06:37 +03:00
parent 6d4380ccac
commit e6d5fc2b95
26 changed files with 458 additions and 159 deletions

View File

@@ -2,11 +2,32 @@
- [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`**
- 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.30.10**
- [YT-DLP](https://github.com/AAndyProgram/SCrawler/wiki/Settings#yt-dlp) - **2025.11.12**
- [Gallery-dl](https://github.com/AAndyProgram/SCrawler/wiki/Settings#gallery-dl) - **1.31.3**
- [YT-DLP](https://github.com/AAndyProgram/SCrawler/wiki/Settings#yt-dlp) - **2025.12.08**
- [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))
# 2026
## 2026.1.17.0
*2026-01-17*
- Add
- Sites:
- OnlyFans: handling error `502`
- Threads: user name and description extraction
- TikTok: **downloading `Stories` and `Reposts`**
- Download groups: excluded groups
- Updated
- yt-dlp up to version **2025.12.08**
- gallery-dl up to version **1.31.3**
- Fixed
- Sites:
- PornHub: videos aren't downloading
- TikTok: new videos aren't downloading
- xHamster: new users aren't added in some cases
# 2025
## 2025.11.25.0
@@ -1765,7 +1786,7 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
- Wrong some Reddit videos parsing
- Wrong some Reddit images parsing
# 1.0.0.0
## 1.0.0.0
*2021-12-07*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 25 KiB

After

Width:  |  Height:  |  Size: 26 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 36 KiB

After

Width:  |  Height:  |  Size: 38 KiB

View File

@@ -1439,6 +1439,16 @@ BlockNullPicture:
Cache.Validate()
Return Cache
End Function
#Region "GDL File Names"
Protected GDLFileNameProvider As ANumbers = Nothing
Protected Sub GDLResetFileNameProvider(Optional ByVal GroupSize As Integer? = Nothing)
GDLFileNameProvider = New ANumbers With {.FormatOptions = ANumbers.Options.FormatNumberGroup + ANumbers.Options.Groups}
GDLFileNameProvider.GroupSize = If(GroupSize, 3)
End Sub
Protected Function GDLRenameFile(ByVal Input As SFile, ByVal i As Integer) As SFile
Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(GDLFileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function
#End Region
#Region "DownloadSingleObject"
Protected IsSingleObjectDownload As Boolean = False
Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject
@@ -2453,6 +2463,7 @@ stxt:
_TempPostsList.Clear()
_MD5List.Clear()
TokenPersonal = Nothing
GDLFileNameProvider = Nothing
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()

View File

@@ -525,7 +525,7 @@ Namespace API.Instagram
Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser, WwwClaimUpdate)
End Sub
Friend Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : End Enum
Friend Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : Reposts : Likes : End Enum
Protected Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass"

View File

@@ -219,12 +219,12 @@ Namespace API.OnlyFans
DynamicRulesXml.Extension = "xml"
ReplacePattern_RepoToRaw = New RParams("(.*github.com/([^/]+)/([^/]+)/blob/(.+))", Nothing, 0,
RegexReturn.ReplaceChangeListMatch, EDP.ReturnValue) With {
.PatternReplacement = "https://raw.githubusercontent.com/{2}/{3}/{4}"}
.PatternReplacement = "https://raw.githubusercontent.com/{2}/{3}/refs/heads/{4}"}
ReplacePattern_JsonInfo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_JsonInfo.PatternReplacement = "https://github.com/{2}/{3}/latest-commit/{4}"
ReplacePattern_RawToRepo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_RawToRepo.Pattern = "(.*raw.githubusercontent.com/([^/]+)/([^/]+)/([^/]+)/(.+))"
ReplacePattern_RawToRepo.PatternReplacement = "https://github.com/{2}/{3}/blob/{4}/{5}"
ReplacePattern_RawToRepo.Pattern = "(.*raw.githubusercontent.com/([^/]+)/([^/]+)(/refs/heads)?/([^/]+)/(.+))"
ReplacePattern_RawToRepo.PatternReplacement = "https://github.com/{2}/{3}/blob/{5}/{6}"
ConfigRulesExtract = RParams.DMS("DYNAMIC_RULE"":(\{.+?\}[\r\n]+)", 1, RegexOptions.Singleline, EDP.ReturnValue)
OFLOG = New TextSaver($"LOGs\OF_{Now:yyyyMMdd_HHmmss}.txt") With {.LogMode = True, .AutoSave = True, .AutoClear = True}
AddHandler OFLOG.TextSaved, AddressOf OFLOG_TextSaved

View File

@@ -88,6 +88,7 @@ Namespace API.OnlyFans
Private _DownloadedPostsSession As Integer = 0
Private FunctionErr As Integer = FunctionErrDef
Private Const FunctionErrDef As Integer = -100
Private _TimelineDownloading As Boolean = False
Private Sub ValidateOFScraper()
_OFScraperExists = ACheck(MySettings.OFScraperPath.Value) AndAlso CStr(MySettings.OFScraperPath.Value).CSFile.Exists
End Sub
@@ -110,7 +111,9 @@ Namespace API.OnlyFans
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID")
End If
_TimelineDownloading = True
If MediaDownloadTimeline Then DownloadTimeline(IIf(IsSavedPosts, 0, String.Empty), Token)
_TimelineDownloading = False
If Not IsSavedPosts Then
If MediaDownloadStories And FunctionErr = FunctionErrDef Then DownloadStories(Token)
If MediaDownloadHighlights And FunctionErr = FunctionErrDef Then DownloadHighlights(Token)
@@ -827,6 +830,8 @@ Namespace API.OnlyFans
Return 3
ElseIf Responser.StatusCode = Net.HttpStatusCode.InternalServerError Then '500
Return 3
ElseIf Not _TimelineDownloading And Responser.StatusCode = Net.HttpStatusCode.BadGateway Then '502
Return 3
Else
Return 0
End If

View File

@@ -385,7 +385,7 @@ Namespace API.PornHub
If PersonType = PersonTypeCannel Then
l = l.ListTake(4, l.Count)
Else
l.RemoveAll(Function(uv) uv.UserRef.IsEmptyString OrElse Not uv.UserRef = usrRef)
l.RemoveAll(Function(uv) Not uv.UserRef.IsEmptyString AndAlso Not uv.UserRef = usrRef)
End If
ElseIf Type = VideoTypes.Favorite Then
l.RemoveAll(Function(uv) uv.Type = VideoTypes.Private)

View File

@@ -0,0 +1,17 @@
' 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 PersonalUtilities.Functions.RegularExpressions
Namespace API.ThreadsNet
Friend Module Declarations
Friend ReadOnly RegexUserID As RParams = RParams.DMS("""props"":\{[^\{\}]*?""user_id"":""(\d+)""", 1, EDP.ReturnValue)
Friend ReadOnly RegexUserName As RParams = RParams.DMS("\<meta property=""og:title"" content=""([^\>]+)""\s*/\>", 1, TitleHtmlConverter, EDP.ReturnValue)
Friend ReadOnly RegexUserDescr As RParams = RParams.DMS("\<meta property=""og:description"" content=""([^\>]+)""\s*/\>", 1, HtmlConverter, EDP.ReturnValue)
End Module
End Namespace

View File

@@ -388,8 +388,10 @@ Namespace API.ThreadsNet
Dim newID$
Dim idStr$ = String.Empty
If Not r.IsEmptyString Then
UserSiteNameUpdate(RegexReplace(r, RegexUserName))
UserDescriptionUpdate(RegexReplace(r, RegexUserDescr))
ParseTokens(r, 0)
newID = RegexReplace(r, RParams.DMS("""props"":\{[^\{\}]*?""user_id"":""(\d+)""", 1, EDP.ReturnValue))
newID = RegexReplace(r, RegexUserID)
If ID.IsEmptyString OrElse ID = newID Then
_IdChanged = ID.IsEmptyString
ID = newID

View File

@@ -11,6 +11,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok
Friend Module Declarations
Friend ReadOnly SimpleDateConverter As New ADateTime("yyyyMMdd")
Friend ReadOnly SimpleDateConverterWithTime As New ADateTime("yyyyMMdd_HHmmss")
Friend ReadOnly RegexTagsReplacer As RParams = RParams.DM("#\w+\s?", -1, RegexReturn.Replace,
CType(Function(input$) String.Empty, Func(Of String, String)), EDP.ReturnValue)
Friend ReadOnly RegexPhotoJson As RParams = RParams.DMS("UNIVERSAL_DATA_FOR_REHYDRATION__"" type=""application/json""\>([^\<]+)\<", 1,

View File

@@ -10,11 +10,13 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.TikTok
<Manifest("AndyProgram_TikTok"), SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Categories"
Private Const CAT_DOWN As String = "Download"
Private Const CAT_UserDefs_Title As String = DN.CAT_UserDefs & " (Title)"
#End Region
#Region "Download"
<PropertyOption(ControlText:="Download videos", Category:=CAT_DOWN), PXML, PClonable>
@@ -22,21 +24,34 @@ Namespace API.TikTok
<PropertyOption(ControlText:="Download photos", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadTTPhotos As PropertyValue
#End Region
<PropertyOption(ControlText:="Remove tags from title"), PXML, PClonable>
#Region "User defaults"
#Region "Sections"
<PropertyOption(ControlText:="Get Timeline", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get User Stories", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetStoriesUser As PropertyValue
<PropertyOption(ControlText:="Get Reposts", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetReposts As PropertyValue
#End Region
#Region "Title"
<PropertyOption(ControlText:="Remove tags from title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property RemoveTagsFromTitle As PropertyValue
<PropertyOption(ControlText:="Use native title", ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML, PClonable>
<PropertyOption(ControlText:="Use native title", ControlToolTip:="Use a user-created video title for the filename instead of the video ID.",
Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseNative As PropertyValue
<PropertyOption(ControlText:="Use native title (standalone downloader)",
ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML, PClonable>
ControlToolTip:="Use a user-created video title for the filename instead of the video ID.", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseNativeSTD As PropertyValue
<PropertyOption(ControlText:="Add video ID to video title"), PXML, PClonable>
<PropertyOption(ControlText:="Add video ID to video title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleAddVideoID As PropertyValue
<PropertyOption(ControlText:="Add video ID to video title (standalone downloader)"), PXML, PClonable>
<PropertyOption(ControlText:="Add video ID to video title (standalone downloader)", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleAddVideoIDSTD As PropertyValue
<PropertyOption(ControlText:="Use regex to clean video title"), PXML, PClonable>
<PropertyOption(ControlText:="Use regex to clean video title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseRegexForTitle As PropertyValue
<PropertyOption(ControlText:="Title regex", ControlToolTip:="Regex to clean video title"), PXML, PClonable>
<PropertyOption(ControlText:="Title regex", ControlToolTip:="Regex to clean video title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseRegexForTitle_Value As PropertyValue
#End Region
#End Region
<PropertyOption(ControlText:="Use video date as file date",
ControlToolTip:="Set the file date to the date the video was added (website) (if available)."), PXML, PClonable>
Friend ReadOnly Property UseParsedVideoDate As PropertyValue
@@ -46,6 +61,10 @@ Namespace API.TikTok
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("TikTok", "www.tiktok.com", AccName, Temp, My.Resources.SiteResources.TikTokIcon_32, My.Resources.SiteResources.TikTokPic_192)
GetTimeline = New PropertyValue(True)
GetStoriesUser = New PropertyValue(False)
GetReposts = New PropertyValue(False)
DownloadTTVideos = New PropertyValue(True)
DownloadTTPhotos = New PropertyValue(True)
@@ -76,5 +95,10 @@ Namespace API.TikTok
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Dim url$ = MyBase.GetUserPostUrl(User, Media)
If Not url.IsEmptyString AndAlso url.EndsWith(UserData.GDL_POSTFIX) Then url = url.Replace(UserData.GDL_POSTFIX, String.Empty)
Return url
End Function
End Class
End Namespace

View File

@@ -7,16 +7,21 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports SCrawler.Plugin.Attributes
Imports Sections = SCrawler.API.Instagram.UserData.Sections
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.TikTok
Friend Class UserData : Inherits UserDataBase
#Region "XML names"
Private Const Name_GetTimeline As String = "GetTimeline"
Private Const Name_GetStoriesUser As String = "GetStoriesUser"
Private Const Name_GetReposts As String = "GetReposts"
Private Const Name_RemoveTagsFromTitle As String = "RemoveTagsFromTitle"
Private Const Name_TitleUseNative As String = "TitleUseNative"
Private Const Name_TitleAddVideoID As String = "TitleAddVideoID"
@@ -27,6 +32,7 @@ Namespace API.TikTok
Private Const Name_PhotosDownloaded As String = "PhotosDownloaded"
#End Region
#Region "Declarations"
Friend Const GDL_POSTFIX As String = "--GDL"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
@@ -57,6 +63,9 @@ Namespace API.TikTok
End If
End Get
End Property
Friend Property GetTimeline As Boolean = True
Friend Property GetStoriesUser As Boolean = False
Friend Property GetReposts As Boolean = False
Friend Property RemoveTagsFromTitle As Boolean = False
Friend Property TitleUseNative As Boolean = True
Friend Property TitleAddVideoID As Boolean = True
@@ -74,6 +83,9 @@ Namespace API.TikTok
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
.ApplyBase(Me)
GetTimeline = .GetTimeline
GetStoriesUser = .GetStoriesUser
GetReposts = .GetReposts
RemoveTagsFromTitle = .RemoveTagsFromTitle
TitleUseNative = .TitleUseNative
TitleAddVideoID = .TitleAddVideoID
@@ -88,6 +100,9 @@ Namespace API.TikTok
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(True)
GetStoriesUser = .Value(Name_GetStoriesUser).FromXML(Of Boolean)(False)
GetReposts = .Value(Name_GetReposts).FromXML(Of Boolean)(False)
RemoveTagsFromTitle = .Value(Name_RemoveTagsFromTitle).FromXML(Of Boolean)(False)
TitleUseNative = .Value(Name_TitleUseNative).FromXML(Of Boolean)(True)
TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True)
@@ -98,6 +113,9 @@ Namespace API.TikTok
TitleUseGlobalRegexOptions = .Value(Name_TitleUseGlobalRegexOptions).FromXML(Of Boolean)(True)
PhotosDownloaded = .Value(Name_PhotosDownloaded).FromXML(Of Boolean)(False)
Else
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
.Add(Name_GetReposts, GetReposts.BoolToInteger)
.Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger)
.Add(Name_TitleUseNative, TitleUseNative.BoolToInteger)
.Add(Name_TitleAddVideoID, TitleAddVideoID.BoolToInteger)
@@ -166,17 +184,25 @@ Namespace API.TikTok
Private Function GetPhotoNode() As Object()
Return {"imageURL", "urlList", 0, 0}
End Function
Private Sub ValidateCache()
If If(UserCache?.Disposed, True) Then UserCache = CreateCache()
End Sub
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
MyBase.DownloadData(Token)
UserCache.DisposeIfReady(False)
UserCache = Nothing
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Protected Overloads Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ValidateCache()
If GetTimeline Then DownloadDataF(Sections.Timeline, Token)
If GetStoriesUser Then DownloadDataF(Sections.UserStories, Token)
If GetReposts Then DownloadDataF(Sections.Reposts, Token)
End Sub
Protected Overloads Sub DownloadDataF(ByVal Section As Sections, ByVal Token As CancellationToken)
Dim URL$ = $"https://www.tiktok.com/@{NameTrue}"
UserCache = CreateCache()
Try
Const photoPrefix$ = "photo_"
Dim postID$, title$, postUrl$, newName$, t$, postID2$, imgUrl$, pText$
Dim postID$, title$, postUrl$, newName$, t$, tOrig$, postID2$, imgUrl$, pText$
Dim postDate As Date?
Dim dateAfterC As Date? = Nothing
Dim dateBefore As Date? = DownloadDateTo
@@ -185,12 +211,24 @@ Namespace API.TikTok
Dim titleRegex As RParams = GetTitleRegex()
Dim vPath As SFile = Nothing, pPath As SFile = Nothing
Dim file As SFile
Dim j As EContainer, photo As EContainer
Dim j As EContainer = Nothing, photo As EContainer, item As EContainer
Dim photoNode As Object() = GetPhotoNode()
Dim c%, cc%, i%
Dim errDef As New ErrorsDescriber(EDP.ReturnValue)
Dim infoParsed As Boolean = False
Dim gdlTmpIDs As New Dictionary(Of String, Integer)
Dim gdlCmd$ = String.Empty
Dim gdlIsNativeJson As Boolean
Dim __specFolder$ = String.Empty
Dim __specFolder_Cr As Func(Of String, String) = Function(_sp$) String.Empty.StringAppend(__specFolder).StringAppend(_sp, "\") &
IIf(__specFolder.IsEmptyString, String.Empty, "*")
Select Case Section
Case Sections.UserStories : URL &= "/stories" : __specFolder = "Stories (user)" : gdlCmd = "-o videos -o photos"
Case Sections.Reposts : URL &= "/reposts" : __specFolder = "Reposts"
End Select
If _ContentList.Count > 0 Then
With (From d In _ContentList Where d.Post.Date.HasValue Select d.Post.Date.Value)
If .ListExists Then dateAfterC = .Min
@@ -215,7 +253,7 @@ Namespace API.TikTok
End If
End If
If DownloadVideos And Settings.YtdlpFile.Exists And CBool(MySettings.DownloadTTVideos.Value) Then
If Section = Sections.Timeline And DownloadVideos And Settings.YtdlpFile.Exists And CBool(MySettings.DownloadTTVideos.Value) Then
With UserCache.NewInstance : .Validate() : vPath = .RootDirectory : End With
Using b As New YTDLP.YTDLPBatch(Token,, vPath) With {.TempPostsList = _TempPostsList}
b.Execute(CreateYTCommand(vPath, URL, False, dateBefore, dateAfter))
@@ -233,7 +271,7 @@ Namespace API.TikTok
Else
.TempPostsList = New List(Of String)
End If
.Execute(CreateGDLCommand(URL))
.Execute(CreateGDLCommand(URL, gdlCmd))
If Not PhotosDownloaded Then _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
PhotosDownloaded = True
End With
@@ -243,6 +281,7 @@ Namespace API.TikTok
ThrowAny(Token)
Dim files As List(Of SFile)
'YTDLP
If Not vPath.IsEmptyString AndAlso vPath.Exists(SFO.Path, False) Then
files = SFile.GetFiles(vPath, "*.json",, errDef)
If files.ListExists Then
@@ -250,7 +289,7 @@ Namespace API.TikTok
j = JsonDocument.Parse(file.GetText, errDef)
If j.ListExists Then
If j.Value("_type").StringToLower = "video" Then
If Not baseDataObtained Then
If Not baseDataObtained And Section = Sections.Timeline Then
baseDataObtained = True
If ID.IsEmptyString Then ID = j.Value("uploader_id")
newName = j.Value("uploader")
@@ -262,7 +301,8 @@ Namespace API.TikTok
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.ListAddValue(postID, LNC)
Else
Exit For 'Exit Sub
'Exit For 'Exit Sub
Continue For
End If
title = GetNewFileName(j.Value("title").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex)
@@ -279,6 +319,7 @@ Namespace API.TikTok
If postUrl.IsEmptyString Then postUrl = $"https://www.tiktok.com/@{Name}/video/{postID}"
_TempMediaList.Add(New UserMedia(postUrl, UTypes.Video) With {
.File = $"{title}.mp4",
.SpecialFolder = __specFolder_Cr(String.Empty),
.Post = New UserPost(postID, postDate),
.PostText = pText,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder,
@@ -291,25 +332,122 @@ Namespace API.TikTok
End If
End If
j.DisposeIfReady
'GDL
If Not pPath.IsEmptyString AndAlso pPath.Exists(SFO.Path, False) Then
files = SFile.GetFiles(pPath, "*.txt",, errDef)
If files.ListExists Then
If Not Section = Sections.Timeline Then
GDLResetFileNameProvider(Math.Max(files.Count.ToString.Length, 2))
For i = 0 To files.Count - 1 : files(i) = GDLRenameFile(files(i), i) : Next
End If
For Each file In files
t = file.GetText(errDef)
If Not t.IsEmptyString Then t = RegexReplace(t, RegexPhotoJson)
tOrig = t
gdlIsNativeJson = False
If Not t.IsEmptyString And Not Section = Sections.UserStories Then
t = RegexReplace(t, RegexPhotoJson)
If t.IsEmptyString Then t = tOrig : gdlIsNativeJson = True
End If
If Not t.IsEmptyString Then
j = JsonDocument.Parse(t, errDef)
If j.ListExists Then
With j.ItemF({0, "webapp.video-detail", "itemInfo", "itemStruct"})
If Section = Sections.UserStories Then
With j("itemList")
If .ListExists Then
For Each item In .Self
With item
postID = .Value("id")
postDate = AConvert(Of Date)(.Value("createTime"), UnixDate32Provider, Nothing)
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.Add(postID)
postUrl = $"https://www.tiktok.com/@{Name}/video/{postID}{GDL_POSTFIX}"
If postDate.HasValue Then
title = CStr(AConvert(Of String)(postDate.Value, SimpleDateConverterWithTime, String.Empty)).StringAppend(postID, " ")
Else
title = postID
End If
_TempMediaList.Add(New UserMedia(postUrl, UTypes.Video) With {
.URL_BASE = postUrl,
.SpecialFolder = __specFolder_Cr(String.Empty),
.File = $"{title}.mp4",
.Post = New UserPost(postID, postDate)
})
With .Item("video")
If .ListExists AndAlso Not .Value("cover").IsEmptyString Then _
_TempMediaList.Add(New UserMedia(.Value("cover"), UTypes.Picture) With {
.URL_BASE = postUrl,
.SpecialFolder = __specFolder_Cr("Photo"),
.File = $"{title}.jpg"
})
End With
Else
Continue For
End If
End With
Next
End If
End With
ElseIf Section = Sections.Reposts And gdlIsNativeJson Then
With j("itemList")
If .ListExists Then
For Each item In .Self
With item
postID = .Value("id")
postID2 = $"{photoPrefix}{postID}"
If Not _TempPostsList.Contains(postID2) Then _TempPostsList.ListAddValue(postID2, LNC) Else Exit For 'Exit Sub
postDate = AConvert(Of Date)(.Value("createTime"), UnixDate32Provider, Nothing)
If Not _TempPostsList.Contains(postID) And Not _TempPostsList.Contains(postID2) Then
title = GetNewFileName(.Value("title").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex)
pText = .Value("title")
If Not .Value("desc").IsEmptyString Then
pText &= vbCr & vbCr & .Value("desc")
If title.IsEmptyString Then title = GetNewFileName(.Value("desc").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex)
End If
postDate = AConvert(Of Date)(j.Value("createTime"), UnixDate32Provider, Nothing)
If postDate.HasValue Then
Select Case CheckDatesLimit(postDate, SimpleDateConverter)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit For 'Exit Sub
End Select
End If
postUrl = .Value({"author"}, "uniqueId")
If Not postUrl.IsEmptyString Then
postUrl = $"https://www.tiktok.com/@{postUrl}/video/{postID}"
_TempMediaList.Add(New UserMedia(postUrl, UTypes.Video) With {
.File = $"{title}.mp4",
.SpecialFolder = __specFolder_Cr(String.Empty),
.Post = New UserPost(postID, postDate),
.PostText = pText,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder,
.PostTextFile = $"{ .File.Name}.txt"
})
If Not gdlTmpIDs.ContainsKey(postID) Then gdlTmpIDs.Add(postID, _TempMediaList.Count - 1)
End If
Else
Continue For
End If
End With
Next
End If
End With
Else
With j.ItemF({0, "webapp.video-detail", "itemInfo", "itemStruct"})
If .ListExists Then
postID = .Value("id")
postID2 = $"{photoPrefix}{postID}"
'If Not _TempPostsList.Contains(postID2) Then _TempPostsList.ListAddValue(postID2, LNC) Else Exit For 'Exit Sub
postDate = AConvert(Of Date)(.Value("createTime"), UnixDate32Provider, Nothing)
If Not Section = Sections.UserStories Then
Select Case CheckDatesLimit(postDate, SimpleDateConverter)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit For 'Exit Sub
End Select
End If
If Not infoParsed Then
With .Item("author")
@@ -340,6 +478,15 @@ Namespace API.TikTok
postUrl = $"https://www.tiktok.com/@{Name}/photo/{postID}"
With .Item({"imagePost", "images"})
If .ListExists Then
If Not _TempPostsList.Contains(postID2) Then
_TempPostsList.ListAddValue(postID2, LNC)
If gdlTmpIDs.ContainsKey(postID) Then
_TempMediaList.RemoveAt(gdlTmpIDs(postID))
gdlTmpIDs.Remove(postID)
End If
Else
Continue For 'Exit Sub
End If
i = 0
c = .Count
cc = Math.Max(c.ToString.Length, 3)
@@ -349,7 +496,7 @@ Namespace API.TikTok
If Not imgUrl.IsEmptyString Then _
_TempMediaList.Add(New UserMedia(imgUrl, UTypes.Picture) With {
.URL_BASE = postUrl,
.SpecialFolder = "Photo",
.SpecialFolder = __specFolder_Cr("Photo"),
.File = $"{title}{IIf(c > 1, $"_{i.NumToString(ANumbers.Formats.NumberGroup, cc)}", String.Empty)}.jpg",
.Post = New UserPost(postID, postDate),
.PostText = pText,
@@ -361,6 +508,7 @@ Namespace API.TikTok
End With
End If
End With
End If
j.Dispose()
End If
End If
@@ -368,6 +516,9 @@ Namespace API.TikTok
End If
End If
j.DisposeIfReady
_TempPostsList.ListAddList(gdlTmpIDs.Keys)
gdlTmpIDs.Clear()
If _TempMediaList.Count > 0 Then LastDownloadDate = Now
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
@@ -452,8 +603,17 @@ Namespace API.TikTok
End Function
#End Region
#Region "GDL Support"
Private Function CreateGDLCommand(ByVal URL As String) As String
Return $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --write-pages {URL}"
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
Dim command$ = $"""{Settings.GalleryDLFile}"" "
If Not IsDownload Then
command &= "--verbose --no-download --no-skip --write-pages "
Else
command &= $"--dest ""{Output.PathNoSeparator}"" "
End If
If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then command &= "--no-mtime "
command &= $"{SectionCommand} {URL}"
Return command
End Function
#End Region
#Region "DownloadContent, DownloadFile"
@@ -465,7 +625,16 @@ Namespace API.TikTok
End Function
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Using b As New TokenBatch(Token) With {.FileExchanger = RootCacheTikTok}
If URL.EndsWith(GDL_POSTFIX) Then
ValidateCache()
Dim tmpPath As SFile
With UserCache.NewInstance : .Validate() : tmpPath = .RootDirectory : End With
b.Execute(CreateGDLCommand(URL.Replace(GDL_POSTFIX, String.Empty),, True, tmpPath))
tmpPath = SFile.GetFiles(tmpPath, "*.mp4", IO.SearchOption.AllDirectories, EDP.ReturnValue).FirstOrDefault
If Not tmpPath.IsEmptyString Then SFile.Move(tmpPath, DestinationFile)
Else
b.Execute(CreateYTCommand(DestinationFile, URL, True))
End If
End Using
If DestinationFile.Exists Then Return DestinationFile Else Return Nothing
End Function

View File

@@ -6,9 +6,16 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Namespace API.TikTok
Friend Class UserExchangeOptions : Inherits Base.EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.GetTimeline), NameOf(MySettings))>
Friend Property GetTimeline As Boolean
<PSetting(NameOf(SiteSettings.GetStoriesUser), NameOf(MySettings))>
Friend Property GetStoriesUser As Boolean
<PSetting(NameOf(SiteSettings.GetReposts), NameOf(MySettings))>
Friend Property GetReposts As Boolean
<PSetting(NameOf(SiteSettings.RemoveTagsFromTitle), NameOf(MySettings))>
Friend Property RemoveTagsFromTitle As Boolean
<PSetting(NameOf(SiteSettings.TitleUseNative), NameOf(MySettings))>
@@ -27,6 +34,9 @@ Namespace API.TikTok
MyBase.New(u)
_ApplyBase_Name = False
MySettings = u.HOST.Source
GetTimeline = u.GetTimeline
GetStoriesUser = u.GetStoriesUser
GetReposts = u.GetReposts
RemoveTagsFromTitle = u.RemoveTagsFromTitle
TitleUseNative = u.TitleUseNative
TitleAddVideoID = u.TitleAddVideoID
@@ -38,6 +48,9 @@ Namespace API.TikTok
MyBase.New(s)
_ApplyBase_Name = False
MySettings = s
GetTimeline = s.GetTimeline.Value
GetStoriesUser = s.GetStoriesUser.Value
GetReposts = s.GetReposts.Value
RemoveTagsFromTitle = s.RemoveTagsFromTitle.Value
TitleUseNative = s.TitleUseNative.Value
TitleAddVideoID = s.TitleAddVideoID.Value

View File

@@ -112,14 +112,6 @@ Namespace API.Twitter
Return HOST.Source
End Get
End Property
Private FileNameProvider As ANumbers = Nothing
Private Sub ResetFileNameProvider(Optional ByVal GroupSize As Integer? = Nothing)
FileNameProvider = New ANumbers With {.FormatOptions = ANumbers.Options.FormatNumberGroup + ANumbers.Options.Groups}
FileNameProvider.GroupSize = If(GroupSize, 3)
End Sub
Private Function RenameGdlFile(ByVal Input As SFile, ByVal i As Integer) As SFile
Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(FileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function
Friend Function GetUserUrl() As String
Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}"
End Function
@@ -479,10 +471,10 @@ Namespace API.Twitter
ThrowAny(Token)
Dim timelineFiles As List(Of SFile) = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue)
If timelineFiles.ListExists Then
ResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2))
GDLResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2))
'rename files
If Not DEBUG_PROFILE Then
For i = 0 To timelineFiles.Count - 1 : timelineFiles(i) = RenameGdlFile(timelineFiles(i), i) : Next
For i = 0 To timelineFiles.Count - 1 : timelineFiles(i) = GDLRenameFile(timelineFiles(i), i) : Next
End If
'parse files
For i = 0 To timelineFiles.Count - 1
@@ -681,14 +673,14 @@ nextpIndx:
Dim f As SFile = GetDataFromGalleryDL("https://x.com/i/bookmarks", Settings.Cache, True, Token)
Dim files As List(Of SFile) = SFile.GetFiles(f, "*.txt")
If files.ListExists Then
ResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3))
GDLResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3))
Dim id$
Dim nodes As List(Of String()) = GetContainerSubnodes()
Dim node$()
Dim j As EContainer, jj As EContainer
Dim jErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To files.Count - 1
f = RenameGdlFile(files(i), i)
f = GDLRenameFile(files(i), i)
j = JsonDocument.Parse(f.GetText, jErr)
If Not j Is Nothing Then
With j.ItemF({"data", 0, "timeline", "instructions", 0, "entries"})
@@ -1140,7 +1132,7 @@ nextpIndx:
Dim files As List(Of SFile)
Dim lim%
Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty)
ResetFileNameProvider()
GDLResetFileNameProvider()
cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache())
If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count
ProgressPre.ChangeMax(lim)
@@ -1166,7 +1158,7 @@ nextpIndx:
files = SFile.GetFiles(f, "*.txt")
If files.ListExists Then
For ii = 0 To files.Count - 1
f = RenameGdlFile(files(ii), ii)
f = GDLRenameFile(files(ii), ii)
j = JsonDocument.Parse(f.GetText)
If Not j Is Nothing Then
With j.ItemF({"data", 0, "instructions", 0, "entries"})

View File

@@ -14,6 +14,9 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Xhamster
<Manifest(XhamsterSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Consts"
Friend Const GetMomentsCaption As String = "Get moments (short videos)"
#End Region
#Region "Declarations"
Private Const CAT_YTDLP As String = "yt-dlp support"
<PXML("Domains"), PClonable> Private ReadOnly Property SiteDomains As PropertyValue
@@ -45,6 +48,8 @@ Namespace API.Xhamster
End Property
<PropertyOption(ControlText:="Disable internal algorithm", ControlToolTip:="If checked, the internal algorithm will be forcibly disabled and replaced with yt-dlp", Category:=CAT_YTDLP), PXML, PClonable, HiddenControl>
Friend ReadOnly Property UseYTDLPForceDisableInternal As PropertyValue
<PropertyOption(ControlText:=GetMomentsCaption, Category:=DeclaredNames.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetMoments As PropertyValue
<DoNotUse> Friend Overrides Property DownloadText As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextPosts As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextSpecialFolder As PropertyValue
@@ -61,10 +66,11 @@ Namespace API.Xhamster
UseYTDLPJSON = New PropertyValue(True)
UseYTDLPDownload = New PropertyValue(True)
UseYTDLPForceDisableInternal = New PropertyValue(False)
GetMoments = New PropertyValue(True)
_SubscriptionsAllowed = True
UrlPatternUser = "https://xhamster.com/{0}/{1}"
UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
UserRegex = RParams.DMS($"/({UserOption}|{UserOption2}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
ImageVideoContains = "xhamster"
UserOptionsType = GetType(UserExchangeOptions)
UseNetscapeCookies = True
@@ -113,6 +119,7 @@ Namespace API.Xhamster
#Region "IsMyUser, IsMyImageVideo"
Friend Const ChannelOption As String = "channels"
Friend Const UserOption As String = "users/profiles"
Private Const UserOption2 As String = "users"
Friend Const P_Search As String = "search"
Friend Const P_Tags As String = "tags"
Friend Const P_Categories As String = "categories"

View File

@@ -740,10 +740,17 @@ Namespace API.Xhamster
#Region "yt-dlp support"
Private Function YTDLPGetInfo(ByVal URL As String, ByVal n As Integer) As SFile
Try
Dim cc As CacheKeeper
If IsSingleObjectDownload Then
cc = Settings.Cache
Else
If MyCache Is Nothing Then MyCache = CreateCache() : MyCache.Validate()
Dim path As SFile = MyCache.NewPath
cc = MyCache
End If
Dim path As SFile = cc.NewPath
Dim c$ = If(MySettings.CookiesNetscapeFile.Exists, $" --no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}""", String.Empty)
Dim cmd$ = $"{Settings.YtdlpFile} --write-info-json --skip-download{c} {URL} -o ""{path.PathWithSeparator}file"""
path.Exists()
Using ytdlp As New YTDLP.YTDLPBatch(TokenPersonal,, path) : ytdlp.Encoding = Settings.CMDEncoding : ytdlp.Execute(cmd) : End Using
Return SFile.GetFiles(path, "*.json",, EDP.ReturnValue).FirstOrDefault
Catch ex As Exception

View File

@@ -10,7 +10,7 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.Xhamster
Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P
<PSetting(Address:=SettingAddress.User, Caption:="Get moments")>
<PSetting(Address:=SettingAddress.User, Caption:=SiteSettings.GetMomentsCaption)>
Friend Property GetMoments As Boolean = False
Friend Sub New()
MyBase.New
@@ -19,6 +19,10 @@ Namespace API.Xhamster
MyBase.New(DirectCast(u, UserData))
GetMoments = DirectCast(u, UserData).GetMoments
End Sub
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
GetMoments = s.GetMoments.Value
End Sub
Friend Overrides Sub Apply(ByRef u As IPSite)
MyBase.Apply(u)
DirectCast(u, UserData).GetMoments = GetMoments

View File

@@ -410,7 +410,6 @@ Namespace DownloadObjects
With newObj
.Name = String.Empty
.Enabled = Enabled
.Groups.ListAddList(Groups, LAP.ClearBeforeAdd)
.IsManual = IsManual
.Timer = Timer
.StartupDelay = StartupDelay
@@ -690,7 +689,6 @@ Namespace DownloadObjects
If Not disposedValue And disposing Then
[Stop]()
UserKeys.ListClearDispose()
Groups.Clear()
End If
MyBase.Dispose(disposing)
End Sub

View File

@@ -365,18 +365,30 @@ Namespace DownloadObjects.Groups
(.Sites.Count = 0 OrElse .Sites.Contains(user.Site)) AndAlso
(.SitesExcluded.Count = 0 OrElse Not .SitesExcluded.Contains(user.Site))
Dim users As New List(Of IUserData)
Dim l As New ListAddParams(LAP.IgnoreICopier)
If Not .GroupsOnly Or (.GroupsOnly And .Groups.Count = 0) Then
users.ListAddList(Settings.GetUsers(Function(user) CheckLabels.Invoke(user) AndAlso CheckSites.Invoke(user) AndAlso
CheckParams.Invoke(user) AndAlso CheckSubscription.Invoke(user) AndAlso
CheckDays.Invoke(user) AndAlso CheckDateRange.Invoke(user)), LAP.IgnoreICopier)
CheckDays.Invoke(user) AndAlso CheckDateRange.Invoke(user)), l)
End If
If .Groups.Count > 0 And Settings.Groups.Count > 0 Then
If Settings.Groups.Count > 0 Then
Dim i%
For Each groupName$ In .Groups
Dim groupName$
l.NotContainsOnly = True
If .Groups.Count > 0 Then
For Each groupName In .Groups
i = Settings.Groups.IndexOf(groupName)
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, LAP.NotContainsOnly, LAP.IgnoreICopier)
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, l)
Next
End If
l.DisableDispose = True
If .GroupsExcluded.Count > 0 Then
For Each groupName In .GroupsExcluded
i = Settings.Groups.IndexOf(groupName)
If i >= 0 Then users.ListDisposeRemove(Settings.Groups(i).GetUsers, l)
Next
End If
End If
If .UsersCount <> 0 And users.ListExists Then
users = users.ListTake(If(.UsersCount > 0, -1, -2), Math.Abs(.UsersCount))

View File

@@ -58,6 +58,7 @@ Namespace DownloadObjects.Groups
Private ReadOnly Sites As List(Of String)
Private ReadOnly SitesExcluded As List(Of String)
Private ReadOnly Groups As List(Of String)
Private ReadOnly GroupsExcluded As List(Of String)
Private ReadOnly TT_MAIN As ToolTip
Friend ReadOnly Property GroupsOnly As Boolean
Get
@@ -72,6 +73,7 @@ Namespace DownloadObjects.Groups
Sites = New List(Of String)
SitesExcluded = New List(Of String)
Groups = New List(Of String)
GroupsExcluded = New List(Of String)
TT_MAIN = New ToolTip
InitTextBox(TXT_LABELS, "Labels", {New ActionButton(ADB.Edit) With {.ToolTipText = "Edit selected labels"},
@@ -82,7 +84,8 @@ Namespace DownloadObjects.Groups
New ActionButton(ADB.Delete) With {.ToolTipText = "Edit excluded sites"}, ADB.Clear})
TXT_SITES.TextBoxReadOnly = True
InitTextBox(TXT_GROUPS, "Groups", {New ActionButton(ADB.Edit) With {.ToolTipText = "Edit selected groups"}, ADB.Clear}, CaptionModes.CheckBox)
InitTextBox(TXT_GROUPS, "Groups", {New ActionButton(ADB.Edit) With {.ToolTipText = "Edit selected groups"},
New ActionButton(ADB.Delete) With {.ToolTipText = "Edit excluded groups"}, ADB.Clear}, CaptionModes.CheckBox)
With TXT_GROUPS
.TextBoxReadOnly = True
.CaptionCheckAlign = ContentAlignment.MiddleLeft
@@ -301,6 +304,7 @@ Namespace DownloadObjects.Groups
Sites.Clear()
SitesExcluded.Clear()
Groups.Clear()
GroupsExcluded.Clear()
CH_REGULAR.Dispose()
CH_TEMPORARY.Dispose()
CH_FAV.Dispose()
@@ -363,7 +367,7 @@ Namespace DownloadObjects.Groups
End If
End Using
End With
Case ADB.Clear : Labels.Clear() : LabelsExcluded.Clear() : TXT_LABELS.Clear() : UpdateLabelsText()
Case ADB.Clear : Labels.Clear() : LabelsExcluded.Clear() : UpdateLabelsText()
End Select
End Sub
Private Sub TXT_SITES_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_SITES.ActionOnButtonClick
@@ -379,36 +383,38 @@ Namespace DownloadObjects.Groups
End If
End Using
End With
Case ADB.Clear : Sites.Clear() : SitesExcluded.Clear() : TXT_SITES.Clear() : UpdateSitesText()
Case ADB.Clear : Sites.Clear() : SitesExcluded.Clear() : UpdateSitesText()
End Select
End Sub
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_GROUPS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ADB.Edit
Using f As New LabelsForm(Groups, (From g As DownloadGroup In Settings.Groups Where Not g.IsViewFilter Select g.Name)) With {
.Text = "Groups (F3 to edit)",
Case ADB.Edit, ADB.Delete
With If(Sender.DefaultButton = ADB.Edit, Groups, GroupsExcluded)
Using f As New LabelsForm(.Self, (From g As DownloadGroup In Settings.Groups Where Not g.IsViewFilter Select g.Name)) With {
.Text = $"Groups {IIf(Sender.DefaultButton = ADB.Delete, "excluded ", String.Empty)}(F3 to edit)",
.Icon = My.Resources.GroupByIcon_16,
.IsGroups = True
}
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then Groups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : UpdateGroupsText()
If f.DialogResult = DialogResult.OK Then .ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : UpdateGroupsText()
End Using
Case ADB.Clear : Groups.Clear() : TXT_GROUPS.Clear() : UpdateGroupsText()
End With
Case ADB.Clear : Groups.Clear() : GroupsExcluded.Clear() : UpdateGroupsText()
End Select
End Sub
Private Sub UpdateLabelsText()
TXT_LABELS.Clear()
If Not _JustExcludeOptions Then TXT_LABELS.Text = Labels.ListToString
If LabelsExcluded.Count > 0 Then TXT_LABELS.Text.StringAppend($"EXCLUDED: {LabelsExcluded.ListToString}", "; ")
__UpdateTextImpl(TXT_LABELS, Labels, LabelsExcluded)
End Sub
Private Sub UpdateSitesText()
TXT_SITES.Clear()
If Not _JustExcludeOptions Then TXT_SITES.Text = Sites.ListToString
If SitesExcluded.Count > 0 Then TXT_SITES.Text.StringAppend($"EXCLUDED: {SitesExcluded.ListToString}", "; ")
__UpdateTextImpl(TXT_SITES, Sites, SitesExcluded)
End Sub
Private Sub UpdateGroupsText()
TXT_GROUPS.Clear()
TXT_GROUPS.Text = Groups.ListToString
__UpdateTextImpl(TXT_GROUPS, Groups, GroupsExcluded)
End Sub
Private Sub __UpdateTextImpl(ByRef txt As TextBoxExtended, ByVal filter As List(Of String), ByVal excluded As List(Of String))
txt.Clear()
txt.Text = filter.ListToString
If excluded.Count > 0 Then txt.Text.StringAppend($"EXCLUDED: {excluded.ListToString}", "; ")
End Sub
#End Region
#Region "Get/set"
@@ -455,6 +461,7 @@ Namespace DownloadObjects.Groups
.SitesExcluded.ListAddList(SitesExcluded)
.Groups.Clear()
.Groups.ListAddList(Groups)
.GroupsExcluded.ListAddList(GroupsExcluded)
.GroupsOnly = GroupsOnly
End With
End If
@@ -505,6 +512,7 @@ Namespace DownloadObjects.Groups
UpdateSitesText()
Groups.ListAddList(.Groups)
GroupsExcluded.ListAddList(.GroupsExcluded)
TXT_GROUPS.Checked = .GroupsOnly
UpdateGroupsText()
End With
@@ -513,14 +521,12 @@ Namespace DownloadObjects.Groups
#End Region
#Region "Enabled"
Private _Enabled As Boolean = True
Private _JustExcludeOptions As Boolean = False
Friend Overloads Property Enabled() As Boolean
Get
Return _Enabled
End Get
Set(ByVal e As Boolean)
_Enabled = e
_JustExcludeOptions = False
TP_1.Enabled = e
TP_2.Enabled = e
TP_3.Enabled = e

View File

@@ -17,6 +17,7 @@ Namespace DownloadObjects.Groups
ReadOnly Property Sites As List(Of String)
ReadOnly Property SitesExcluded As List(Of String)
ReadOnly Property Groups As List(Of String)
ReadOnly Property GroupsExcluded As List(Of String)
Property GroupsOnly As Boolean
Property Regular As Boolean
Property Temporary As Boolean
@@ -59,6 +60,7 @@ Namespace DownloadObjects.Groups
Protected Const Name_Sites As String = "Sites"
Protected Const Name_Sites_Excluded As String = "SitesExcluded"
Protected Const Name_Groups As String = "Groups"
Protected Const Name_GroupsExcluded As String = "GroupsExcluded"
Protected Const Name_GroupsOnly As String = "GroupsOnly"
Protected Const Name_DaysNumber As String = "DaysNumber"
Protected Const Name_DaysIsDownloaded As String = "DaysIsDownloaded"
@@ -79,6 +81,7 @@ Namespace DownloadObjects.Groups
Friend ReadOnly Property Sites As List(Of String) Implements IGroup.Sites
Friend ReadOnly Property SitesExcluded As List(Of String) Implements IGroup.SitesExcluded
Friend ReadOnly Property Groups As List(Of String) Implements IGroup.Groups
Friend ReadOnly Property GroupsExcluded As List(Of String) Implements IGroup.GroupsExcluded
Friend Property GroupsOnly As Boolean = False Implements IGroup.GroupsOnly
Friend Property Regular As Boolean = True Implements IGroup.Regular
Friend Property Temporary As Boolean = True Implements IGroup.Temporary
@@ -105,6 +108,7 @@ Namespace DownloadObjects.Groups
Sites = New List(Of String)
SitesExcluded = New List(Of String)
Groups = New List(Of String)
GroupsExcluded = New List(Of String)
End Sub
#End Region
#Region "Base functions"
@@ -129,6 +133,7 @@ Namespace DownloadObjects.Groups
Sites.ListAddList(.Sites, LAP.ClearBeforeAdd)
SitesExcluded.ListAddList(.SitesExcluded, LAP.ClearBeforeAdd)
Groups.ListAddList(.Groups, LAP.ClearBeforeAdd)
GroupsExcluded.ListAddList(.GroupsExcluded, LAP.ClearBeforeAdd)
GroupsOnly = .GroupsOnly
Regular = .Regular
Temporary = .Temporary
@@ -163,6 +168,7 @@ Namespace DownloadObjects.Groups
If Not e.Value(Name_Sites).IsEmptyString Then Sites.ListAddList(e.Value(Name_Sites).Split("|"), l)
If Not e.Value(Name_Sites_Excluded).IsEmptyString Then SitesExcluded.ListAddList(e.Value(Name_Sites_Excluded).Split("|"), l)
If Not e.Value(Name_Groups).IsEmptyString Then Groups.ListAddList(e.Value(Name_Groups).Split("|"), l)
If Not e.Value(Name_GroupsExcluded).IsEmptyString Then GroupsExcluded.ListAddList(e.Value(Name_GroupsExcluded).Split("|"), l)
GroupsOnly = e.Value(Name_GroupsOnly).FromXML(Of Boolean)(False)
Regular = e.Value(Name_Regular).FromXML(Of Boolean)(True)
@@ -202,6 +208,7 @@ Namespace DownloadObjects.Groups
New EContainer(Name_Sites, Sites.ListToString("|")),
New EContainer(Name_Sites_Excluded, SitesExcluded.ListToString("|")),
New EContainer(Name_Groups, Groups.ListToString("|")),
New EContainer(Name_GroupsExcluded, GroupsExcluded.ListToString("|")),
New EContainer(Name_GroupsOnly, GroupsOnly.BoolToInteger),
New EContainer(Name_Regular, Regular.BoolToInteger),
New EContainer(Name_Temporary, Temporary.BoolToInteger),
@@ -233,6 +240,7 @@ Namespace DownloadObjects.Groups
Sites.Clear()
SitesExcluded.Clear()
Groups.Clear()
GroupsExcluded.Clear()
End If
disposedValue = True
End If

View File

@@ -368,7 +368,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_FEED.Name = "BTT_FEED"
Me.BTT_FEED.Size = New System.Drawing.Size(52, 22)
Me.BTT_FEED.Text = "Feed"
Me.BTT_FEED.ToolTipText = "Feed of recently downloaded data (Ctrl+F)"
Me.BTT_FEED.ToolTipText = "Feed of recently downloaded data (Alt+F)"
'
'BTT_CHANNELS
'

View File

@@ -184,36 +184,37 @@
<data name="MENU_VIEW.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAABkSURBVDhPY6AKyO86WFDQfeg/iIYKkQZAmkNbnvyXta76
DxViYGFi+Y8PQ5VBAMhmkGYgJs8FAw9GA5EKILFiWUFixfL/IBoqRBoAafYsOvpf0jiTvEAE2QzSLGmU
MeQCkYEBAD3tUdo+/cEPAAAAAElFTkSuQmCC
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAABkSURBVDhPY2CgBsjvOlhQ0H3oP4hGlyMKgDSHtjz5L2td
9R8mxsLE8h8fRjEAZDNIs6x1FXkuGHgwGohUAIkVywoSK5b/B9HockQBkGbPoqP/JY0zyQtEkM0gzZJG
GeS5YEABAD3tUdqXHMg6AAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_LOG.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAFmSURBVFhH1dc/K4VhHMbxJ5EFEQbFiERKCotIrMJIiYEi
pbwCZcOqJC9AikUWiqRkJYtSRDbESMT3V07dna7zHHru+9T51me+Ts//E+V7LRjFFAZRiZzUhDVc4/vX
B47Rh6D14Aqp4XQ36ECQ2nALNezaQjG8Vo5DqMF0bxiA1+bwCTWoLMFbNTiDGsrkABXw0jDsKldDmdyj
HokrwCrUSBz7wXbRJs4eLkdQI9m0I3ENeIAaiGN3QjMSZ4fxv+ffnKIKibOnmhqI84V5eMleOHY41VAm
9k7wdgtW4wRqSHlCP7y2AjWmbMB7Y7DzqgZdz2iF9zrxCDXq2oU9uLz31+tgAcHahhp1DSFY9pGhRl29
CFYXxrMoQ7BmsZfFPkoRpHWow+56hX26BWkRatR1gRIEaQLvUMMpOyhCkBpxBzWcMoOgLUMNm0vUIWj2
ebaJF7jj5+hGTiqE/f+bxDRGUIt8LIp+AC/GHt3tQnwvAAAAAElFTkSuQmCC
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAGTSURBVFhH1ZfPK21RGIaf5GaCCAPF0JVISWEiElNhSIkB
RUr5C5QZpkryB0gxkQlFUjKlO1HKjcwQQyJatdXp7TtnH3t/Z+CpZ7be7z3tH2uvA7+cFmAUmAIGgSpd
UCiagDXgCviMfAOOgT5d7E0P8C+jWL0GOjTkRRtwY5SqW0CJhtNSARwaZZYvwIAOSMsc8G6UZXNJB6Sh
FjgzSnJ5AFTqoKQMR0+5luTyFmjQQUkoAlaNgjjDDw4PbWrC5nJkFORjuw5Lwl/gzhgeZ3gTmnVYEsJl
/On9D54C1TosCWFX0+FxfgDzOigp4YMTLqeW5DJ8E9xewRrgxCjJ5gPQr0PSsmIUZXNDwx6MRfdVy9RH
oFXDHnQC90ahuhttXO7k+xwsaNCTbaNQHdKQJ+GQoYVqr4Y86QLGYyzXkCezwF6M+0CZBr1YNy65+hwd
3QrColGoXgClGvRiAng1SjPdAf5o0ItG4L9RmumMhrxZNkq/vQTqNeBNOJ5tAk9Sfg506+JCURz9/5sE
poERoE4X/Rq+AC/GHt09Rk0KAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_BUG_REPORT.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIDSURBVDhPpZLrS5NhGMb3j4SWh0oRQVExD4gonkDpg4hG
YKxG6WBogkMZKgPNCEVJFBGdGETEvgwyO9DJE5syZw3PIlPEE9pgBCLZ5XvdMB8Ew8gXbl54nuf63dd9
0OGSnwCahxbPRNPAPMw9Xpg6ZmF46kZZ0xSKzJPIrhpDWsVnpBhGkKx3nAX8Pv7z1zg8OoY/cITdn4fw
bf/C0kYAN3Ma/w3gWfZL5kzTKBxjWyK2DftwI9tyMYCZKXbNHaD91bLYJrDXsYbrWfUKwJrPE9M2M1Oc
VzOOpHI7Jr376Hi9ogHqFIANO0/MmmmbmSmm9a8ze+I4MrNWAdjtoJgWcx+PSzg166yZZ8xM8XvXDix9
c4jIqFYAjoriBV9AhEPv1mH/sonogha0afbZMMZz+yreTGyhpusHwtNNCsA5U1zS4BLxzJIfg299qO32
Ir7UJtZfftyATqeT+8o2D8JSjQrAJblrncYL7ZJ2+bfaFnC/1S1NjL3diRat7qrO7wLRP3HjWsojBeCo
mDEo5mNjuweFGvjWg2EBhCbpkW78htSHHwRyNdmgAFzPEee2iFkzayy2OLXzT4gr6UdUnlXrullsxxQ+
kx0g8BTA3aZlButjSTyjODq/WcQcW/B/Je4OQhLvKQDnzN1mp0nnkvAhR8VuMzNrpm1mpjgkoVwB/v8D
TgDQASA1MVpwzwAAAABJRU5ErkJggg==
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIFSURBVDhPpZLtS1NhGMbPPxJmmlYSgqHiKzGU1EDxg4iK
YKyG2WBogqMYJQOtCEVRFBGdTBCJfRnkS4VaaWNT5sqx1BUxRXxDHYxAJLvkusEeBaPAB+5z4Jzn+t3X
/aLhnEfjo8m+dCoa+7/C3O2Hqe0zDC+8KG+cRZHZhdzaaWTVTCLDMIY0vfM04Nfh77/G/sEhwpEDbO3t
I7TxE8urEVy99fT/AL5gWDLrTB/hnF4XsW0khCu5ln8DmJliT2AXrcNBsU1gj/MH4nMeKwBrPktM28xM
cX79DFKrHHD5d9D26hvicx4pABt2lpg10zYzU0zr7+e3xXGcrkEB2O2TNec9nJFwB3alZn5jZorfeDZh
6Q3g8s06BeCoKF4MRURoH1+BY2oNCbeb0TIclIYxOhzf8frTOuo7FxCbbVIAzpni0iceEc8vhzEwGkJD
lx83ymxifejdKjRNk/8PWnyIyTQqAJek0jqHwfEVscu31baIu8+90sTE4nY025dQ2/5FIPpnXlzKuK8A
HBUzHot52djqQ6HZhfR7IwK4mKpHtvEDMqvfCiQ6zaAAXM8x94aIWTNrLLG4kVUzgaTSPlzLtyJOZxbb
1wtfyg4Q+AfA3aZlButjSfxGcUJBk4g5tuP3haQKRKXcUQDOmbvNTpPOJeFFjordZmbWTNvMTHFUcpUC
nOccAdABIDXXE1nzAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="Toolbar_BOTTOM.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">

View File

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

View File

@@ -255,6 +255,7 @@
<Compile Include="API\ThisVid\SiteSettings.vb" />
<Compile Include="API\ThisVid\UserData.vb" />
<Compile Include="API\ThisVid\UserExchangeOptions.vb" />
<Compile Include="API\ThreadsNet\Declarations.vb" />
<Compile Include="API\ThreadsNet\SiteSettings.vb" />
<Compile Include="API\ThreadsNet\UserData.vb" />
<Compile Include="API\TikTok\Declarations.vb" />