Compare commits

..

2 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
37 changed files with 464 additions and 120 deletions

View File

@@ -2,13 +2,35 @@
- [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.32.0**
- [YT-DLP](https://github.com/AAndyProgram/SCrawler/wiki/Settings#yt-dlp) - **2026.03.17**
- [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.07.04**
- [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.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*

Binary file not shown.

After

Width:  |  Height:  |  Size: 847 KiB

View File

@@ -1,6 +1,5 @@
<!--
# 🏳️‍🌈 Happy LGBT Pride Month 🎉
-->
# 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![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,10 @@ Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Base
Friend Class EditorExchangeOptionsBase
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)>
Friend Overridable Property UserName As String = String.Empty
<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)>
Friend Overridable Property DownloadTextSpecialFolder As Boolean = False
Friend Sub New(ByVal u As UserDataBase)
UserExists = u.UserExists
UserSuspended = u.UserSuspended
UserName = u.NameTrue(True)
DownloadText = u.DownloadText
DownloadTextPosts = u.DownloadTextPosts
@@ -35,6 +41,8 @@ Namespace API.Base
Protected _ApplyBase_Name As Boolean = True
Protected _ApplyBase_Text As Boolean = True
Friend Sub ApplyBase(ByRef u As UserDataBase)
u.UserExists = UserExists
u.UserSuspended = UserSuspended
If _ApplyBase_Name Then u.NameTrue = UserName
If _ApplyBase_Text Then
u.DownloadText = DownloadText

View File

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

View File

@@ -1951,7 +1951,7 @@ stxt:
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) As SFile
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
If Process AndAlso f.Exists Then
@@ -1960,7 +1960,7 @@ stxt:
If WebpFile.Copy(f) Then
Dim newFile As SFile = WebpFile
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)
Else
f = WebpFile

View File

@@ -17,11 +17,13 @@ Namespace API.Bluesky
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

View File

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

View File

@@ -6,9 +6,10 @@
'
' 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.Facebook
Friend Class UserExchangeOptions
Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))>
Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
@@ -19,6 +20,7 @@ Namespace API.Facebook
Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock
@@ -26,11 +28,21 @@ Namespace API.Facebook
ParseStoriesBlock = u.ParseStoriesBlock
End Sub
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value
ParseReelsBlock = s.ParseReelsBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value
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 Namespace

View File

@@ -150,6 +150,8 @@ Namespace API.Instagram
Friend ReadOnly Property USE_GQL As PropertyValue
<PropertyOption(ControlText:="Use GraphQL to download user data", IsAuth:=True), PXML, PClonable, HiddenControl>
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
#Region "Download data"
<PropertyOption(ControlText:="Download timeline", Category:=CAT_DOWN), PXML, PClonable>
@@ -496,6 +498,7 @@ Namespace API.Instagram
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
USE_GQL = New PropertyValue(False)
USE_GQL_UserData = New PropertyValue(True)
USE_GQL_Highlights = New PropertyValue(True)
DownloadTimeline = New PropertyValue(True)
DownloadTimeline_Def = New PropertyValue(DownloadTimeline.Value, GetType(Boolean))

View File

