Compare commits

..

6 Commits

Author SHA1 Message Date
Andy
e00dfec701 2024.1.12.1
API.Instagram: stories (user) downloading with the wrong aspect ratio for some users
API.YouTube: fix incorrect opening of a post from the feed; fix wrong date to data parsing; add data downloading by dates

DownloadFeedForm: add merging multiple session feeds into one
2024-01-12 19:58:17 +03:00
Andy
94edf23570 2024.1.12.0
DownloadFeedForm: add an option to create a new feed when adding checked items; add a prompt before clearing the current session
MainFrame: add scheduler to tray menu

API.Instagram: fix tagged posts downloading
API.xHamster: fix profiles downloading; add creators downloading
API.YouTube: add error to log (communities)
2024-01-11 23:39:56 +03:00
Andy
0246af9b69 2023.12.27.0
API.OnlyFans: add OF-Scraper support
ProfileSaved: save files when adding new data
2023-12-27 16:10:02 +03:00
Andy
c458f1cd1d 2023.12.26.0
SiteEditorForm: sort controls only if some of them have numbers
UserCreatorForm: reset site options for new user only; add host reset when changing account for created user
PropertyValueHost: add 'UpdateMember' function
SettingsHost: add 'DefaultInstanceChanged' function to update properties when setting default instance
SettingsHostCollection: update properties when setting default instance
2023-12-26 14:34:53 +03:00
Andy
e3da1bf1d3 2023.12.21.0
Update 'new log data' notification
Feed: improve last session loading
2023-12-21 10:01:30 +03:00
Andy
dde024276b 2023.12.20.0
API.Twitter: simplify JSON error string
Add notification of new log data
Add deleting permanent cache path if empty
2023-12-20 15:37:40 +03:00
35 changed files with 986 additions and 195 deletions

View File

@@ -1,3 +1,46 @@
# 2024.1.12.1
*2024-01-12*
- Added
- YouTube (SCrawler): data downloading by dates
- Feed: ability to merge multiple session feeds into one
- Feed: remove session number from special feeds
- Fixed
- **Instagram**: stories (user) downloading with the wrong aspect ratio for some users
- YouTube: incorrect opening of a post from the feed
- YouTube: wrong date to data parsing
# 2024.1.12.0
*2024-01-12*
- Added
- Feed: added a prompt before clearing the current session
- xHamster: creators
- YouTube communities: add error to log
- Added scheduler to tray menu
- Other improvements
- Fixed
- Feed: there is no option to create a new feed when adding checked items
- **Instagram**: downloading of tagged posts
- xHamster: profiles are not downloading
- Minor bugs
# 2023.12.27.0
*2023-12-27*
- Added
- Notification of new log data
- OnlyFans: **OF-Scrapper support to download DRM protected videos**
- Other improvements
- Fixed
- The default options are changed (`Favorite`, `Temporary`, etc.) when changing an account for a created user
- When changing the account for a created user, the new account does not apply to that user until SCrawler is restarted
- Saved posts: session file is not updated when new data is added
- Minor bugs
# 2023.12.15.0
*2023-12-15*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 13 KiB

View File

@@ -6,11 +6,19 @@ https://github.com/yt-dlp/yt-dlp/
SCrawler has advanced user management, collections, labels, groups, automatic downloads, a beautiful view, GUI, the ability to add plugins for other sites and much more. Just try it and compare.
# gallery-dl
https://github.com/mikf/gallery-dl
**Great powerful CLI tool that supports hundreds of sites.**
SCrawler has advanced user management, collections, labels, groups, automatic downloads, a beautiful view, GUI, the ability to add plugins for other sites and much more. Just try it and compare.
# 4K Video Downloader
https://www.4kdownload.com/-plbrz/video-downloader
| Option | SCrawler | 4K Stogram |
| Option | SCrawler | 4K Video Downloader |
| ---- | ---- | ---- |
| User managament | **Advanced** | No |
| Automatic downloads | **Yes** | No |
@@ -121,10 +129,3 @@ https://github.com/RipMeApp/ripme
| Other sites support | **Yes** | No |
| Still supported | **Yes** | **No (last release date May 4, 2021)** |
# gallery-dl
https://github.com/mikf/gallery-dl
**CLI tool**
SCrawler has advanced user management, collections, labels, groups, automatic downloads, a beautiful view, GUI, the ability to add plugins for other sites and much more. Just try it and compare.

View File

@@ -47,7 +47,7 @@ Namespace API.Base
Progress.InformationTemporary = $"{HOST.Name} ({c - s}/{c}) Images: {_TotalImages}; Videos: {_TotalVideos}"
End If
End If
If _FeedDataExists Then Downloader.Files.Sort()
If _FeedDataExists Then Downloader.Files.Sort() : Downloader.FilesSave()
End Sub
Private Overloads Sub Download(ByVal Host As SettingsHost, ByVal Number As Integer, ByVal Count As Integer,
ByVal Token As CancellationToken, ByVal Multiple As Boolean)

View File

@@ -205,7 +205,7 @@ Namespace API.Base
If Not h Is Nothing Then _HostKey = h.Key
End Set
End Property
Private Sub ResetHost()
Friend Sub ResetHost()
_HostObtained = False
End Sub
Friend Property HostStatic As Boolean = False Implements IUserData.HostStatic
@@ -1403,7 +1403,7 @@ BlockNullPicture:
End If
ff.Name &= "_thumb"
ff.Extension = "jpg"
f = Web.FFMPEG.TakeSnapshot(f, ff, Settings.FfmpegFile, TimeSpan.FromSeconds(1),,, EDP.LogMessageValue)
f = Web.FFMPEG.TakeSnapshot(f, ff, Settings.FfmpegFile, TimeSpan.FromSeconds(1),,, EDP.SendToLog + EDP.ReturnValue)
If f.Exists Then DirectCast(Data, IDownloadableMedia).ThumbnailFile = f
End If
Else

View File

@@ -63,8 +63,6 @@ Namespace API.Instagram
Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0), PClonable(Clone:=False)>
Friend ReadOnly Property HashTagged As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2), PClonable(Clone:=False)>
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3), PClonable(Clone:=False)>
@@ -236,7 +234,6 @@ Namespace API.Instagram
.CookiesExtractedAutoSave = False
End With
HashTagged = New PropertyValue(String.Empty, GetType(String))
HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v))
HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v))
HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v))
@@ -249,7 +246,7 @@ Namespace API.Instagram
DownloadTimeline = New PropertyValue(True)
DownloadStories = New PropertyValue(True)
DownloadStoriesUser = New PropertyValue(True)
DownloadTagged = New PropertyValue(False)
DownloadTagged = New PropertyValue(True)
RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100)

View File

@@ -255,7 +255,12 @@ Namespace API.Instagram
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadStoriesUser.Value) And GetStoriesUser Then s = Sections.UserStories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadTagged.Value) And GetTaggedData Then
s = Sections.Tagged
DownloadData(String.Empty, s, Token)
ProgressPre.Done()
If PostsToReparse.Count > 0 Then DownloadPosts(Token, True)
End If
End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException
@@ -460,12 +465,10 @@ Namespace API.Instagram
SavedPostsDownload(String.Empty, Token)
Exit Sub
Case Sections.Tagged
Dim h$ = AConvert(Of String)(MySiteSettings.HashTagged.Value, String.Empty)
If h.IsEmptyString Then Throw New ExitException
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={h}&variables={vars}"
ENode = {"data", "user", 0}
URL = $"https://www.instagram.com/graphql/query/?doc_id=17946422347485809&variables={vars}"
ENode = {"data", "user", "edge_user_to_photos_of_you"}
SpecFolder = TaggedFolder
Case Sections.Stories
If Not StoriesRequested Then
@@ -581,11 +584,12 @@ Namespace API.Instagram
ProcessException(DoEx, Token, $"data downloading error [{URL}]",, Section)
End Try
End Sub
Private Sub DownloadPosts(ByVal Token As CancellationToken)
Private Sub DownloadPosts(ByVal Token As CancellationToken, Optional ByVal IsTagged As Boolean = False)
Dim URL$ = String.Empty
Dim dValue% = 1
Dim _Index% = 0
Dim before%
Dim specFolder$ = IIf(IsTagged, "Tagged", String.Empty)
If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
Try
Do While dValue = 1
@@ -616,7 +620,7 @@ Namespace API.Instagram
With j("items")
For Each jj In .Self
before = _TempMediaList.Count
ObtainMedia(jj, PostsToReparse(i).ID)
ObtainMedia(jj, PostsToReparse(i).ID, specFolder)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
Next
@@ -742,10 +746,15 @@ Namespace API.Instagram
Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Try
Dim maxSize As Func(Of EContainer, Integer) = Function(ByVal _ss As EContainer) As Integer
Dim w% = AConvert(Of Integer)(_ss.Value("width"), 0)
Dim h% = AConvert(Of Integer)(_ss.Value("height"), 0)
Return Math.Max(w, h)
End Function
Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(maxSize(_ss), _ss.Value("url"))
Dim ssVid As Func(Of EContainer, Sizes) = ss
Dim ssPic As Func(Of EContainer, Sizes) = ss
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String

View File

@@ -0,0 +1,77 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'This class was auto-generated by the StronglyTypedResourceBuilder
'class via a tool like ResGen or Visual Studio.
'To add or remove a member, edit your .ResX file then rerun ResGen
'with the /str option, or rebuild your VS project.
'''<summary>
''' A strongly-typed resource class, for looking up localized strings, etc.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "16.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Class OFResources
Private Shared resourceMan As Global.System.Resources.ResourceManager
Private Shared resourceCulture As Global.System.Globalization.CultureInfo
<Global.System.Diagnostics.CodeAnalysis.SuppressMessageAttribute("Microsoft.Performance", "CA1811:AvoidUncalledPrivateCode")> _
Friend Sub New()
MyBase.New
End Sub
'''<summary>
''' Returns the cached ResourceManager instance used by this class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Shared ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("SCrawler.OFResources", GetType(OFResources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Overrides the current thread's CurrentUICulture property for all
''' resource lookups using this strongly typed resource class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Shared Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
'''<summary>
''' Looks up a localized resource of type System.Byte[].
'''</summary>
Friend Shared ReadOnly Property OFScraperConfigPattern() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("OFScraperConfigPattern", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
End Class
End Namespace

View File

@@ -0,0 +1,124 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
<data name="OFScraperConfigPattern" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>OFScraperConfigPattern.json;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
</root>

View File

@@ -0,0 +1,61 @@
{
"config": {
"main_profile": "main_profile",
"metadata": "{configpath}/{profile}/.data/{model_username}_{model_id}",
"discord": "",
"file_options": {
"save_location": "",
"dir_format": "",
"file_format": "{filename}.{ext}",
"textlength": 0,
"space-replacer": " ",
"date": "YYYY-MM-DD"
},
"download_options": {
"file_size_limit": 0,
"file_size_min": 0,
"filter": [
"Images",
"Audios",
"Videos"
],
"auto_resume": false
},
"binary_options": {
"mp4decrypt": "",
"ffmpeg": ""
},
"cdm_options": {
"private-key": null,
"client-id": null,
"key-mode-default": "cdrm",
"keydb_api": ""
},
"performance_options": {
"download-sems": 6,
"maxfile-sem": 0,
"threads": 5
},
"advanced_options": {
"code-execution": false,
"dynamic-mode-default": "deviint",
"backend": "aio",
"downloadbars": false,
"cache-mode": "sqlite",
"appendlog": true,
"custom": null,
"sanitize_text": false,
"avatar": true
},
"responsetype": {
"timeline": "Posts",
"message": "Messages",
"archived": "Archived",
"paid": "Messages",
"stories": "Stories",
"highlights": "Stories",
"profile": "Profile",
"pinned": "Posts"
}
}
}

View File

@@ -26,8 +26,8 @@ Namespace API.OnlyFans
#Region "Headers"
Private Const HeaderBrowser As String = "sec-ch-ua"
Private Const HeaderUserID As String = "User-Id"
Private Const HeaderXBC As String = "X-Bc"
Private Const HeaderAppToken As String = "App-Token"
Friend Const HeaderXBC As String = "X-Bc"
Friend Const HeaderAppToken As String = "App-Token"
<PropertyOption(ControlText:=HeaderUserID, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_USER_ID As PropertyValue
<PropertyOption(ControlText:=HeaderXBC, AllowNull:=False), PClonable(Clone:=False)>
@@ -37,7 +37,7 @@ Namespace API.OnlyFans
<PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True), PClonable>
Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(AllowNull:=False), PClonable>
Private ReadOnly Property UserAgent As PropertyValue
Friend ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String)
Dim hName$ = String.Empty
Dim isUserAgent As Boolean = False
@@ -78,6 +78,42 @@ Namespace API.OnlyFans
"Change this value only if you know what you are doing."), PXML, PClonable>
Friend ReadOnly Property DynamicRules As PropertyValue
#End Region
#Region "OFScraper"
<PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'")>
Friend ReadOnly Property OFScraperPath As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).OFScraperPath_XML
Else
Return OFScraperPath_XML
End If
End Get
End Property
<PClonable, PXML("OFScraperMP4decrypt")> Private ReadOnly Property OFScraperMP4decrypt_XML As PropertyValue
<PropertyOption(ControlText:="mp4decrypt path", ControlToolTip:="The path to the 'mp4decrypt.exe'")>
Friend ReadOnly Property OFScraperMP4decrypt As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).OFScraperMP4decrypt_XML
Else
Return OFScraperMP4decrypt_XML
End If
End Get
End Property
Friend Const KeyModeDefault_Default As String = "cdrm"
<PClonable, PXML("KeyModeDefault")> Private ReadOnly Property KeyModeDefault_XML As PropertyValue
<PropertyOption(ControlText:="key-mode-default")>
Friend ReadOnly Property KeyModeDefault As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).KeyModeDefault_XML
Else
Return KeyModeDefault_XML
End If
End Get
End Property
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
@@ -112,11 +148,27 @@ Namespace API.OnlyFans
DownloadChatMedia = New PropertyValue(True)
LastDateUpdated_XML = New PropertyValue(Now.AddYears(-1), GetType(Date))
UseOldAuthRules = New PropertyValue(False)
'URGENT: OF [UseOldAuthRules = True]
UseOldAuthRules = New PropertyValue(True)
DynamicRulesUpdateInterval = New PropertyValue(60 * 24)
DynamicRulesUpdateIntervalProvider = New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0) > 0, v, Nothing),
"The value of [{0}] field must be greater than 0")
DynamicRules = New PropertyValue(String.Empty, GetType(String))
OFScraperPath_XML = New PropertyValue(String.Empty, GetType(String))
If ACheck(OFScraperPath_XML.Value) Then
Dim f As SFile = OFScraperPath_XML.Value
If Not f.Exists AndAlso f.Exists(SFO.Path, False) Then
With SFile.GetFiles(f, "*.exe",, EDP.ReturnValue)
If .ListExists Then
f = .FirstOrDefault(Function(ff) ff.Name.StringToLower.StartsWith("ofscraper"))
If f.Exists Then OFScraperPath_XML.Value = f.ToString
End If
End With
End If
End If
OFScraperMP4decrypt_XML = New PropertyValue(String.Empty, GetType(String))
KeyModeDefault_XML = New PropertyValue(KeyModeDefault_Default)
UserRegex = RParams.DMS("onlyfans.com/([\w\._]+)", 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}"
ImageVideoContains = "onlyfans.com"
@@ -151,6 +203,7 @@ Namespace API.OnlyFans
End Sub
#End Region
#Region "GetUserUrl, GetUserPostUrl, UserOptions"
Friend Const UserPostPattern As String = "https://onlyfans.com/{0}/{1}"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
End Function
@@ -168,7 +221,7 @@ Namespace API.OnlyFans
If p.IsEmptyString Then
Return GetUserUrl(User)
Else
Return String.Format("https://onlyfans.com/{0}/{1}", p, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
Return String.Format(UserPostPattern, p, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
End If
Else
Return String.Empty

View File

@@ -7,10 +7,12 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports System.Text.RegularExpressions
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports PersonalUtilities.Tools.Web.Cookies
@@ -65,11 +67,20 @@ Namespace API.OnlyFans
#Region "Initializer"
Friend Sub New()
HighlightsList = New List(Of String)
UseInternalDownloadFileFunction = True
End Sub
#End Region
#Region "Download functions"
Private _OFScraperExists As Boolean = False
Private OFSCache As CacheKeeper = Nothing
Private _AbsMediaIndex As Integer = 0
Private Sub ValidateOFScraper()
_OFScraperExists = ACheck(MySettings.OFScraperPath.Value) AndAlso CStr(MySettings.OFScraperPath.Value).CSFile.Exists
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not MySettings.SessionAborted Then
ValidateOFScraper()
_AbsMediaIndex = 0
If Not CCookie Is Nothing Then CCookie.Dispose()
CCookie = Responser.Cookies.Copy
Responser.Cookies.Clear()
@@ -307,8 +318,8 @@ Namespace API.OnlyFans
#End Region
Private Function TryCreateMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal PostDate As String = Nothing,
Optional ByRef Result As Boolean = False, Optional ByVal IsHL As Boolean = False,
Optional ByVal SpecFolder As String = Nothing) As List(Of UserMedia)
Dim postUrl$, ext$
Optional ByVal SpecFolder As String = Nothing, Optional ByVal PostUserID As String = Nothing) As List(Of UserMedia)
Dim postUrl$, postUrlBase$, ext$
Dim t As UTypes
Dim mList As New List(Of UserMedia)
Result = False
@@ -320,16 +331,27 @@ Namespace API.OnlyFans
Else
postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
End If
postUrlBase = String.Empty
Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg"
Case "video" : t = UTypes.Video : ext = "mp4"
Case "video"
t = UTypes.Video
ext = "mp4"
If postUrl.IsEmptyString And Not IsHL Then
t = UTypes.VideoPre
_AbsMediaIndex += 1
If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
End If
Case Else : t = UTypes.Undefined : ext = String.Empty
End Select
If Not t = UTypes.Undefined And Not postUrl.IsEmptyString Then
Dim media As New UserMedia(postUrl, t) With {
If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
.SpecialFolder = SpecFolder
}
If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
media.File.Extension = ext
Result = True
mList.Add(media)
@@ -387,7 +409,7 @@ Namespace API.OnlyFans
End Function
Dim mList As List(Of UserMedia)
Dim mediaResult As Boolean
Dim r$, path$, postDate$
Dim r$, path$, postDate$, postUserID$
Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
@@ -404,8 +426,9 @@ Namespace API.OnlyFans
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
postDate = j.Value("postedAt")
postUserID = j.Value({"author"}, "id")
mediaResult = False
mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult)
mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult,,, postUserID)
If mediaResult Then
_TempMediaList.ListAddList(mList.ListForEachCopy(stateRefill, True), LNC)
rList.Add(i)
@@ -531,10 +554,145 @@ Namespace API.OnlyFans
Return result
End Function
#End Region
#Region "OFScraper support"
Private Function OFS_DownloadFile(ByVal URL As String, ByVal Token As CancellationToken) As List(Of SFile)
Try
Const requestPattern$ = """{0}"" manual --config ""{1}"" --url {2}"
Dim conf As SFile = OFS_CreateConfig()
If conf.Exists Then
Dim command$ = String.Format(requestPattern, MySettings.OFScraperPath.Value, conf, URL)
'#If DEBUG Then
'Debug.WriteLine(command)
'#End If
Using b As New TokenBatch(Token) : b.Execute(command) : End Using
Return SFile.GetFiles(conf, "*.mp4", IO.SearchOption.AllDirectories, EDP.ReturnValue)
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "OnlyFans.UserData.OFS_DownloadFile", Nothing)
End Try
End Function
Private Function OFS_CreateConfig() As SFile
Try
Const confMainPattern$ = "{0}"": ""([^""]*)"""
If OFSCache Is Nothing Then OFSCache = If(IsSingleObjectDownload, Settings.Cache.NewInstance, CreateCache())
Dim currentCache As CacheKeeper = OFSCache.NewInstance
currentCache.Validate()
Dim cacheRoot As SFile = currentCache.NewPath
cacheRoot.Exists(SFO.Path, True, EDP.ThrowException)
Dim f As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json"
Dim configText$
If Not f.Exists Then
configText = Text.Encoding.UTF8.GetString(My.Resources.OFResources.OFScraperConfigPattern)
TextSaver.SaveTextToFile(configText, f, True)
End If
If f.Exists Then
Dim replaceValue$ = String.Empty
Dim rp As RParams = RParams.DMS(String.Empty, 1, RegexReturn.Replace, RegexOptions.IgnoreCase,
CType(Function(input) replaceValue, Func(Of String, String)), String.Empty, EDP.ReturnValue)
Dim ff As SFile
configText = f.GetText
Dim updateConf As Action(Of String, String) = Sub(ByVal patternValue As String, ByVal __replaceValue As String)
rp.Pattern = String.Format(confMainPattern, patternValue)
rp.Nothing = configText
replaceValue = __replaceValue
configText = RegexReplace(configText, rp)
End Sub
If Not configText.IsEmptyString Then
updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"))
If ACheck(MySettings.OFScraperMP4decrypt.Value) Then
ff = CStr(MySettings.OFScraperMP4decrypt.Value)
If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"))
End If
If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"))
updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default))
f = currentCache
f.Name = "config"
f.Extension = "json"
If TextSaver.SaveTextToFile(configText, f, True).Exists AndAlso OFS_CreateAuth(currentCache) Then Return f
End If
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "OnlyFans.UserData.OFS_CreateConfig", Nothing)
End Try
End Function
Private Function OFS_CreateAuth(ByVal DestinationPath As SFile) As Boolean
Const authText$ = """user_agent"": ""{0}"",""app-token"": ""{1}"",""x-bc"": ""{2}"",""auth_id"": ""{3}"",""sess"": ""{4}"",""auth_uid_"": ""{3}"",""cookie"": ""{5}"""
Try
Dim sess$ = If(If(CCookie, Responser.Cookies).FirstOrDefault(Function(c) c.Name.StringToLower = "sess")?.Value, String.Empty)
Dim outText$ = "{""auth"":{" &
String.Format(authText,
MySettings.UserAgent.Value,
Responser.Headers.Value(SiteSettings.HeaderAppToken),
Responser.Headers.Value(SiteSettings.HeaderXBC),
MySettings.HH_USER_ID.Value,
sess,
If(CCookie, Responser.Cookies).ToString()) &
"}}"
If DestinationPath.Exists(SFO.Path, False) Then
Dim f As SFile = $"{DestinationPath.PathWithSeparator}main_profile\auth.json"
Return TextSaver.SaveTextToFile(outText, f, True).Exists
End If
Return False
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "OnlyFans.UserData.OFS_CreateAuth", False)
End Try
End Function
#End Region
#Region "DownloadContent"
Private OFSPostFiles As Dictionary(Of String, List(Of SFile)) = Nothing
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
OFSCache.DisposeIfReady
OFSPostFiles.ListClearDispose
End Sub
Protected Overrides Function ValidateDownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByRef Interrupt As Boolean) As Boolean
Return Media.Type = UTypes.VideoPre
End Function
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile
ValidateOFScraper()
If _OFScraperExists Then
If OFSPostFiles Is Nothing Then OFSPostFiles = New Dictionary(Of String, List(Of SFile))
If IsSingleObjectDownload Then
URL = Media.URL_BASE
Else
URL = GetPostUrl(Me, Media)
End If
If Not URL.IsEmptyString Then
Dim f As SFile = Nothing
If OFSPostFiles.Count > 0 AndAlso OFSPostFiles.ContainsKey(Media.Post.ID) AndAlso OFSPostFiles(Media.Post.ID).Count > 0 Then
f = OFSPostFiles(Media.Post.ID)(0)
OFSPostFiles(Media.Post.ID).RemoveAt(0)
Else
Dim files As List(Of SFile) = OFS_DownloadFile(URL, Token)
If files.ListExists Then
Dim ff As SFile
For i% = files.Count - 1 To 0 Step -1
ff = files(i)
DestinationFile.Name = ff.Name
DestinationFile.Extension = ff.Extension
If SFile.Move(ff, DestinationFile,,,, EDP.ThrowException) Then
files(i) = DestinationFile
Else
files.RemoveAt(i)
End If
Next
If files.Count > 0 Then
f = files(0)
files.RemoveAt(0)
If files.Count > 0 Then OFSPostFiles.Add(Media.Post.ID, files)
End If
End If
End If
Return f
End If
Return Nothing
Else
Throw New InvalidProgramException("OF-Scraper not found")
End If
End Function
#End Region
#Region "DownloadingException"
Private _DownloadingException_AuthFileUpdate As Boolean = False
@@ -546,7 +704,7 @@ Namespace API.OnlyFans
Return 2
Else
MySettings.SessionAborted = True
MyMainLOG = $"{ToStringForLog()}: OnlyFans credentials expired"
MyMainLOG = $"{ToStringForLog()} [{CInt(Responser.StatusCode)}]: OnlyFans credentials expired"
Return 1
End If
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404
@@ -558,7 +716,7 @@ Namespace API.OnlyFans
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.Unauthorized Then '401
MySettings.SessionAborted = True
MyMainLOG = $"{ToStringForLog()}: OnlyFans credentials expired"
MyMainLOG = $"{ToStringForLog()} [{CInt(Responser.StatusCode)}]: OnlyFans credentials expired"
Return 1
Else
Return 0
@@ -567,7 +725,13 @@ Namespace API.OnlyFans
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then CCookie.DisposeIfReady(False) : CCookie = Nothing : HighlightsList.Clear()
If Not disposedValue And disposing Then
CCookie.DisposeIfReady(False)
CCookie = Nothing
HighlightsList.Clear()
OFSCache.DisposeIfReady
OFSPostFiles.ListClearDispose
End If
MyBase.Dispose(disposing)
End Sub
#End Region