@@ -37,11 +37,11 @@ Namespace API.Instagram
Friend Const GQL_HEADER_ROOT_FIELD_NAME_Value As String = "fetch__XDTUserDict"
#End Region
#Region "Data constants"
Private Const GQL_UserData_DocId As String = "35710877621861450" '"7381344031985950"
Private Const GQL_UserData_DocId As String = "26672929172408668" '"35710877621861450" '"7381344031985950"
Private Const GQL_UserData_FbFriendlyName As String = "PolarisProfilePageContentQuery"
Private Const GQL_Highlights_DocId As String = "8298007123561120"
Private Const GQL_Highlights_DocId_Second As String = "7559771384111300"
Private Const GQL_Highlights_DocId As String = "36997000523232338" '"8298007123561120"
Private Const GQL_Highlights_DocId_Second As String = "27618287167780519" '"7559771384111300"
Private Const GQL_Highlights_FbFriendlyName As String = "PolarisProfileStoryHighlightsTrayContentQuery"
Private Const GQL_Highlights_FbFriendlyName_Second As String = "PolarisStoriesV3HighlightsPageQuery"
@@ -82,6 +82,7 @@ Namespace API.Instagram
End Sub
'<Obsolete("Use 'GET' function: 'GetUserData'", False)>
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,
@@ -121,6 +122,7 @@ Namespace API.Instagram
Dim vars$
ThrowAny(Token)
UpdateTokens(Not ValidateBaseTokens())
UpdateRequestNumber()
ChangeResponserMode(True)
@@ -170,7 +172,7 @@ Namespace API.Instagram
Return If(hasNextPage And (Not nextCursor.IsEmptyString AndAlso Not nextCursor.StringToLower = none_cursor), nextCursor, String.Empty)
End Function
Private Function GetHighlightsGQL_List() As List(Of String)
UpdateTokens(Not ValidateBaseTokens())
Dim nextCursor$ = String.Empty
Dim hasNextPage As Boolean = False
Dim i% = -1
@@ -206,7 +208,7 @@ Namespace API.Instagram
Return hList
End Function
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 i% = -1
If StoriesList.ListExists Then
@@ -214,6 +216,7 @@ Namespace API.Instagram
'tmpList.AddRange(StoriesList.Take(10))
tmpList.AddRange(StoriesList.Take(5))
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,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(highlightData, tmpList(0), tmpList.Select(Function(hl) $"""{hl}""").ListToString(",")) & "}"))
@@ -240,6 +243,7 @@ Namespace API.Instagram
tmpList.Clear()
End Sub
Private Sub GetUserStoriesGQL(ByVal Token As CancellationToken)
UpdateTokens(Not ValidateBaseTokens())
'"{" & $"""user_id"":""{ID}""" & "}"
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}""]" & "}"))
@@ -272,7 +276,7 @@ Namespace API.Instagram
Private Function GetReelsGQL(ByVal Cursor As String) As String
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 & """}"
If Not Cursor.IsEmptyString Then vars = $"""after"":""{Cursor}"",""before"":null,{vars},""first"":4,""last"":null"
@@ -285,6 +289,7 @@ Namespace API.Instagram
End Function
''' <summary>Response</summary>
Private Function GetTaggedGQL(ByVal Cursor As String) As String
UpdateTokens(Not ValidateBaseTokens())
'default count = 12
'max count = 21
Dim vars$
@@ -335,7 +340,12 @@ Namespace API.Instagram
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
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)
Catch ex As Exception
Finally

View File

@@ -177,7 +177,7 @@ Namespace API.Instagram
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me)
.Apply(Me)
GetTimeline = .GetTimeline
GetReels = .GetReels
GetStories = .GetStories
@@ -333,6 +333,7 @@ Namespace API.Instagram
Private _LastWwwClaim As String = String.Empty
Private _ResponserGQLMode 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)
If Not _ResponserGQLMode = GQL Or Force Then
_ResponserGQLMode = GQL
@@ -506,26 +507,26 @@ Namespace API.Instagram
If Not errorFound Then LoadSavePostsKV(False)
End Try
End Sub
'TODELETE: ValidateExtension
Protected Sub ValidateExtension()
Dim tmpList As List(Of UserMedia) = Nothing
Try
Const heic$ = "heic"
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then
Dim m As UserMedia
tmpList = New List(Of UserMedia)
tmpList.ListAddList(_TempMediaList)
_TempMediaList.Clear()
For i% = 0 To tmpList.Count - 1
m = tmpList(i)
_TempMediaList.Add(m)
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _
m.File.Extension = "jpg" : _TempMediaList.Add(m)
Next
tmpList.Clear()
End If
Catch ex As Exception
If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear()
End Try
'Dim tmpList As List(Of UserMedia) = Nothing
'Try
' If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = ImgHeic) Then
' Dim m As UserMedia
' tmpList = New List(Of UserMedia)
' tmpList.ListAddList(_TempMediaList)
' _TempMediaList.Clear()
' For i% = 0 To tmpList.Count - 1
' m = tmpList(i)
' _TempMediaList.Add(m)
' If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = ImgHeic Then _
' m.File.Extension = "jpg" : _TempMediaList.Add(m)
' Next
' tmpList.Clear()
' End If
'Catch ex As Exception
' If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear()
'End Try
End Sub
Protected Overridable Sub UpdateResponser()
Try
@@ -702,7 +703,7 @@ Namespace API.Instagram
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 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)
End If
@@ -1275,6 +1276,7 @@ NextPageBlock:
With j({"data", "user"})
If Not ____dataGql Or ID.IsEmptyString Then ID = .Value("id")
__idFound = True
If Not .Value("username").IsEmptyString Then NameTrue = .Value("username")
UserSiteNameUpdate(.Value("full_name"))
IsVerifiedProfile = .Value("is_verified").FromXML(Of Boolean)(False)
IsVerifiedProfile_Checked = True
@@ -1307,9 +1309,17 @@ NextPageBlock:
ChangeResponserMode(_UseGQL)
End Try
End Sub
Private Function GetUserNameById() As Boolean
Private Function GetUserNameById(ByVal Token As CancellationToken) As Boolean
UserNameRequested = 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
If Not ID.IsEmptyString Then
UpdateRequestNumber()
@@ -1343,6 +1353,7 @@ NextPageBlock:
#Region "Pinned stories"
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 hPattern$ = "highlight:"
Dim tmpList As IEnumerable(Of String) = Nothing
Dim qStr$, r$
Dim i% = -1
@@ -1355,7 +1366,7 @@ NextPageBlock:
If GetUserStory Then
qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}"
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
UpdateRequestNumber()
r = Responser.GetResponse(qStr,, EDP.ThrowException)
@@ -1404,21 +1415,34 @@ NextPageBlock:
End If
End Sub
Private Function GetStoriesList() As List(Of String)
UpdateRequestNumber()
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
If CBool(MySiteSettings.USE_GQL_Highlights.Value) Then
Dim hList As List(Of String) = GetHighlightsGQL_List()
If Not _UseGQL Then ChangeResponserMode(_UseGQL)
Return hList
Else
UpdateRequestNumber()
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
Return Nothing
End Function
#End Region
#Region "Download content"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
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
#Region "Erase"
Protected Overrides Sub EraseData_AdditionalDataFiles()
@@ -1441,7 +1465,7 @@ NextPageBlock:
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
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
HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"

View File

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

View File

@@ -6,15 +6,21 @@
'
' 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.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")>
Friend Property ExtractSubBoards As Boolean = True
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
ExtractSubBoards = u.ExtractSubBoards
End Sub
Friend Sub New()
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
DirectCast(u, UserData).ExtractSubBoards = ExtractSubBoards
End Sub
End Class
End Namespace

View File

@@ -97,7 +97,7 @@ Namespace API.Pinterest
Return New EditorExchangeOptions(Me)
End Function
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 Region
#Region "Download overrides"

View File

@@ -136,7 +136,7 @@ Namespace API.Reddit
DownloadTextSpecialFolder = .DownloadTextSpecialFolder
RedGifsAccount = .RedGifsAccount
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 If
End Sub
@@ -1022,11 +1022,11 @@ Namespace API.Reddit
If .ListExists AndAlso ParseContainer(.Self, m.Post.ID, String.Empty,,, GetTextDocument(.Self)) Then
If lastCount <> _TempMediaList.Count Then
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
m2 = _TempMediaList(i)
m2 = _TempMediaList(li)
m2.Post.Date = m.Post.Date
m2.State = UStates.Missing
m2.Attempts = m.Attempts
_TempMediaList(i) = m2
_TempMediaList(li) = m2
Next
End If
rList.Add(i)

View File

@@ -7,6 +7,8 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.ThisVid
Friend Module Declarations
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 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 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 Namespace

View File

@@ -50,6 +50,14 @@ Namespace API.ThisVid
UrlPatternUser = "https://thisvid.com/members/{0}/"
ImageVideoContains = "https://thisvid.com/videos/"
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
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider

View File

@@ -55,7 +55,7 @@ Namespace API.ThreadsNet
Return New EditorExchangeOptionsBase(Me)
End Function
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 Region
#Region "Initializer"

View File

@@ -80,20 +80,7 @@ Namespace API.TikTok
Return New UserExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
.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
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
End Sub
#End Region
#Region "Loader"

View File

@@ -6,10 +6,11 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Namespace API.TikTok
Friend Class UserExchangeOptions : Inherits Base.EditorExchangeOptionsBase
Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.GetTimeline), NameOf(MySettings))>
Friend Property GetTimeline As Boolean
<PSetting(NameOf(SiteSettings.GetStoriesUser), NameOf(MySettings))>
@@ -57,5 +58,19 @@ Namespace API.TikTok
TitleUseRegexForTitle = s.TitleUseRegexForTitle.Value
TitleUseRegexForTitle_Value = s.TitleUseRegexForTitle_Value.Value
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 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 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 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 GdlPostCoutNumberNodes As String() = {"data", "user", "result", "legacy", "statuses_count"}
Private Function GetDateProvider() As ADateTime

View File

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

View File

@@ -123,7 +123,7 @@ Namespace API.Twitter
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me)
.Apply(Me)
GifsDownload = .GifsDownload
GifsSpecialFolder = .GifsSpecialFolder
GifsPrefix = .GifsPrefix
@@ -442,7 +442,7 @@ Namespace API.Twitter
End If
End If
Else
ObtainMedia(nn, PostID, PostDate)
ObtainMedia(nn, PostID, PostDate,,,, ee)
End If
End If
End If
@@ -717,7 +717,7 @@ nextpIndx:
With jj(node)
If .ListExists Then
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
End If
End With
@@ -738,11 +738,27 @@ nextpIndx:
#End Region
#Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
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"})
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"})
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 media As UserMedia
@@ -1246,7 +1262,7 @@ nextpIndx:
If .ListExists Then
PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder)
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder, n)
rList.ListAddValue(i, LNC)
End If
End With

View File

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

View File

@@ -53,7 +53,7 @@ Namespace API.Xhamster
End Property
Friend Property QueryString As String Implements IPSite.QueryString
Get
If SiteMode = SiteModes.User Then
If SiteMode = SiteModes.User And Not IsCreator Then
Return String.Empty
Else
Return GetNonUserUrl(0)
@@ -73,7 +73,7 @@ Namespace API.Xhamster
End Structure
Private ReadOnly _TempPhotoData As List(Of UserMedia)
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
If Force Then eObj = MySettings.IsMyUser(NewUrl)
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 Region
#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"
If SiteMode = SiteModes.User And Not IsCreator Then
Return String.Empty
@@ -210,8 +210,10 @@ Namespace API.Xhamster
End Select
url &= $"/{NameTrue}"
If GetShorts And (SiteMode = SiteModes.User Or IsCreator) Then url &= "/shorts"
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 args.IsEmptyString Then
If SiteMode = SiteModes.Search Then
@@ -288,7 +290,10 @@ Namespace API.Xhamster
End If
ElseIf Not SiteMode = SiteModes.Search 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({"pagesCategoryComponent", "trendingVideoListProps", "models"})
containerNodes.Add({"trendingVideoSectionComponent", "videoModels"})
@@ -311,7 +316,7 @@ Namespace API.Xhamster
URL = GetNonUserUrl(Page)
containerNodes.Add({"searchResult", "models"})
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
URL = $"https://xhamster.com/{SiteSettings.UserOption}/{NameTrue}/{If(GetMoments, "moments", IIf(IsVideo, "videos", "photos"))}{IIf(Page = 1, String.Empty, $"/{Page}")}"
End If

View File

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

View File

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

View File

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

View File

@@ -35,6 +35,9 @@ Namespace DownloadObjects
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 DataColumns As Integer = 1
@@ -74,8 +77,10 @@ Namespace DownloadObjects
If Not CurrentFilter Is Nothing Then
With CurrentFilter
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 .Labels.Count > 0 AndAlso d.User.Labels.Count > 0 AndAlso Not d.User.Labels.ListContains(.Labels) Then Return False
#Enable Warning
End With
End If
@@ -188,6 +193,7 @@ Namespace DownloadObjects
.Image = My.Resources.CutPic_48,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_FAV_T = New ToolStripButton With {
.Text = "Favorite",
.AutoToolTip = True,
@@ -202,6 +208,29 @@ Namespace DownloadObjects
.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,
@@ -220,7 +249,6 @@ Namespace DownloadObjects
.ToolTipText = "Invert selection",
.DisplayStyle = ToolStripItemDisplayStyle.Text
}
FILTERS = New FeedFilterCollection
BTT_FILTER.Image = My.Resources.FilterPic
BTT_FILTER_SIMPLE.Image = My.Resources.FilterPic
@@ -249,16 +277,24 @@ Namespace DownloadObjects
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 .Feeds
.Load()
AddHandler .FeedAdded, AddressOf Feed_FeedAdded
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
For Each feed As FeedSpecial In .Self
If Not feed.IsFavorite Then
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_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)
@@ -542,7 +578,7 @@ Namespace DownloadObjects
#Region "Toolbar controls"
#Region "Feed"
#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)
RefillList(True, False)
End Sub
@@ -1030,10 +1066,13 @@ Namespace DownloadObjects
End Sub
#End Region
#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})
RefillSpecialFeedsData(False)
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
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then

View File

@@ -18,24 +18,28 @@ Namespace DownloadObjects
Private Const Name_Types As String = "Types"
Private Const Name_Users As String = "Users"
Private Const Name_Sites As String = "Sites"
Private Const Name_Labels As String = "Labels"
#End Region
#Region "Properties"
Friend Property Name As String
Friend ReadOnly Property Types As List(Of UTypes)
Friend ReadOnly Property Users As List(Of UserInfo)
Friend ReadOnly Property Sites As List(Of String)
Friend ReadOnly Property Labels As List(Of String)
#End Region
#Region "Initializers"
Friend Sub New()
Types = New List(Of UTypes)
Users = New List(Of UserInfo)
Sites = New List(Of String)
Labels = New List(Of String)
End Sub
Friend Sub New(ByVal e As EContainer)
Me.New
Name = e.Value(Name_Name)
Types.ListAddList(e.Value(Name_Types).StringToList(Of Integer)(","))
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
Users.ListAddList(e(Name_Users), LAP.IgnoreICopier)
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_Types, Types.ListToString(",")))
ee.Add(New EContainer(Name_Sites, Sites.ListToString("|")))
ee.Add(New EContainer(Name_Labels, Labels.ListToString("|")))
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)
End If
Return ee
@@ -95,6 +100,8 @@ Namespace DownloadObjects
Users.ListAddList(.Users, LAP.NotContainsOnly)
Sites.Clear()
Sites.ListAddList(.Sites, LAP.NotContainsOnly)
Labels.Clear()
Labels.ListAddList(.Labels, LAP.NotContainsOnly)
End With
Return Me
End Function
@@ -126,8 +133,15 @@ Namespace DownloadObjects
End Get
Set(ByVal f As FeedFilter)
_TEMP = f
If _TEMP Is Nothing And _CurrentFilterName.IsEmptyString And Not _CurrentFilterNameLast.IsEmptyString Then _
_CurrentFilterName = _CurrentFilterNameLast
If _TEMP Is Nothing Then
If Not _CurrentFilterNameLast.IsEmptyString Then
_CurrentFilterName = _CurrentFilterNameLast
Else
_CurrentFilterName = String.Empty
End If
Else
_CurrentFilterName = String.Empty
End If
End Set
End Property
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 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 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.CH_T_ALL = 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.TXT_NAME = 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()
TP_TYPES = New System.Windows.Forms.TableLayoutPanel()
TP_USERS = New System.Windows.Forms.TableLayoutPanel()
@@ -55,6 +58,7 @@ Namespace DownloadObjects
TP_USERS_2.SuspendLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
@@ -78,16 +82,18 @@ Namespace DownloadObjects
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.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_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.Location = New System.Drawing.Point(0, 0)
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, 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.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(522, 336)
Me.TP_MAIN.TabIndex = 0
@@ -178,13 +184,13 @@ Namespace DownloadObjects
TP_USERS.Controls.Add(TP_USERS_2, 0, 0)
TP_USERS.Controls.Add(Me.LIST_USERS, 0, 1)
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.Name = "TP_USERS"
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.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_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.Absolute, 25.0!))
TP_USERS_2.Size = New System.Drawing.Size(522, 25)
TP_USERS_2.TabIndex = 0
TP_USERS_2.TabIndex = 4
'
'CH_U_USE
'
@@ -258,8 +264,8 @@ Namespace DownloadObjects
Me.LIST_USERS.FormattingEnabled = True
Me.LIST_USERS.Location = New System.Drawing.Point(3, 28)
Me.LIST_USERS.Name = "LIST_USERS"
Me.LIST_USERS.Size = New System.Drawing.Size(516, 224)
Me.LIST_USERS.TabIndex = 1
Me.LIST_USERS.Size = New System.Drawing.Size(516, 196)
Me.LIST_USERS.TabIndex = 5
'
'TXT_NAME
'
@@ -298,6 +304,25 @@ Namespace DownloadObjects
Me.TXT_SITE.TabIndex = 2
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
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -317,6 +342,7 @@ Namespace DownloadObjects
TP_USERS_2.PerformLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
@@ -333,5 +359,6 @@ Namespace DownloadObjects
Private WithEvents TXT_NAME As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TP_MAIN As TableLayoutPanel
Private WithEvents TXT_SITE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_LABELS As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
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">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
wgAADsIBFShKgAAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
@@ -185,7 +185,7 @@
RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP
lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l
f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK
j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEwAACxMBAJqcGAAAAZlJREFUOE9j+P//PwOp
j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEQAACxEBf2RfkQAAAZlJREFUOE9j+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
@@ -198,7 +198,72 @@
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
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
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types
@@ -105,6 +106,7 @@ Namespace DownloadObjects
End If
UpdateSitesText()
UpdateLabelsText()
.EndLoaderOperations()
RefillList(True)
@@ -143,21 +145,29 @@ Namespace DownloadObjects
Return DirectCast(Obj, DataUserTmp).UserInfo
End Function
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)
If Not MyDefs.Initializing Then
If Not Init Then ApplyFilter()
LIST_USERS.Items.Clear()
Dim dataUsers As New List(Of DataUserTmp)
If CH_U_SHOW_ALL.Checked Or MyData.Count = 0 Then
dataUsers.ListAddList(Settings.UsersList)
Else
dataUsers.ListAddList(MyData.Select(Function(d) d.UserInfo), LAP.NotContainsOnly)
'dataUsers.ListAddList(Settings.UsersList)
If Settings.Users.Count > 0 Then dataUsers.ListAddList(From __d As IUserData In Settings.GetUsers(Function(____d) True)
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
Dim i%
If dataUsers.Count > 0 Then
dataUsers.Sort()
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
dataUsers.ForEach(Sub(d) LIST_USERS.Items.Add(d, True))
If .Users.Count > 0 Then
@@ -243,10 +253,30 @@ Namespace DownloadObjects
End Select
If refill Then RefillList()
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()
TXT_SITE.Clear()
TXT_SITE.Text = MyFilter.Sites.ListToString
End Sub
Private Sub UpdateLabelsText()
TXT_LABELS.Clear()
TXT_LABELS.Text = MyFilter.Labels.ListToString
End Sub
#End Region
End Class
End Namespace

View File

@@ -155,10 +155,12 @@ Namespace DownloadObjects
End Function
#End Region
#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 ExtractText Then
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
f.Path = $"{File.Path.CSFilePS}Video"
End If
@@ -224,14 +226,14 @@ Namespace DownloadObjects
LBL_TITLE.Dispose()
TP_MAIN.RowStyles(1).Height = 0
File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File)
FileCheckSpecialFolders(File, ExtractText)
FileCheckSpecialFolders(File, ExtractText, Media.Data.File)
End If
If Not File.Exists And Not IsSubscription Then
If Not Media.Data.SpecialFolder.IsEmptyString Then
File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File)
File.Path = $"{File.Path.CSFilePS}{Media.Data.SpecialFolder}".CSFileP
FileCheckSpecialFolders(File, ExtractText)
FileCheckSpecialFolders(File, ExtractText, Media.Data.File)
End If
End If

View File

@@ -250,7 +250,14 @@ Namespace Editors
MyDefs = New DefaultFormOptions(Me, Settings.Design)
Host = h
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)
Host.BeginEdit()
End Sub

View File

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