View File

@@ -364,7 +364,7 @@ Namespace API.Twitter
DownloadModelForceApply = False
FirstDownloadComplete = True
Catch jsonNull_ex As ArgumentNullException When jsonArgs.State = WebDocumentEventArgs.States.Error
Throw New Plugin.ExitException($"{ToStringForLog()}: No deserialized data found")
Throw New Plugin.ExitException("No deserialized data found")
Catch limit_ex As TwitterLimitException
Throw limit_ex
Catch ex As Exception

View File

@@ -46,7 +46,7 @@ Namespace API.Xhamster
_SubscriptionsAllowed = True
UrlPatternUser = "https://xhamster.com/{0}/{1}"
UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
ImageVideoContains = "xhamster"
End Sub
Friend Overrides Sub EndInit()
@@ -96,8 +96,9 @@ Namespace API.Xhamster
Friend Const P_Search As String = "search"
Friend Const P_Tags As String = "tags"
Friend Const P_Categories As String = "categories"
Friend Const P_Pornstars = "pornstars"
Private ReadOnly NonUsersRegex As RParams = RParams.DM("https?://[^/]+/((gay)/|(shemale)/|)(pornstars|tags|categories|search)/([^/\?]+)[/\?]?(.*)", 0,
Friend Const P_Pornstars As String = "pornstars"
Friend Const P_Creators As String = "creators"
Private ReadOnly NonUsersRegex As RParams = RParams.DM("https?://[^/]+/((gay)/|(shemale)/|)(pornstars|creators|tags|categories|search)/([^/\?]+)[/\?]?(.*)", 0,
RegexReturn.ListByMatch, EDP.ReturnValue)
Private ReadOnly PageRemover_1 As RParams = RParams.DM("[\?&]?[Pp]age=\d+", 0, RegexReturn.Replace, EDP.ReturnValue,
CType(Function(input) String.Empty, Func(Of String, String)))
@@ -106,12 +107,23 @@ Namespace API.Xhamster
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
If Not UserURL.IsEmptyString AndAlso Domains.Domains.Count > 0 AndAlso Domains.Domains.Exists(Function(d) UserURL.ToLower.Contains(d.ToLower)) Then
Dim n$, opt$
Dim tryNext As Boolean = False
Dim data As List(Of String) = RegexReplace(UserURL, UserRegex)
If data.ListExists(3) AndAlso Not data(2).IsEmptyString Then
n = data(2)
If Not data(1).IsEmptyString AndAlso data(1) = ChannelOption Then n &= $"@{data(1)}"
Return New ExchangeOptions(Site, n)
If Not data(1).IsEmptyString Then
If data(1) = ChannelOption Then
n &= $"@{data(1)}"
ElseIf data(1) = P_Creators Then
tryNext = True
End If
End If
If Not tryNext Then Return New ExchangeOptions(Site, n)
Else
tryNext = True
End If
If tryNext Then
data = RegexReplace(UserURL, NonUsersRegex)
If data.ListExists(7) AndAlso Not data(5).IsEmptyString Then
n = data(5).StringRemoveWinForbiddenSymbols
@@ -122,6 +134,7 @@ Namespace API.Xhamster
Case P_Tags : mode = SiteModes.Tags
Case P_Categories : mode = SiteModes.Categories
Case P_Pornstars : mode = SiteModes.Pornstars
Case P_Creators : mode = SiteModes.User
Case Else : Return Nothing
End Select
n = $"{CInt(mode)}@{n}"

View File

@@ -19,6 +19,7 @@ Namespace API.Xhamster
Friend Class UserData : Inherits UserDataBase
#Region "XML names"
Private Const Name_Gender As String = "Gender"
Private Const Name_IsCreator As String = "IsCreator"
#End Region
#Region "Declarations"
Friend Overrides ReadOnly Property FeedIsUser As Boolean
@@ -27,6 +28,7 @@ Namespace API.Xhamster
End Get
End Property
Friend Property IsChannel As Boolean = False
Friend Property IsCreator As Boolean = False
Friend Property TrueName As String = String.Empty
Friend Property Gender As String = String.Empty
Friend Property SiteMode As SiteModes = SiteModes.User
@@ -77,7 +79,8 @@ Namespace API.Xhamster
If n.Length = 2 And If(Force, eObj.Options, Options).IsEmptyString Then
If Force Then Return False
TrueName = n(0)
IsChannel = True
IsChannel = n(1) = SiteSettings.ChannelOption
IsCreator = n(1) = SiteSettings.P_Creators
ElseIf IsChannel Then
If Force Then Return False
TrueName = Name
@@ -89,6 +92,7 @@ Namespace API.Xhamster
If n2.ListExists Then
IsChannel = False
__Mode = CInt(n2(0))
IsCreator = __Mode = SiteModes.User
__Gender = n2(1)
__Arguments = n2(3)
__TrueName = n2.ListTake(3, 100, EDP.ReturnValue).ListToString(String.Empty)
@@ -139,6 +143,7 @@ Namespace API.Xhamster
With Container
If Loading Then
IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False)
IsCreator = .Value(Name_IsCreator).FromXML(Of Boolean)(False)
TrueName = .Value(Name_TrueName)
Gender = .Value(Name_Gender)
SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User)
@@ -151,6 +156,7 @@ Namespace API.Xhamster
.Value(Name_FriendlyName) = FriendlyName
End If
.Add(Name_IsChannel, IsChannel.BoolToInteger)
.Add(Name_IsCreator, IsCreator.BoolToInteger)
.Add(Name_TrueName, TrueName)
.Add(Name_Gender, Gender)
.Add(Name_SiteMode, CInt(SiteMode))
@@ -178,7 +184,7 @@ Namespace API.Xhamster
#End Region
#Region "Download functions"
Friend Function GetNonUserUrl(ByVal Page As Integer) As String
If SiteMode = SiteModes.User Then
If SiteMode = SiteModes.User And Not IsCreator Then
Return String.Empty
Else
Dim url$ = "https://xhamster.com/"
@@ -188,6 +194,7 @@ Namespace API.Xhamster
Case SiteModes.Categories : url &= SiteSettings.P_Categories
Case SiteModes.Search : url &= SiteSettings.P_Search
Case SiteModes.Pornstars : url &= SiteSettings.P_Pornstars
Case SiteModes.User : url &= SiteSettings.P_Creators
Case Else : Return String.Empty
End Select
url &= $"/{TrueName}"
@@ -224,15 +231,20 @@ Namespace API.Xhamster
Private ReadOnly SessionPosts As List(Of String)
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TempPhotoData.Clear()
SearchPostsCount = 0
_PageVideosRepeat = 0
SessionPosts.Clear()
If DownloadVideos Then DownloadData(1, True, Token)
If Not IsChannel And DownloadImages And Not IsSubscription Then
DownloadData(1, False, Token)
ReparsePhoto(Token)
End If
Try
_TempPhotoData.Clear()
SearchPostsCount = 0
_PageVideosRepeat = 0
SessionPosts.Clear()
Responser.CookiesAsHeader = True
If DownloadVideos Then DownloadData(1, True, Token)
If Not IsChannel And Not IsCreator And DownloadImages And Not IsSubscription Then
DownloadData(1, False, Token)
ReparsePhoto(Token)
End If
Finally
Responser.CookiesAsHeader = False
End Try
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsVideo As Boolean, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
@@ -260,7 +272,7 @@ Namespace API.Xhamster
ElseIf SiteMode = SiteModes.Search Then
URL = GetNonUserUrl(Page)
containerNodes.Add({"searchResult", "models"})
ElseIf SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then
ElseIf IsCreator Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then
URL = GetNonUserUrl(Page)
If SiteMode = SiteModes.Pornstars Then
containerNodes.Add({"trendingVideoListComponent", "models"})
@@ -269,9 +281,11 @@ Namespace API.Xhamster
containerNodes.Add({"pagesCategoryComponent", "trendingVideoListProps", "models"})
containerNodes.Add({"trendingVideoListComponent", "models"})
End If
containerNodes.Add({"trendingVideoSectionComponent", "videoModels"})
Else
URL = $"https://xhamster.com/users/{TrueName}/{IIf(IsVideo, "videos", "photos")}{IIf(Page = 1, String.Empty, $"/{Page}")}"
containerNodes.Add({If(IsVideo, "userVideoCollection", "userGalleriesCollection")})
containerNodes.Add(If(IsVideo, {"videoListComponent", "models"}, {"userGalleriesCollection"}))
End If
ThrowAny(Token)

View File

@@ -90,7 +90,11 @@ Namespace API.YouTube
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
If Not User Is Nothing AndAlso TypeOf User Is UserData Then
Return $"https://{IIf(DirectCast(User, UserData).IsMusic, "music", "www")}.youtube.com/watch?v={Media.Post.ID}"
If DirectCast(User, UserData).IsMusic Or Media.URL_BASE.IsEmptyString Then
Return $"https://{IIf(DirectCast(User, UserData).IsMusic, "music", "www")}.youtube.com/watch?v={Media.Post.ID}"
Else
Return Media.URL_BASE
End If
Else
Return String.Empty
End If

View File

@@ -137,6 +137,26 @@ Namespace API.YouTube
Dim list As New List(Of IYouTubeMediaContainer)
Dim url$ = String.Empty
Dim maxDate As Date? = Nothing
Dim __minDate As Date? = DownloadDateFrom
Dim __maxDate As Date? = DownloadDateTo
Dim __getMinDate As Func(Of Date?, Date?) = Function(ByVal dInput As Date?) As Date?
If dInput.HasValue Then
If __minDate.HasValue Then
Return {__minDate.Value, dInput.Value}.Min
Else
Return dInput
End If
ElseIf __minDate.HasValue Then
Return __minDate
Else
Return Nothing
End If
End Function
Dim shortsUrlStandardize As Action(Of IYouTubeMediaContainer, Integer) = Sub(ByVal c As IYouTubeMediaContainer, ByVal ii As Integer)
Dim sUrl$ = $"https://www.youtube.com/shorts/{c.ID}"
'c.URL = sUrl
c.URL_BASE = sUrl
End Sub
Dim nDate As Func(Of Date?, Date?) = Function(ByVal dInput As Date?) As Date?
If dInput.HasValue Then
If dInput.Value.AddDays(3) < Now Then Return dInput.Value.AddDays(1) Else Return dInput
@@ -144,22 +164,23 @@ Namespace API.YouTube
Return Nothing
End If
End Function
Dim fillList As Func(Of Date?, Boolean) = Function(ByVal lDate As Date?) As Boolean
If Not container Is Nothing AndAlso container.HasElements Then
Dim ce As IEnumerable(Of IYouTubeMediaContainer)
ce = container.Elements
If ce.ListExists Then ce = ce.Where(Function(e) e.ObjectType = YouTubeMediaType.Single)
If ce.ListExists AndAlso lDate.HasValue Then _
ce = ce.Where(Function(e) e.DateAdded <= lDate.Value AndAlso
Not e.ID.IsEmptyString AndAlso Not _TempPostsList.Contains(e.ID))
If ce.ListExists Then
maxDate = ce.Max(Function(e) e.DateAdded)
list.AddRange(ce)
Return True
End If
End If
Return False
End Function
Dim fillList As Func(Of Date?, Boolean, Boolean) = Function(ByVal lDate As Date?, ByVal ___isShorts As Boolean) As Boolean
If Not container Is Nothing AndAlso container.HasElements Then
Dim ce As IEnumerable(Of IYouTubeMediaContainer)
ce = container.Elements
If ce.ListExists Then ce = ce.Where(Function(e) e.ObjectType = YouTubeMediaType.Single)
If ce.ListExists AndAlso lDate.HasValue Then _
ce = ce.Where(Function(e) e.DateAdded >= lDate.Value AndAlso
Not e.ID.IsEmptyString AndAlso Not _TempPostsList.Contains(e.ID))
If ce.ListExists Then
maxDate = ce.Max(Function(e) e.DateAdded)
If ___isShorts Then ce.ListForEach(shortsUrlStandardize, EDP.None)
list.AddRange(ce)
Return True
End If
End If
Return False
End Function
Dim applySpecFolder As Action(Of String, Boolean) = Sub(ByVal fName As String, ByVal isPls As Boolean)
If If(container?.Count, 0) > 0 Then _
container.Elements.ForEach(Sub(ByVal el As YouTubeMediaContainerBase)
@@ -175,33 +196,33 @@ Namespace API.YouTube
maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDatePlaylist,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDatePlaylist), __maxDate,, True)
applySpecFolder.Invoke(String.Empty, False)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
If fillList.Invoke(LastDownloadDatePlaylist, False) Then LastDownloadDatePlaylist = If(maxDate, Now)
ElseIf YTMediaType = YouTubeMediaType.Channel Then
If IsMusic Or DownloadYTVideos Then
maxDate = Nothing
LastDownloadDateVideos = nDate(LastDownloadDateVideos)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/{IIf(IsMusic Or IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDateVideos,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDateVideos), __maxDate,, True)
applySpecFolder.Invoke(IIf(IsMusic, String.Empty, "Videos"), False)
If fillList.Invoke(LastDownloadDateVideos) Then LastDownloadDateVideos = If(maxDate, Now)
If fillList.Invoke(LastDownloadDateVideos, False) Then LastDownloadDateVideos = If(maxDate, Now)
End If
If Not IsMusic And DownloadYTShorts Then
maxDate = Nothing
LastDownloadDateShorts = nDate(LastDownloadDateShorts)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/shorts"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDateShorts,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDateShorts), __maxDate,, True)
applySpecFolder.Invoke("Shorts", False)
If fillList.Invoke(LastDownloadDateShorts) Then LastDownloadDateShorts = If(maxDate, Now)
If fillList.Invoke(LastDownloadDateShorts, True) Then LastDownloadDateShorts = If(maxDate, Now)
End If
If Not IsMusic And DownloadYTPlaylists Then
maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/playlists"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDatePlaylist,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDatePlaylist), __maxDate,, True)
applySpecFolder.Invoke("Playlists", True)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
If fillList.Invoke(LastDownloadDatePlaylist, False) Then LastDownloadDatePlaylist = If(maxDate, Now)
End If
If Not IsMusic And (DownloadYTCommunityImages Or DownloadYTCommunityVideos) Then DownloadCommunity(String.Empty, Token)
Else
@@ -225,6 +246,7 @@ Namespace API.YouTube
End Sub
Private Sub DownloadCommunity(ByVal Cursor As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0)
Dim URL$ = String.Empty
Const errMsg$ = "community data downloading error"
Try
Const postIdTemp$ = "Community_{0}"
Const specFolder$ = "Community"
@@ -311,6 +333,10 @@ Namespace API.YouTube
Next
End If
End With
Else
With j({"error"})
If .ListExists Then MyMainLOG = $"{ToStringForLog()} {errMsg} [{ .Value("code")}]: { .Value("message")}"
End With
End If
End With
End If
@@ -327,7 +353,7 @@ Namespace API.YouTube
If Not nextToken.IsEmptyString Then DownloadCommunity(nextToken, Token)
Catch ex As Exception
ProcessException(ex, Token, "community data downloading error")
ProcessException(ex, Token, errMsg)
End Try
End Sub
Private Sub GetChannelID()

View File

@@ -30,6 +30,7 @@ Namespace DownloadObjects
Dim MENU_LOAD_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_4 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_5 As System.Windows.Forms.ToolStripSeparator
Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
@@ -43,18 +44,19 @@ Namespace DownloadObjects
Me.BTT_FEED_REMOVE_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_REMOVE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_DOWN_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
Me.BTT_FEED_CLEAR_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_CLEAR_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_DATE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_SESSIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_DOWN_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
@@ -62,6 +64,7 @@ Namespace DownloadObjects
MENU_LOAD_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_4 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_5 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout()
'
@@ -112,10 +115,20 @@ Namespace DownloadObjects
MENU_LOAD_SEP_3.Name = "MENU_LOAD_SEP_3"
MENU_LOAD_SEP_3.Size = New System.Drawing.Size(264, 6)
'
'MENU_LOAD_SEP_4
'
MENU_LOAD_SEP_4.Name = "MENU_LOAD_SEP_4"
MENU_LOAD_SEP_4.Size = New System.Drawing.Size(264, 6)
'
'MENU_LOAD_SEP_5
'
MENU_LOAD_SEP_5.Name = "MENU_LOAD_SEP_5"
MENU_LOAD_SEP_5.Size = New System.Drawing.Size(264, 6)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_LOAD_SESSION, Me.SEP_0, MENU_VIEW, SEP_1, Me.MENU_DOWN, Me.BTT_REFRESH, Me.BTT_CLEAR, SEP_2})
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_LOAD_SESSION, Me.SEP_0, MENU_VIEW, SEP_1, Me.MENU_DOWN, Me.BTT_REFRESH, SEP_2})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(484, 25)
@@ -124,7 +137,7 @@ Namespace DownloadObjects
'MENU_LOAD_SESSION
'
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_4, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE})
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_4, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE, MENU_LOAD_SEP_5, Me.BTT_MERGE_SESSIONS, Me.BTT_CLEAR_DAILY})
Me.MENU_LOAD_SESSION.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION"
@@ -194,6 +207,59 @@ Namespace DownloadObjects
Me.BTT_FEED_REMOVE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_REMOVE_SPEC.Text = "Remove checked from special feed..."
'
'BTT_FEED_CLEAR_FAV
'
Me.BTT_FEED_CLEAR_FAV.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_FAV.Name = "BTT_FEED_CLEAR_FAV"
Me.BTT_FEED_CLEAR_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_FAV.Text = "Clear Favorite"
'
'BTT_FEED_CLEAR_SPEC
'
Me.BTT_FEED_CLEAR_SPEC.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_SPEC.Name = "BTT_FEED_CLEAR_SPEC"
Me.BTT_FEED_CLEAR_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_SPEC.Text = "Clear special feed..."
'
'BTT_FEED_DELETE_SPEC
'
Me.BTT_FEED_DELETE_SPEC.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_SPEC.Name = "BTT_FEED_DELETE_SPEC"
Me.BTT_FEED_DELETE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_SPEC.Text = "Delete special feed..."
'
'BTT_FEED_DELETE_DAILY_LIST
'
Me.BTT_FEED_DELETE_DAILY_LIST.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_LIST.Name = "BTT_FEED_DELETE_DAILY_LIST"
Me.BTT_FEED_DELETE_DAILY_LIST.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_LIST.Text = "Delete daily feed (by list)"
'
'BTT_FEED_DELETE_DAILY_DATE
'
Me.BTT_FEED_DELETE_DAILY_DATE.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_DATE.Name = "BTT_FEED_DELETE_DAILY_DATE"
Me.BTT_FEED_DELETE_DAILY_DATE.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)"
'
'BTT_MERGE_SESSIONS
'
Me.BTT_MERGE_SESSIONS.AutoToolTip = True
Me.BTT_MERGE_SESSIONS.Image = Global.SCrawler.My.Resources.Resources.DBPic_32
Me.BTT_MERGE_SESSIONS.Name = "BTT_MERGE_SESSIONS"
Me.BTT_MERGE_SESSIONS.Size = New System.Drawing.Size(267, 22)
Me.BTT_MERGE_SESSIONS.Text = "Merge sessions"
Me.BTT_MERGE_SESSIONS.ToolTipText = "Merge multiple session feeds into one"
'
'BTT_CLEAR_DAILY
'
Me.BTT_CLEAR_DAILY.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_CLEAR_DAILY.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_DAILY.Name = "BTT_CLEAR_DAILY"
Me.BTT_CLEAR_DAILY.Size = New System.Drawing.Size(267, 22)
Me.BTT_CLEAR_DAILY.Text = "Clear session"
Me.BTT_CLEAR_DAILY.ToolTipText = "Clear data list (session)"
'
'SEP_0
'
Me.SEP_0.Name = "SEP_0"
@@ -235,15 +301,6 @@ Namespace DownloadObjects
Me.BTT_REFRESH.Text = "Refresh"
Me.BTT_REFRESH.ToolTipText = "Refresh data list"
'
'BTT_CLEAR
'
Me.BTT_CLEAR.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_CLEAR.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR.Name = "BTT_CLEAR"
Me.BTT_CLEAR.Size = New System.Drawing.Size(54, 22)
Me.BTT_CLEAR.Text = "Clear"
Me.BTT_CLEAR.ToolTipText = "Clear data list"
'
'TP_DATA
'
Me.TP_DATA.AutoScroll = True
@@ -269,46 +326,6 @@ Namespace DownloadObjects
Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1
'
'MENU_LOAD_SEP_4
'
MENU_LOAD_SEP_4.Name = "MENU_LOAD_SEP_4"
MENU_LOAD_SEP_4.Size = New System.Drawing.Size(264, 6)
'
'BTT_FEED_CLEAR_FAV
'
Me.BTT_FEED_CLEAR_FAV.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_FAV.Name = "BTT_FEED_CLEAR_FAV"
Me.BTT_FEED_CLEAR_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_FAV.Text = "Clear Favorite"
'
'BTT_FEED_CLEAR_SPEC
'
Me.BTT_FEED_CLEAR_SPEC.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_SPEC.Name = "BTT_FEED_CLEAR_SPEC"
Me.BTT_FEED_CLEAR_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_SPEC.Text = "Clear special feed..."
'
'BTT_FEED_DELETE_SPEC
'
Me.BTT_FEED_DELETE_SPEC.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_SPEC.Name = "BTT_FEED_DELETE_SPEC"
Me.BTT_FEED_DELETE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_SPEC.Text = "Delete special feed..."
'
'BTT_FEED_DELETE_DAILY_LIST
'
Me.BTT_FEED_DELETE_DAILY_LIST.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_LIST.Name = "BTT_FEED_DELETE_DAILY_LIST"
Me.BTT_FEED_DELETE_DAILY_LIST.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_LIST.Text = "Delete daily feed (by list)"
'
'BTT_FEED_DELETE_DAILY_DATE
'
Me.BTT_FEED_DELETE_DAILY_DATE.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_DATE.Name = "BTT_FEED_DELETE_DAILY_DATE"
Me.BTT_FEED_DELETE_DAILY_DATE.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)"
'
'DownloadFeedForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -330,7 +347,7 @@ Namespace DownloadObjects
End Sub
Private WithEvents BTT_REFRESH As ToolStripButton
Private WithEvents BTT_CLEAR As ToolStripButton
Private WithEvents BTT_CLEAR_DAILY As ToolStripMenuItem
Private WithEvents MENU_LOAD_SESSION As ToolStripDropDownButton
Private WithEvents BTT_LOAD_SESSION_LAST As ToolStripMenuItem
Private WithEvents BTT_LOAD_SESSION_CHOOSE As ToolStripMenuItem
@@ -354,5 +371,6 @@ Namespace DownloadObjects
Private WithEvents BTT_FEED_DELETE_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_LIST As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_DATE As ToolStripMenuItem
Private WithEvents BTT_MERGE_SESSIONS As ToolStripMenuItem
End Class
End Namespace

View File

@@ -144,10 +144,13 @@
<metadata name="MENU_LOAD_SEP_3.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="MENU_LOAD_SEP_4.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_LOAD_SEP_5.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
</root>

View File

@@ -37,6 +37,7 @@ Namespace DownloadObjects
Return OPT_SUBSCRIPTIONS.Checked
End Get
End Property
Private IsSession As Boolean = True
#End Region
#Region "Initializer"
Friend Sub New()
@@ -105,7 +106,7 @@ Namespace DownloadObjects
Private Sub DownloadFeedForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
ClearTable()
MyRange.Dispose()
BTT_CLEAR.Dispose()
BTT_CLEAR_DAILY.Dispose()
DataList.Clear()
End Sub
Private Sub DownloadFeedForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
@@ -171,6 +172,7 @@ Namespace DownloadObjects
End Try
End Sub
Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
IsSession = False
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then
DataList.Clear()
@@ -291,12 +293,15 @@ Namespace DownloadObjects
#Region "Feed"
#Region "Load"
Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click
IsSession = True
RefillList()
End Sub
Private Sub BTT_LOAD_SESSION_LAST_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_LAST.Click
IsSession = True
SessionChooser(True)
End Sub
Private Sub BTT_LOAD_SESSION_CHOOSE_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CHOOSE.Click
IsSession = True
SessionChooser(False)
End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False,
@@ -318,7 +323,7 @@ Namespace DownloadObjects
Return False
End If
End Function
If Not GetLast Then __getFiles.Invoke
__getFiles.Invoke
If Not GetLast And GetFilesOnly And Not fList.ListExists Then
MsgBoxE({"No session files found", "Get session files"}, vbExclamation)
ElseIf Not GetLast AndAlso fList.ListExists Then
@@ -352,18 +357,24 @@ Namespace DownloadObjects
MsgBoxE(m)
End If
End Using
ElseIf Downloader.FilesSessionActual(False).Exists OrElse __getFiles.Invoke Then
If Downloader.FilesSessionActual(False).Exists Then
f = Downloader.FilesSessionActual(False)
ElseIf Downloader.FilesSessionActual(False).Exists OrElse fList.ListExists Then
If GetLast Then
If fList.ListExists Then
f = fList(IIf(fList.Count > 1 And Downloader.FilesSessionActual(False).Exists, 1, 0))
Else
f = Downloader.FilesSessionActual(False)
End If
Else
f = fList(0)
f = Downloader.FilesSessionActual(False)
End If
If f.Exists Then
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then DataList.Clear() : DataList.ListAddList(x, lcr)
x.Dispose()
CleanDataList()
RefillList(False)
End If
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then DataList.Clear() : DataList.ListAddList(x, lcr)
x.Dispose()
CleanDataList()
RefillList(False)
Else
m.Text = "Saved sessions not found"
MsgBoxE(m)
@@ -376,6 +387,7 @@ Namespace DownloadObjects
#End Region
#Region "Load fav, spec"
Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click
IsSession = False
DataList.Clear()
With Settings.Feeds.Favorite
.RemoveNotExist(FileNotExist)
@@ -383,6 +395,7 @@ Namespace DownloadObjects
End With
End Sub
Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click
IsSession = False
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then
DataList.Clear()
@@ -408,7 +421,7 @@ Namespace DownloadObjects
Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click
Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If c.ListExists Then
With FeedSpecialCollection.ChooseFeeds(False)
With FeedSpecialCollection.ChooseFeeds(True)
If .ListExists Then .ForEach(Sub(f) f.Add(c))
End With
Else
@@ -512,6 +525,77 @@ Namespace DownloadObjects
End Try
End Sub
#End Region
#Region "Clear session"
Private Sub BTT_CLEAR_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DAILY.Click
If MsgBoxE({"Are you sure you want to clear this session data?", "Clear session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.Files.Clear()
ClearTable()
RefillList()
End If
End Sub
#End Region
#Region "Merge feeds"
Private Sub MergeFeeds() Handles BTT_MERGE_SESSIONS.Click
Try
Const msgTitle$ = "Merge feeds"
Dim files As New List(Of SFile)
Dim abs% = 0, prev% = 0, curr%, i%
Dim x As XmlFile
Dim f As SFile
Dim um As UserMediaD
Dim data As New List(Of UserMediaD)
Dim tmpData As New List(Of UserMediaD)
Dim lrc As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier)
SessionChooser(False, True, files)
If files.ListExists(2) Then
files.Sort()
For Each f In files
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData(EDP.None)
If x.Count > 0 Then tmpData.ListAddList(x, lrc)
If tmpData.Count > 0 Then tmpData.Reverse() : data.AddRange(tmpData) : tmpData.Clear()
x.Dispose()
Next
If data.Count > 0 Then
For i = 0 To data.Count - 1
um = data(i)
curr = um.Session
If i = 0 Then
abs = curr
Else
If curr < abs And prev <> curr Then
abs += 1
ElseIf curr >= abs Then
abs = curr
End If
End If
prev = curr
um.Session = abs
data(i) = um
Next
data.Reverse()
x = New XmlFile With {.Name = TDownloader.Name_SessionXML, .AllowSameNames = True}
x.AddRange(data)
x.Save(files(0))
x.Dispose()
For i = 1 To files.Count - 1 : files(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.ReturnValue) : Next
MsgBoxE({$"Session data was combined into '{files(0).Name}'.{vbCr}{vbCr}" &
files.ListToStringE(, New CustomProvider(Function(ff As SFile) ff.Name),,, EDP.ReturnValue), msgTitle})
files.Clear()
data.Clear()
Else
MsgBoxE({"There is no session data in the selected files", msgTitle}, vbExclamation)
End If
ElseIf files.ListExists(1) Then
MsgBoxE({"You must select two or more files to merge feeds", msgTitle}, vbExclamation)
Else
MsgBoxE({"You haven't selected any feeds", msgTitle}, vbExclamation)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.MergeFeeds]")
End Try
End Sub
#End Region
#End Region
#Region "View modes"
Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click
@@ -538,11 +622,7 @@ Namespace DownloadObjects
BTT_REFRESH.ControlChangeColor(ToolbarTOP, Added, False)
End Sub
Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click
RefillList()
End Sub
Private Sub BTT_CLEAR_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR.Click
Downloader.Files.Clear()
ClearTable()
IsSession = True
RefillList()
End Sub
#End Region
@@ -753,7 +833,7 @@ Namespace DownloadObjects
Dim p As New TPCELL(DataRows, DataColumns)
Dim fmList As New List(Of FeedMedia)
d.ForEach(Sub(ByVal de As UserMediaD)
fmList.Add(New FeedMedia(de, w, h))
fmList.Add(New FeedMedia(de, w, h, IsSession))
With fmList.Last
AddHandler .MediaDeleted, AddressOf FeedMedia_MediaDeleted
AddHandler .MediaDownload, AddressOf FeedMedia_Download

View File

@@ -159,7 +159,7 @@ Namespace DownloadObjects
Public Sub New()
InitializeComponent()
End Sub
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer)
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer, ByVal IsSession As Boolean)
Try
InitializeComponent()
Me.Media = Media
@@ -278,7 +278,7 @@ Namespace DownloadObjects
End With
End If
If Settings.FeedAddSessionToCaption Then info = $"[{Media.Session}] {info}"
If Settings.FeedAddSessionToCaption And IsSession Then info = $"[{Media.Session}] {info}"
If Settings.FeedAddDateToCaption Then info &= $" ({Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)})"
LBL_INFO.Text = info
If Not Media.User Is Nothing AndAlso Not Media.User.HOST Is Nothing Then

View File

@@ -26,6 +26,7 @@ Namespace DownloadObjects
#End Region
#Region "Declarations"
#Region "Files"
Friend Const Name_SessionXML As String = "Session"
Friend Structure UserMediaD : Implements IComparable(Of UserMediaD), IEquatable(Of UserMediaD), IEContainerProvider
#Region "XML Names"
Private Const Name_Data As String = "Data"
@@ -40,7 +41,7 @@ Namespace DownloadObjects
Friend ReadOnly Data As UserMedia
Friend ReadOnly UserInfo As UserInfo
Friend ReadOnly [Date] As Date
Friend ReadOnly Session As Integer
Friend Session As Integer
Friend IsSavedPosts As Boolean
Friend Sub New(ByVal Data As UserMedia, ByVal User As IUserData, ByVal Session As Integer)
Me.Data = Data
@@ -122,19 +123,29 @@ Namespace DownloadObjects
Return _FilesSessionActual
End Get
End Property
Private _FilesSaving As Boolean = False
Friend Sub FilesSave()
While _FilesSaving Or _FilesUpdating : Thread.Sleep(100) : End While
Dim i% = 0
While Not FilesSaveImpl() And i < 10 : i += 1 : End While
End Sub
Private Function FilesSaveImpl() As Boolean
_FilesSaving = True
Try
If Settings.FeedStoreSessionsData And Files.Count > 0 Then
ClearSessions()
Using x As New XmlFile With {.Name = "Session", .AllowSameNames = True}
Using x As New XmlFile With {.Name = Name_SessionXML, .AllowSameNames = True}
x.AddRange(Files)
x.Save(FilesSessionActual)
End Using
End If
Return True
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.FilesSave]")
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.FilesSave]", False)
Finally
_FilesSaving = False
End Try
End Sub
End Function
Private _FilesUpdating As Boolean = False
Friend Sub FilesUpdatePendingUsers()
_FilesUpdating = True

View File

@@ -157,6 +157,7 @@ Namespace Editors
Me.TXT_FEED_CENTER_IMAGE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.COLORS_FEED = New SCrawler.Editors.ColorPicker()
Me.CH_FEED_SHOW_FRIENDLY = New System.Windows.Forms.CheckBox()
Me.CH_FEED_SHOW_SPEC_MEDIAITEM = New System.Windows.Forms.CheckBox()
Me.TXT_YTDLP = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FFMPEG = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_CURL = New PersonalUtilities.Forms.Controls.TextBoxExtended()
@@ -177,7 +178,7 @@ Namespace Editors
Me.TAB_MAIN = New System.Windows.Forms.TabControl()
Me.TAB_ENVIR = New System.Windows.Forms.TabPage()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
Me.CH_FEED_SHOW_SPEC_MEDIAITEM = New System.Windows.Forms.CheckBox()
Me.CH_NOTIFY_LOG = New System.Windows.Forms.CheckBox()
TP_BASIS = New System.Windows.Forms.TableLayoutPanel()
TP_IMAGES = New System.Windows.Forms.TableLayoutPanel()
TP_FILE_NAME = New System.Windows.Forms.TableLayoutPanel()
@@ -1670,6 +1671,17 @@ Namespace Editors
Me.CH_FEED_SHOW_FRIENDLY.Text = "Show friendly names instead of usernames"
Me.CH_FEED_SHOW_FRIENDLY.UseVisualStyleBackColor = True
'
'CH_FEED_SHOW_SPEC_MEDIAITEM
'
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.AutoSize = True
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Location = New System.Drawing.Point(4, 247)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Name = "CH_FEED_SHOW_SPEC_MEDIAITEM"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Size = New System.Drawing.Size(568, 19)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.TabIndex = 9
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Text = "Show special feeds in media items"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.UseVisualStyleBackColor = True
'
'TAB_NOTIFY
'
TAB_NOTIFY.Controls.Add(TP_NOTIFY_MAIN)
@@ -1692,10 +1704,12 @@ Namespace Editors
TP_NOTIFY_MAIN.Controls.Add(Me.CH_NOTIFY_SAVED_POSTS, 0, 5)
TP_NOTIFY_MAIN.Controls.Add(Me.CH_STD, 0, 6)
TP_NOTIFY_MAIN.Controls.Add(Me.CH_STD_EVERY, 0, 7)
TP_NOTIFY_MAIN.Controls.Add(Me.CH_NOTIFY_LOG, 0, 8)
TP_NOTIFY_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_NOTIFY_MAIN.Location = New System.Drawing.Point(0, 0)
TP_NOTIFY_MAIN.Name = "TP_NOTIFY_MAIN"
TP_NOTIFY_MAIN.RowCount = 9
TP_NOTIFY_MAIN.RowCount = 10
TP_NOTIFY_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_NOTIFY_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_NOTIFY_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_NOTIFY_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
@@ -2140,16 +2154,17 @@ Namespace Editors
Me.CONTAINER_MAIN.TabIndex = 0
Me.CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'CH_FEED_SHOW_SPEC_MEDIAITEM
'CH_NOTIFY_LOG
'
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.AutoSize = True
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Location = New System.Drawing.Point(4, 247)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Name = "CH_FEED_SHOW_SPEC_MEDIAITEM"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Size = New System.Drawing.Size(568, 19)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.TabIndex = 9
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Text = "Show special feeds in media items"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.UseVisualStyleBackColor = True
Me.CH_NOTIFY_LOG.AutoSize = True
Me.CH_NOTIFY_LOG.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_NOTIFY_LOG.Location = New System.Drawing.Point(4, 212)
Me.CH_NOTIFY_LOG.Name = "CH_NOTIFY_LOG"
Me.CH_NOTIFY_LOG.Size = New System.Drawing.Size(568, 19)
Me.CH_NOTIFY_LOG.TabIndex = 8
Me.CH_NOTIFY_LOG.Text = "The log contains new data"
TT_MAIN.SetToolTip(Me.CH_NOTIFY_LOG, "Show a notification when the new data is added to the log.")
Me.CH_NOTIFY_LOG.UseVisualStyleBackColor = True
'
'GlobalSettingsForm
'
@@ -2341,5 +2356,6 @@ Namespace Editors
Private WithEvents CH_STD_YT_CREATE_URL As CheckBox
Private WithEvents CH_USE_DEF_ACC As CheckBox
Private WithEvents CH_FEED_SHOW_SPEC_MEDIAITEM As CheckBox
Private WithEvents CH_NOTIFY_LOG As CheckBox
End Class
End Namespace

View File

@@ -74,6 +74,7 @@ Namespace Editors
CH_NOTIFY_SAVED_POSTS.Checked = .ShowNotificationsDownSavedPosts
CH_STD.Checked = .ShowNotificationsSTDownloader
CH_STD_EVERY.Checked = .ShowNotificationsSTDownloaderEveryDownload
CH_NOTIFY_LOG.Checked = .ShowNotificationsLOG
'Defaults
CH_SEPARATE_VIDEO_FOLDER.Checked = .SeparateVideoFolder.Value
CH_DEF_TEMP.Checked = .DefaultTemporary
@@ -248,6 +249,7 @@ Namespace Editors
.ShowNotificationsDownSavedPosts.Value = CH_NOTIFY_SAVED_POSTS.Checked
.ShowNotificationsSTDownloader.Value = CH_STD.Checked
.ShowNotificationsSTDownloaderEveryDownload.Value = CH_STD_EVERY.Checked
.ShowNotificationsLOG.Value = CH_NOTIFY_LOG.Checked
'Defaults
.SeparateVideoFolder.Value = CH_SEPARATE_VIDEO_FOLDER.Checked
.DefaultTemporary.Value = CH_DEF_TEMP.Checked

View File

@@ -213,7 +213,7 @@ Namespace Editors
Dim loAdded As Boolean = False
Dim pArr() As Boolean
If .PropList.Exists(Function(p) If(p.Options?.IsAuth, False)) Then pArr = {True, False} Else pArr = {False}
.PropList.Sort()
If .PropList.Exists(Function(p) p.ControlNumber >= 0) Then .PropList.Sort()
For Each pAuth As Boolean In pArr
For Each prop As PropertyValueHost In .PropList
If Not prop.Options Is Nothing Then

View File

@@ -430,6 +430,7 @@ Namespace Editors
If Not UserInstance Is Nothing Then
With DirectCast(UserInstance, UserDataBase)
.User = User
.ResetHost()
Dim setFriendly As Boolean = True
If FriendlyNameIsSiteName Then
If Not FriendlyNameChanged Then
@@ -590,7 +591,7 @@ CloseForm:
End Sub
Private _AccountsRefilling As Boolean = False
Private Sub CMB_ACCOUNT_ActionSelectedItemChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles CMB_ACCOUNT.ActionSelectedItemChanged
If Not _AccountsRefilling Then SetParamsBySite(False)
If Not _AccountsRefilling And UserInstance Is Nothing Then SetParamsBySite(False)
End Sub
Private Sub CH_TEMP_CheckedChanged(sender As Object, e As EventArgs) Handles CH_TEMP.CheckedChanged
If CH_TEMP.Checked Then CH_FAV.Checked = False : CH_READY_FOR_DOWN.Checked = False

View File

@@ -139,6 +139,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_FEED_SHOW = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CHANNELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_DOWNLOADER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_SCHEDULER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem()
@@ -987,9 +988,9 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'
'TRAY_CONTEXT
'
Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_TRAY_PAUSE_AUTOMATION, Me.BTT_TRAY_SILENT_MODE, Me.BTT_TRAY_FEED_SHOW, Me.BTT_TRAY_CHANNELS, Me.BTT_TRAY_DOWNLOADER, TRAY_SEP_1, Me.BTT_TRAY_SHOW_HIDE, TRAY_SEP_2, Me.BTT_TRAY_CLOSE, Me.BTT_TRAY_CLOSE_NO_SCRIPT})
Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_TRAY_PAUSE_AUTOMATION, Me.BTT_TRAY_SILENT_MODE, Me.BTT_TRAY_FEED_SHOW, Me.BTT_TRAY_CHANNELS, Me.BTT_TRAY_DOWNLOADER, Me.BTT_TRAY_SCHEDULER, TRAY_SEP_1, Me.BTT_TRAY_SHOW_HIDE, TRAY_SEP_2, Me.BTT_TRAY_CLOSE, Me.BTT_TRAY_CLOSE_NO_SCRIPT})
Me.TRAY_CONTEXT.Name = "TRAY_CONTEXT"
Me.TRAY_CONTEXT.Size = New System.Drawing.Size(171, 192)
Me.TRAY_CONTEXT.Size = New System.Drawing.Size(171, 214)
'
'BTT_TRAY_PAUSE_AUTOMATION
'
@@ -1032,6 +1033,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_DOWNLOADER.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_DOWNLOADER.Text = "Downloader"
'
'BTT_TRAY_SCHEDULER
'
Me.BTT_TRAY_SCHEDULER.Image = Global.SCrawler.My.Resources.Resources.ScriptPic_32
Me.BTT_TRAY_SCHEDULER.Name = "BTT_TRAY_SCHEDULER"
Me.BTT_TRAY_SCHEDULER.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_SCHEDULER.Text = "Scheduler"
'
'BTT_TRAY_SHOW_HIDE
'
Me.BTT_TRAY_SHOW_HIDE.Image = Global.SCrawler.My.Resources.Resources.ApplicationPic_16
@@ -1181,4 +1189,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents MENU_INFO_SHOW_QUEUE As ToolStripMenuItem
Private WithEvents BTT_DOWN_SPEC As ToolStripKeyMenuItem
Private WithEvents BTT_SHOW_FILTER_ADV As ToolStripMenuItem
Private WithEvents BTT_TRAY_SCHEDULER As ToolStripMenuItem
End Class

View File

@@ -603,7 +603,7 @@ CloseResume:
ControlInvokeFast(Toolbar_TOP, BTT_DOWN_AUTOMATION_PAUSE, Sub() BTT_DOWN_AUTOMATION_PAUSE.Visible = b)
ControlInvokeFast(Me, Sub() BTT_TRAY_PAUSE_AUTOMATION.Visible = b)
End Sub
Private Async Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click
Private Async Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click, BTT_TRAY_SCHEDULER.Click
Try
Using f As New SchedulerEditorForm : f.ShowDialog() : End Using
Await Settings.Automation.Start(False)
@@ -842,7 +842,7 @@ CloseResume:
#End Region
#End Region
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(Settings.Design,,,, Sub() MainFrameObj.UpdateLogButton())
MainFrameObj.ShowLog()
End Sub
Private Sub BTT_VERSION_INFO_Click(sender As Object, e As EventArgs) Handles BTT_VERSION_INFO.Click
CheckVersion(True)

View File

@@ -19,6 +19,11 @@ Friend Class MainFrameObjects : Implements INotificator
MF = f
Notificator = New NotificationsManager
PauseButtons = New DownloadObjects.AutoDownloaderPauseButtons(DownloadObjects.AutoDownloaderPauseButtons.ButtonsPlace.MainFrame)
ProgramLogInitialize()
With ProgramLog
AddHandler .TextAdded, AddressOf ProgramLog_TextAdded
AddHandler .TextCleared, AddressOf ProgramLog_TextCleared
End With
End Sub
#Region "Users"
Friend Sub FocusUser(ByVal Key As String, Optional ByVal ActivateForm As Boolean = False)
@@ -65,6 +70,12 @@ Friend Class MainFrameObjects : Implements INotificator
Friend Function GetUserListProvider(ByVal WithCollections As Boolean) As IFormatProvider
Return MF.GetUserListProvider(WithCollections)
End Function
Friend Sub ShowLog()
MyMainLOG_ShowForm(Settings.Design,,,, Sub()
UpdateLogButton()
LogFormClosed()
End Sub)
End Sub
#End Region
#Region "Notifications"
Private Sub INotificator_ShowNotification(ByVal Text As String, ByVal Image As SFile) Implements INotificator.ShowNotification
@@ -88,6 +99,7 @@ Friend Class MainFrameObjects : Implements INotificator
Case $"{NotificationInternalKey}_{NotifyObj.Channels}" : MF.MyChannels.FormShowS()
Case $"{NotificationInternalKey}_{NotifyObj.SavedPosts}" : MF.MySavedPosts.FormShowS()
Case $"{NotificationInternalKey}_{NotifyObj.STDownloader}" : VideoDownloader.FormShowS()
Case $"{NotificationInternalKey}_{NotifyObj.LOG}" : ControlInvokeFast(MF, AddressOf ShowLog, EDP.LogMessageValue)
Case Else : Focus(True)
End Select
ElseIf Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key, found, activateForm) Then
@@ -100,4 +112,16 @@ Friend Class MainFrameObjects : Implements INotificator
End If
End Sub
#End Region
#Region "LOG events support"
Private _LogNotificationsEnabled As Boolean = True
Private Sub ProgramLog_TextAdded(ByVal Sender As Object, ByVal e As EventArgs)
If _LogNotificationsEnabled Then _LogNotificationsEnabled = False : ShowNotification(NotifyObj.LOG, "There is new data in the log")
End Sub
Private Sub ProgramLog_TextCleared(ByVal Sender As Object, ByVal e As EventArgs)
_LogNotificationsEnabled = True
End Sub
Friend Sub LogFormClosed()
_LogNotificationsEnabled = True
End Sub
#End Region
End Class

View File

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

View File

@@ -23,6 +23,7 @@ Namespace Plugin.Hosts
Private ReadOnly Keeper As SettingsHost
Protected Source As Object 'ReadOnly
Protected Member As MemberInfo
Private ReadOnly MemberRef As MemberInfo
Friend ReadOnly Options As PropertyOption
Friend Overridable ReadOnly Property Name As String
Protected _Type As Type
@@ -41,7 +42,7 @@ Namespace Plugin.Hosts
#End Region
#Region "Control"
Friend Property Control As Control
Protected ControlNumber As Integer = -1
Friend Property ControlNumber As Integer = -1
Friend ReadOnly Property ControlHeight As Integer
Get
If Not Control Is Nothing Then
@@ -245,13 +246,12 @@ Namespace Plugin.Hosts
Me.Keeper = Keeper
Source = PropertySource
Name = Member.Name
MemberRef = Member
ControlNumber = If(Member.GetCustomAttribute(Of ControlNumber)()?.PropertyNumber, -1)
If DirectCast(Member, PropertyInfo).PropertyType Is GetType(PropertyValue) Then
ExternalValue = DirectCast(DirectCast(Member, PropertyInfo).GetValue(Source), PropertyValue)
_Value = ExternalValue.Value
AddHandler ExternalValue.ValueChanged, AddressOf ExternalValueChanged
UpdateMember()
Options = Member.GetCustomAttribute(Of PropertyOption)()
IsTaskCounter = Not Member.GetCustomAttribute(Of TaskCounter)() Is Nothing
_XmlName = If(Member.GetCustomAttribute(Of PXML)()?.ElementName, String.Empty)
@@ -274,9 +274,22 @@ Namespace Plugin.Hosts
Next
End If
End Sub
Friend Sub UpdateMember()
If Not ExternalValue Is Nothing Then
Try : RemoveHandler ExternalValue.ValueChanged, AddressOf ExternalValueChanged : Catch : End Try
End If
_ExternalValue = DirectCast(DirectCast(MemberRef, PropertyInfo).GetValue(Source), PropertyValue)
_Value = ExternalValue.Value
AddHandler ExternalValue.ValueChanged, AddressOf ExternalValueChanged
End Sub
#End Region
#Region "Value"
Protected ReadOnly Property ExternalValue As PropertyValue
Private _ExternalValue As PropertyValue = Nothing
Private ReadOnly Property ExternalValue As PropertyValue
Get
Return _ExternalValue
End Get
End Property
Friend ReadOnly Property XValue As IXMLValue
Protected _Value As Object
Friend Overloads Property Value As Object Implements IPropertyValue.Value

View File

@@ -143,6 +143,9 @@ Namespace Plugin.Hosts
End Set
End Property
Friend ReadOnly Property [Default] As Boolean
Friend Sub DefaultInstanceChanged()
If PropList.Count > 0 Then PropList.ForEach(Sub(p) p.UpdateMember())
End Sub
Friend ReadOnly Property IsSeparatedTasks As Boolean = False
Friend ReadOnly Property IsSavedPostsCompatible As Boolean = False
Private ReadOnly _TaskCountDefined As Integer? = Nothing

View File

@@ -122,7 +122,7 @@ Namespace Plugin.Hosts
AddHandler Host.OkClick, AddressOf Hosts_OkClick
AddHandler Host.Deleted, AddressOf Hosts_Deleted
AddHandler Host.CloneClick, AddressOf Hosts_CloneClick
If Host.Index > 0 Then Host.Source.DefaultInstance = [Default].Source
If Host.Index > 0 Then Host.Source.DefaultInstance = [Default].Source : Host.DefaultInstanceChanged()
End Sub
Private Sub Hosts_OkClick(ByVal Obj As SettingsHost)
If Obj.Index = -1 Then

View File

@@ -194,6 +194,11 @@
<Compile Include="API\Mastodon\SiteSettings.vb" />
<Compile Include="API\Mastodon\UserData.vb" />
<Compile Include="API\OnlyFans\Declarations.vb" />
<Compile Include="API\OnlyFans\OFResources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>OFResources.resx</DependentUpon>
</Compile>
<Compile Include="API\OnlyFans\SiteSettings.vb" />
<Compile Include="API\OnlyFans\UserData.vb" />
<Compile Include="API\OnlyFans\UserExchangeOptions.vb" />
@@ -490,6 +495,11 @@
<EmbeddedResource Include="API\BaseObjects\InternalSettingsForm.resx">
<DependentUpon>InternalSettingsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\OnlyFans\OFResources.resx">
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<Generator>ResXFileCodeGenerator</Generator>
<LastGenOutput>OFResources.Designer.vb</LastGenOutput>
</EmbeddedResource>
<EmbeddedResource Include="API\Reddit\RedditViewSettingsForm.resx">
<DependentUpon>RedditViewSettingsForm.vb</DependentUpon>
</EmbeddedResource>
@@ -588,6 +598,7 @@
</ItemGroup>
<ItemGroup>
<None Include=".editorconfig" />
<None Include="API\OnlyFans\OFScraperConfigPattern.json" />
<None Include="Content\Pictures\ApplicationPic_16.png" />
<None Include="Content\Pictures\BookmarkBlack_16.png" />
<None Include="Content\Pictures\DBPic_32.png" />

View File

@@ -27,6 +27,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend Const CookieEncryptKey As String = "SCrawlerCookiesEncryptKeyword"
Private Const EnvironmentPath As String = "Environment\"
Friend Const CollectionsFolderName As String = "Collections"
Private Const PermanentCacheSnapshotsPath As String = "_CacheSnapshots\"
Friend Const DefaultCmdEncoding As Integer = BatchExecutor.UnicodeEncoding
Friend ReadOnly Design As XmlFile
Private ReadOnly MyXML As XmlFile
@@ -113,7 +114,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property CacheSnapshots(ByVal Permanent As Boolean) As CacheKeeper
Get
If Permanent Then
If _CacheSnapshots Is Nothing Then _CacheSnapshots = New CacheKeeper("_CacheSnapshots\") With {.DeleteCacheOnDispose = False, .DeleteRootOnDispose = False}
If _CacheSnapshots Is Nothing Then _CacheSnapshots = New CacheKeeper(PermanentCacheSnapshotsPath) With {.DeleteCacheOnDispose = False, .DeleteRootOnDispose = False}
Return _CacheSnapshots
Else
Dim dir As SFile = $"{Cache.RootDirectory.PathWithSeparator}Snapshots\"
@@ -336,6 +337,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
ShowNotificationsDownSavedPosts = New XMLValue(Of Boolean)("SavedPosts", True, MyXML, n)
ShowNotificationsSTDownloader = New XMLValue(Of Boolean)("STDownloader", True, MyXML, n)
ShowNotificationsSTDownloaderEveryDownload = New XMLValue(Of Boolean)("STDownloaderEveryDownload", True, MyXML, n)
ShowNotificationsLOG = New XMLValue(Of Boolean)("LOG", True, MyXML, n)
ProgramText = New XMLValue(Of String)("ProgramText",, MyXML)
ProgramDescription = New XMLValue(Of String)("ProgramDescription",, MyXML)
@@ -672,6 +674,14 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend Sub DeleteCachePath()
Reddit.ChannelsCollection.ChannelsPathCache.Delete(SFO.Path, SFODelete.None, EDP.None)
End Sub
Private Sub DeleteCachePathPermanent()
Try
Dim f As New SFile(PermanentCacheSnapshotsPath)
If f.Exists(SFO.Path, False) AndAlso Not SFile.GetFiles(f,, IO.SearchOption.AllDirectories, EDP.ReturnValue).ListExists Then _
f.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.None)
Catch
End Try
End Sub
Friend Overloads Function UserExists(ByVal UserSite As String, ByVal UserID As String) As Boolean
Dim UserFinderBase As Predicate(Of IUserData) = Function(user) user.Site = UserSite And user.Name = UserID
Dim UserFinder As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
@@ -944,6 +954,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Channels
SavedPosts
STDownloader
LOG
End Enum
Friend ReadOnly Property ProcessNotification(ByVal Sender As NotificationObjects) As Boolean
Get
@@ -955,6 +966,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Case NotificationObjects.Channels : Return ShowNotificationsDownChannels
Case NotificationObjects.SavedPosts : Return ShowNotificationsDownSavedPosts
Case NotificationObjects.STDownloader : Return ShowNotificationsSTDownloader
Case NotificationObjects.LOG : Return ShowNotificationsLOG
Case Else : Return True
End Select
Else
@@ -970,6 +982,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property ShowNotificationsDownSavedPosts As XMLValue(Of Boolean)
Friend ReadOnly Property ShowNotificationsSTDownloader As XMLValue(Of Boolean)
Friend ReadOnly Property ShowNotificationsSTDownloaderEveryDownload As XMLValue(Of Boolean)
Friend ReadOnly Property ShowNotificationsLOG As XMLValue(Of Boolean)
#End Region
#Region "Other program properties"
Friend ReadOnly Property ProgramText As XMLValue(Of String)
@@ -1007,6 +1020,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End If
If Not Automation Is Nothing Then Automation.Dispose()
Cache.Dispose()
DeleteCachePathPermanent()
Plugins.Clear()
LastCollections.Clear()
Users.ListClearDispose