2024.5.18.0

YT
YouTubeSettings: add 'DefaultVideoHighlightFPS_H' and 'DefaultVideoHighlightFPS_L' properties
VideoOption: highlight frame rates higher/lower than this value

SCrawler
SiteSettingsBase: add 'UserAgentDefault' property
API.Facebook, API.Instagram, API.Mastodon, API.OnlyFans, API.ThreadsNet, API.Twitter: add categories
API.Instagram.SiteSettings: add 'DownDetector' validation; remove wrong header
API.Instagram.UserData: fix incorrect definition of pinned posts; add 'DefaultParser_Pinned' and 'DefaultParser_SkipPost' func (for Threads)
API.Threads: fix pinned posts processing
API.Reddit: add 429 bypass; change the naming method of video files (hosted on Reddit) to the 'YYYYMMDD_HHMMSS' pattern; add 'UserAgent' property
API.RedGifs: hide credential controls
API.Twitter: add 'Likes' downloading; change domain from twitter.com to x.com;
API.OnlyFans: set '_AllowUserAgentUpdate' to false
SiteEditorForm: group options by category
GroupListForm: enable 'OK' if it is filter
DownloadGroup: add 'FilterShowAllUsers' property
PropertyValueHost: add 'Category' property
MainFrame: the 'ALL' filter isn't unchecked when loading a filter from a saved one
Update user paths when global paths change
Scheduler: add the ability to clone the scheduler

PluginProvider
PropertyOption attribute: set category name when `IsAuth = True`
ISiteSettings: add 'UserAgentDefault' property
This commit is contained in:
Andy
2024-05-18 01:17:29 +03:00
parent ec2266f1bf
commit 444b3521eb
61 changed files with 1665 additions and 236 deletions

View File

@@ -1,3 +1,30 @@
# 2024.5.18.0
*2024-05-18*
- Added
- YouTube (standalone app): highlight frame rates higher/lower than this value (`Settings` - `Defaults Video` - `Highlight FPS (higher/lower)`).
- Sites
- Instagram: 'DownDetector' support to determine if the site is accessible
- Reddit: change the naming method of video files (hosted on Reddit) to the `YYYYMMDD_HHMMSS` pattern
- Twitter
- `Likes` downloading *(user settings)*
- **changed domain from twitter.com to x.com**
- Site settings: group options by category
- Minor improvements
- PluginProvider
- `PropertyOption` attribute: set category name when `IsAuth = True`
- `ISiteSettings`: added `UserAgentDefault` property
- Updated
- gallery-dl up to version **1.27.0-dev**
- Fixed
- Sites
- Instagram: incorrect definition of pinned posts
- Threads: new posts are no longer downloaded from profiles with pinned posts
- Reddit: bypass error 429 for saved posts
- Twitter: **data is not downloading due to domain change from twitter.com to x.com**
- Minor bugs
# 2024.5.4.0 # 2024.5.4.0
*2024-05-04* *2024-05-04*
@@ -5,13 +32,13 @@
- Added - Added
- YouTube (standalone app): setting to remove specific characters (`Defaults` - `Remove characters`) - YouTube (standalone app): setting to remove specific characters (`Defaults` - `Remove characters`)
- Instagram: simplify the `Connection closed` error - Instagram: simplify the `Connection closed` error
- Users search: add 'FriendlyName' to search results - Users search: add `Friendly name` to search results
- Fixed - Fixed
- YouTube (standalone app): incorrect download processing when the file name ends with a dot (Issue #188) - YouTube (standalone app): incorrect download processing when the file name ends with a dot (Issue #188)
- The program is freezes when editing users in some cases - The program is freezes when editing users in some cases
- Sites - Sites
- Reddit: token update error - Reddit: token update error
- Threads: unable to obtain credentials (ID) - Threads: unable to obtain credentials (`ID`)
# 2024.4.26.0 # 2024.4.26.0

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 26 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 35 KiB

After

Width:  |  Height:  |  Size: 40 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 29 KiB

After

Width:  |  Height:  |  Size: 30 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 24 KiB

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 25 KiB

View File

@@ -36,8 +36,22 @@ Namespace Plugin.Attributes
Public Property IsInformationLabel As Boolean = False Public Property IsInformationLabel As Boolean = False
''' <summary>Label text alignment.<br/>Default: <see cref="Drawing.ContentAlignment.TopCenter"/></summary> ''' <summary>Label text alignment.<br/>Default: <see cref="Drawing.ContentAlignment.TopCenter"/></summary>
Public Property LabelTextAlign As Drawing.ContentAlignment = Drawing.ContentAlignment.TopCenter Public Property LabelTextAlign As Drawing.ContentAlignment = Drawing.ContentAlignment.TopCenter
Private _IsAuth As Boolean = False
''' <summary>This is an authorization property</summary> ''' <summary>This is an authorization property</summary>
Public Property IsAuth As Boolean = False Public Property IsAuth As Boolean
Get
Return _IsAuth
End Get
Set(ByVal _IsAuth As Boolean)
Me._IsAuth = _IsAuth
If _IsAuth And String.IsNullOrEmpty(Category) Then
Category = CategoryAuth
ElseIf Not _IsAuth AndAlso Not String.IsNullOrEmpty(Category) AndAlso Category = CategoryAuth Then
Category = String.Empty
End If
End Set
End Property
Public Const CategoryAuth As String = "Authorization"
Public Property Category As String = Nothing Public Property Category As String = Nothing
Public Property InheritanceName As String = Nothing Public Property InheritanceName As String = Nothing
''' <summary>Initialize a new property option attribute</summary> ''' <summary>Initialize a new property option attribute</summary>

View File

@@ -19,6 +19,7 @@ Namespace Plugin
ReadOnly Property Site As String ReadOnly Property Site As String
Property CMDEncoding As String Property CMDEncoding As String
Property EnvironmentPrograms As IEnumerable(Of String) Property EnvironmentPrograms As IEnumerable(Of String)
Property UserAgentDefault As String
Sub EnvironmentProgramsUpdated() Sub EnvironmentProgramsUpdated()
Property AccountName As String Property AccountName As String
Property Temporary As Boolean Property Temporary As Boolean

View File

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

View File

@@ -361,6 +361,12 @@ Namespace API.YouTube.Base
Throw New NotImplementedException("'GetFormat' is not available in 'FpsFormatProvider'") Throw New NotImplementedException("'GetFormat' is not available in 'FpsFormatProvider'")
End Function End Function
End Class End Class
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, 30), Category("Defaults Video"), DisplayName("Highlight FPS (higher)"),
Description("Highlight frame rates higher than this value." & vbCr & "Default: 30" & vbCr & "-1 to disable")>
Public ReadOnly Property DefaultVideoHighlightFPS_H As XMLValue(Of Integer)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, -1), Category("Defaults Video"), DisplayName("Highlight FPS (lower)"),
Description("Highlight frame rates lower than this value." & vbCr & "Default: -1" & vbCr & "-1 to disable")>
Public ReadOnly Property DefaultVideoHighlightFPS_L As XMLValue(Of Integer)
#End Region #End Region
#Region "Defaults Audio" #Region "Defaults Audio"
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"), <Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"),

View File

@@ -58,6 +58,11 @@ Namespace API.YouTube.Controls
If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC" If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
If Not SelectedAudio.ID.IsEmptyString Then LBL_CODECS.Text &= $" / {SelectedAudio.Extension}{d}{SelectedAudio.Codec}{d}{SelectedAudio.Bitrate}k" If Not SelectedAudio.ID.IsEmptyString Then LBL_CODECS.Text &= $" / {SelectedAudio.Extension}{d}{SelectedAudio.Codec}{d}{SelectedAudio.Bitrate}k"
If Not SelectedAudio.ID.IsEmptyString AndAlso SelectedAudio.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC" If Not SelectedAudio.ID.IsEmptyString AndAlso SelectedAudio.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
If MyYouTubeSettings.DefaultVideoHighlightFPS_H > 0 AndAlso m.FPS > MyYouTubeSettings.DefaultVideoHighlightFPS_H Then _
BackColor = MyColor.DeleteBack : ForeColor = MyColor.DeleteFore
If MyYouTubeSettings.DefaultVideoHighlightFPS_L > 0 AndAlso m.FPS < MyYouTubeSettings.DefaultVideoHighlightFPS_L Then _
BackColor = MyColor.UpdateBack : ForeColor = MyColor.UpdateFore
End If End If
Dim sv% = m.Size / 1024 Dim sv% = m.Size / 1024

View File

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

View File

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

View File

@@ -11,6 +11,9 @@ Namespace API.Base
Friend Const Header_Authorization As String = "authorization" Friend Const Header_Authorization As String = "authorization"
Friend Const Header_CSRFToken As String = "x-csrf-token" Friend Const Header_CSRFToken As String = "x-csrf-token"
Friend Const CAT_UserDefs As String = "New user defaults"
Friend Const CAT_Timers As String = "Timers"
Friend Const ConcurrentDownloadsCaption As String = "Concurrent downloads" Friend Const ConcurrentDownloadsCaption As String = "Concurrent downloads"
Friend Const ConcurrentDownloadsToolTip As String = "The number of concurrent downloads." Friend Const ConcurrentDownloadsToolTip As String = "The number of concurrent downloads."
Friend Const SavedPostsUserNameCaption As String = "Saved posts user" Friend Const SavedPostsUserNameCaption As String = "Saved posts user"

View File

@@ -77,7 +77,7 @@ Namespace API.Base
''' </summary> ''' </summary>
Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
Function EraseData(ByVal Mode As EraseMode) As Boolean Function EraseData(ByVal Mode As EraseMode) As Boolean
Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile) As Boolean Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile, Optional ByVal NewUser As SplitCollectionUserInfo? = Nothing) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder() Sub OpenFolder()
Property DownloadTopCount As Integer? Property DownloadTopCount As Integer?

View File

@@ -34,6 +34,16 @@ Namespace API.Base
Friend Property AccountName As String Implements ISiteSettings.AccountName Friend Property AccountName As String Implements ISiteSettings.AccountName
Friend Property Temporary As Boolean = False Implements ISiteSettings.Temporary Friend Property Temporary As Boolean = False Implements ISiteSettings.Temporary
Friend Property DefaultInstance As ISiteSettings = Nothing Implements ISiteSettings.DefaultInstance Friend Property DefaultInstance As ISiteSettings = Nothing Implements ISiteSettings.DefaultInstance
Protected _UserAgentDefault As String = String.Empty
Friend Overridable Property UserAgentDefault As String Implements ISiteSettings.UserAgentDefault
Get
Return _UserAgentDefault
End Get
Set(ByVal _UserAgentDefault As String)
Me._UserAgentDefault = _UserAgentDefault
If _AllowUserAgentUpdate And Not Responser Is Nothing And Not _UserAgentDefault.IsEmptyString Then Responser.UserAgent = _UserAgentDefault
End Set
End Property
Protected _AllowUserAgentUpdate As Boolean = True Protected _AllowUserAgentUpdate As Boolean = True
Protected _SubscriptionsAllowed As Boolean = False Protected _SubscriptionsAllowed As Boolean = False
Friend ReadOnly Property SubscriptionsAllowed As Boolean Implements ISiteSettings.SubscriptionsAllowed Friend ReadOnly Property SubscriptionsAllowed As Boolean Implements ISiteSettings.SubscriptionsAllowed
@@ -138,7 +148,6 @@ Namespace API.Base
Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit
End Sub End Sub
Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit
If _AllowUserAgentUpdate And Not DefaultUserAgent.IsEmptyString And Not Responser Is Nothing Then Responser.UserAgent = DefaultUserAgent
If CheckNetscapeCookiesOnEndInit Then Update_SaveCookiesNetscape(, True) If CheckNetscapeCookiesOnEndInit Then Update_SaveCookiesNetscape(, True)
End Sub End Sub
#End Region #End Region

View File

@@ -0,0 +1,28 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Base
Friend Structure SplitCollectionUserInfo
Friend UserOrig As UserInfo
Friend UserNew As UserInfo
Friend Changed As Boolean
Friend ReadOnly Property SameDrive As Boolean
Get
Return GetUserDrive(UserOrig) = GetUserDrive(UserNew)
End Get
End Property
Private Shared Function GetUserDrive(ByVal User As UserInfo) As String
Dim u As UserInfo = User
If u.File.IsEmptyString Then u.UpdateUserFile()
Return u.File.Segments.FirstOrDefault.StringToLower
End Function
Public Overrides Function ToString() As String
Return $"[{UserOrig.File.CutPath.PathWithSeparator}] -> [{UserNew.File.CutPath.PathWithSeparator}]"
End Function
End Structure
End Namespace

View File

@@ -0,0 +1,111 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Base
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SplitCollectionUserInfoChangePathsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim LBL_INFO As System.Windows.Forms.Label
Me.LIST_USERS = New System.Windows.Forms.ListBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
LBL_INFO = New System.Windows.Forms.Label()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 261)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(384, 261)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(LBL_INFO, 0, 0)
TP_MAIN.Controls.Add(Me.LIST_USERS, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 2
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 50.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(384, 261)
TP_MAIN.TabIndex = 0
'
'LBL_INFO
'
LBL_INFO.Dock = System.Windows.Forms.DockStyle.Fill
LBL_INFO.Location = New System.Drawing.Point(3, 0)
LBL_INFO.Name = "LBL_INFO"
LBL_INFO.Size = New System.Drawing.Size(378, 50)
LBL_INFO.TabIndex = 0
LBL_INFO.Text = "Check the user destination paths and change them if necessary." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Double-click to c" &
"hange."
LBL_INFO.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
'
'LIST_USERS
'
Me.LIST_USERS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_USERS.FormattingEnabled = True
Me.LIST_USERS.Location = New System.Drawing.Point(3, 53)
Me.LIST_USERS.Name = "LIST_USERS"
Me.LIST_USERS.Size = New System.Drawing.Size(378, 205)
Me.LIST_USERS.TabIndex = 1
'
'SplitCollectionUserInfoChangePathsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(384, 261)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = Global.SCrawler.My.Resources.Resources.UsersIcon_32
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(400, 300)
Me.Name = "SplitCollectionUserInfoChangePathsForm"
Me.ShowInTaskbar = False
Me.Text = "Collection users"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_USERS As ListBox
End Class
End Namespace

View File

@@ -0,0 +1,129 @@
<?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>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="LBL_INFO.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

View File

@@ -0,0 +1,78 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.Messaging
Namespace API.Base
Friend Class SplitCollectionUserInfoChangePathsForm
Private WithEvents MyDefs As DefaultFormOptions
Friend ReadOnly Property Users As List(Of SplitCollectionUserInfo)
''' <summary>
''' Cancel = use initial<br/>
''' Abort = abort operation<br/>
''' OK = use changes
''' </summary>
Friend Sub New(ByVal _Users As IEnumerable(Of SplitCollectionUserInfo))
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
Users = New List(Of SplitCollectionUserInfo)(_Users)
End Sub
Private Sub SplitCollectionUserInfoChangePathsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
LIST_USERS.Items.AddRange(Users.Cast(Of Object).ToArray)
.EndLoaderOperations()
.MyOkCancel.EnableOK = True
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
MyDefs.CloseForm()
End Sub
Private Sub MyDefs_ButtonCancelClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonCancelClick
Dim m As New MMessage("You have canceled the change. Do you want to process user(s) as is or cancel the operation?", "Change user paths",
{New MsgBoxButton("Initial", "Process users as is (IGNORE changes to this form)") With {.CallBackObject = DialogResult.Cancel},
New MsgBoxButton("Process", "Process users as is (INCLUDE changes here)") With {.CallBackObject = DialogResult.OK},
New MsgBoxButton("Abort", "Abort operation") With {.CallBackObject = DialogResult.Abort},
New MsgBoxButton("Cancel", "Continue editing here") With {.CallBackObject = DialogResult.Retry}},
vbExclamation) With {.ButtonsPerRow = 4}
Dim result As DialogResult = CInt(MsgBoxE(m).Button.CallBackObject)
If result = DialogResult.Retry Then
e.Handled = True
Exit Sub
Else
MyDefs.CloseForm(result)
End If
End Sub
Private Sub SplitCollectionUserInfoChangePathsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
Users.Clear()
End Sub
Private Sub LIST_USERS_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_USERS.MouseDoubleClick
Try
With LIST_USERS
If .SelectedIndex >= 0 Then
Dim obj As SplitCollectionUserInfo = .Items(.SelectedIndex)
Using f As New SplitCollectionUserInfoPathForm(obj)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
obj = f.User
If obj.Changed Then
Users(.SelectedIndex) = obj
.Items(.SelectedIndex) = obj
.Refresh()
End If
End If
End Using
End If
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Change user paths")
End Try
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,134 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Base
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SplitCollectionUserInfoPathForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(SplitCollectionUserInfoPathForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.TXT_PATH_CURR = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_PATH_NEW = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_PATH_CURR, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_PATH_NEW, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(484, 84)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(484, 84)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(Me.TXT_PATH_CURR, 0, 0)
TP_MAIN.Controls.Add(Me.TXT_PATH_NEW, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(484, 84)
TP_MAIN.TabIndex = 0
'
'TXT_PATH_CURR
'
Me.TXT_PATH_CURR.CaptionText = "Current"
Me.TXT_PATH_CURR.CaptionWidth = 50.0R
Me.TXT_PATH_CURR.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_PATH_CURR.Location = New System.Drawing.Point(4, 4)
Me.TXT_PATH_CURR.Name = "TXT_PATH_CURR"
Me.TXT_PATH_CURR.Size = New System.Drawing.Size(476, 22)
Me.TXT_PATH_CURR.TabIndex = 0
Me.TXT_PATH_CURR.TextBoxReadOnly = True
'
'TXT_PATH_NEW
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Refresh"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Open"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
Me.TXT_PATH_NEW.Buttons.Add(ActionButton1)
Me.TXT_PATH_NEW.Buttons.Add(ActionButton2)
Me.TXT_PATH_NEW.CaptionText = "New"
Me.TXT_PATH_NEW.CaptionWidth = 50.0R
Me.TXT_PATH_NEW.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_PATH_NEW.Location = New System.Drawing.Point(4, 33)
Me.TXT_PATH_NEW.Name = "TXT_PATH_NEW"
Me.TXT_PATH_NEW.Size = New System.Drawing.Size(476, 22)
Me.TXT_PATH_NEW.TabIndex = 1
'
'SplitCollectionUserInfoPathForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(484, 84)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.Resources.UsersIcon_32
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(500, 123)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(500, 123)
Me.Name = "SplitCollectionUserInfoPathForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "User paths"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
CType(Me.TXT_PATH_CURR, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_PATH_NEW, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents TXT_PATH_CURR As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_PATH_NEW As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -0,0 +1,154 @@
<?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>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
</root>

View File

@@ -0,0 +1,68 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base
Imports SCrawler.DownloadObjects.STDownloader
Namespace API.Base
Friend Class SplitCollectionUserInfoPathForm
Private WithEvents MyDefs As DefaultFormOptions
Friend User As SplitCollectionUserInfo
Private ReadOnly UserNewPathDef As String
Friend Sub New(ByVal _User As SplitCollectionUserInfo)
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
User = _User
UserNewPathDef = User.UserNew.File.CutPath.PathWithSeparator
End Sub
Private Sub SplitCollectionUserInfoPathForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
TXT_PATH_CURR.Text = User.UserOrig.File.CutPath.PathWithSeparator
TXT_PATH_NEW.Text = UserNewPathDef
.MyFieldsCheckerE = New FieldsChecker
.MyFieldsCheckerE.AddControl(Of String)(TXT_PATH_NEW, "New path")
.MyFieldsCheckerE.EndLoaderOperations()
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then MyDefs.CloseForm()
End Sub
Private Sub TXT_PATH_NEW_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_PATH_NEW.ActionOnButtonClick
Select Case e.DefaultButton
Case ActionButton.DefaultButtons.Refresh : TXT_PATH_NEW.Text = UserNewPathDef
Case ActionButton.DefaultButtons.Open
Using ff As New Editors.GlobalLocationsChooserForm With {.MyInitialLocation = TXT_PATH_NEW.Text}
ff.ShowDialog()
If ff.DialogResult = DialogResult.OK Then
Dim dest As DownloadLocation = ff.MyDestination
If Not dest.Path.IsEmptyString Then
Dim ph As PathMoverHandler = Editors.GlobalLocationsChooserForm.ModelHandler(dest.Model)
If Not ph Is Nothing Then TXT_PATH_NEW.Text = ph.Invoke(User.UserNew, dest.Path.CSFileP).ToString
End If
End If
End Using
End Select
End Sub
Private Sub TXT_PATH_NEW_ActionOnTextChanged(sender As Object, e As EventArgs) Handles TXT_PATH_NEW.ActionOnTextChanged
If Not MyDefs.Initializing Then
Dim f As SFile = TXT_PATH_NEW.Text.CSFileP
If Not f.IsEmptyString Then
User.UserNew.SpecialPath = f
User.UserNew.UpdateUserFile()
User.Changed = Not User.UserNew.File.CutPath.PathWithSeparator = UserNewPathDef
End If
End If
End Sub
End Class
End Namespace

View File

@@ -950,7 +950,10 @@ BlockNullPicture:
LogError(ex, "user information loading error") LogError(ex, "user information loading error")
End Try End Try
End Sub End Sub
Friend Overridable Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
UpdateUserInformation(False)
End Sub
Friend Overridable Overloads Sub UpdateUserInformation(ByVal DisableUserInfoUpdate As Boolean)
Try Try
UpdateDataFiles() UpdateDataFiles()
MyFileSettings.Exists(SFO.Path) MyFileSettings.Exists(SFO.Path)
@@ -1001,7 +1004,7 @@ BlockNullPicture:
x.Save(MyFileSettings) x.Save(MyFileSettings)
End Using End Using
If Not IsSavedPosts Then Settings.UpdateUsersList(User, True) If Not IsSavedPosts And Not DisableUserInfoUpdate Then Settings.UpdateUsersList(User, True)
Catch ex As Exception Catch ex As Exception
LogError(ex, "user information saving error") LogError(ex, "user information saving error")
End Try End Try
@@ -1934,7 +1937,18 @@ BlockNullPicture:
Return 0 Return 0
End If End If
End Function End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean Implements IUserData.MoveFiles Friend Function SplitCollectionGetNewUserInfo() As SplitCollectionUserInfo
Dim u As New SplitCollectionUserInfo With {.UserOrig = User, .UserNew = User}
With u.UserNew
.CollectionName = String.Empty
.SpecialCollectionPath = Nothing
.UserModel = UsageModel.Default
.CollectionModel = UsageModel.Default
.UpdateUserFile()
End With
Return u
End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile, Optional ByVal NewUser As SplitCollectionUserInfo? = Nothing) As Boolean Implements IUserData.MoveFiles
Dim UserBefore As UserInfo = User Dim UserBefore As UserInfo = User
Dim Removed As Boolean = True Dim Removed As Boolean = True
Dim _TurnBack As Boolean = False Dim _TurnBack As Boolean = False
@@ -1950,6 +1964,7 @@ BlockNullPicture:
User.SpecialCollectionPath = String.Empty User.SpecialCollectionPath = String.Empty
User.UserModel = UsageModel.Default User.UserModel = UsageModel.Default
User.CollectionModel = UsageModel.Default User.CollectionModel = UsageModel.Default
If NewUser.HasValue Then User.SpecialPath = NewUser.Value.UserNew.SpecialPath
Else Else
Settings.Users.Remove(Me) Settings.Users.Remove(Me)
Removed = True Removed = True

View File

@@ -11,6 +11,7 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Facebook Namespace API.Facebook
<Manifest("AndyProgram_Facebook"), SavedPosts, SeparatedTasks(1), SpecialForm(False)> <Manifest("AndyProgram_Facebook"), SavedPosts, SeparatedTasks(1), SpecialForm(False)>
Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings
@@ -31,11 +32,11 @@ Namespace API.Facebook
End Property End Property
#End Region #End Region
#Region "Defaults" #Region "Defaults"
<PropertyOption(ControlText:="Download photos", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Download photos", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParsePhotoBlock As PropertyValue Friend ReadOnly Property ParsePhotoBlock As PropertyValue
<PropertyOption(ControlText:="Download videos", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Download videos", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParseVideoBlock As PropertyValue Friend ReadOnly Property ParseVideoBlock As PropertyValue
<PropertyOption(ControlText:="Download stories", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Download stories", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParseStoriesBlock As PropertyValue Friend ReadOnly Property ParseStoriesBlock As PropertyValue
#End Region #End Region
#End Region #End Region

View File

@@ -14,6 +14,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Instagram Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)> <Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -54,6 +55,9 @@ Namespace API.Instagram
End Function End Function
End Class End Class
#End Region #End Region
#Region "Categories"
Private Const CAT_DOWN As String = "Download data"
#End Region
#Region "Authorization properties" #Region "Authorization properties"
Friend Const Header_IG_APP_ID As String = "x-ig-app-id" Friend Const Header_IG_APP_ID As String = "x-ig-app-id"
Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim" Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
@@ -143,10 +147,19 @@ Namespace API.Instagram
Friend ReadOnly Property USE_GQL As PropertyValue Friend ReadOnly Property USE_GQL As PropertyValue
#End Region #End Region
#Region "Download properties" #Region "Download properties"
<PropertyOption(ControlText:="DownDetector",
ControlToolTip:="Use 'DownDetector' to determine if the site is accessible. -1 to disable." & vbCr &
"The value represents the average number of error reports over the last 4 hours"),
PClonable, PXML, ControlNumber(17)>
Private ReadOnly Property DownDetectorValue As PropertyValue
<Provider(NameOf(DownDetectorValue), FieldsChecker:=True)>
Private ReadOnly Property DownDetectorValueProvider As IFormatProvider
<PropertyOption(ControlText:="Add 'DownDetector' information to the log."), PClonable, PXML, ControlNumber(18), HiddenControl>
Private ReadOnly Property DownDetectorValueAddToLog As PropertyValue
Friend Const TimersUrgentTip As String = vbCr & "It is highly recommended not to change the default value." Friend Const TimersUrgentTip As String = vbCr & "It is highly recommended not to change the default value."
<PropertyOption(ControlText:="Request timer (any)", <PropertyOption(ControlText:="Request timer (any)",
ControlToolTip:="The timer (in milliseconds) that SCrawler should wait before executing the next request." & ControlToolTip:="The timer (in milliseconds) that SCrawler should wait before executing the next request." &
vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & TimersUrgentTip, AllowNull:=False), vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & TimersUrgentTip, AllowNull:=False, Category:=DN.CAT_Timers),
PXML, ControlNumber(19), PClonable> PXML, ControlNumber(19), PClonable>
Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue
<Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)>
@@ -154,33 +167,33 @@ Namespace API.Instagram
<PropertyOption(ControlText:="Request timer", <PropertyOption(ControlText:="Request timer",
ControlToolTip:="The time value (in milliseconds) that the program will wait before processing the next 'Request time counter' request." & ControlToolTip:="The time value (in milliseconds) that the program will wait before processing the next 'Request time counter' request." &
vbCr & "The default value is 1'000." & vbCr & "The minimum value is 100." & TimersUrgentTip, vbCr & "The default value is 1'000." & vbCr & "The minimum value is 100." & TimersUrgentTip,
AllowNull:=False), PXML, ControlNumber(20), PClonable> AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(20), PClonable>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter", <PropertyOption(ControlText:="Request timer counter",
ControlToolTip:="How many requests will be sent to Instagram before the program waits 'Request timer'." & ControlToolTip:="How many requests will be sent to Instagram before the program waits 'Request timer'." &
vbCr & "The default value is 1." & vbCr & "The minimum value is 1." & TimersUrgentTip, vbCr & "The default value is 1." & vbCr & "The minimum value is 1." & TimersUrgentTip,
AllowNull:=False, LeftOffset:=120), PXML, ControlNumber(21), PClonable> AllowNull:=False, LeftOffset:=120, Category:=DN.CAT_Timers), PXML, ControlNumber(21), PClonable>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer", <PropertyOption(ControlText:="Posts limit timer",
ControlToolTip:="The time value (in milliseconds) the program will wait before processing the next request after 195 requests." & ControlToolTip:="The time value (in milliseconds) the program will wait before processing the next request after 195 requests." &
vbCr & "The default value is 60'000." & vbCr & "The minimum value is 10'000." & TimersUrgentTip, vbCr & "The default value is 60'000." & vbCr & "The minimum value is 10'000." & TimersUrgentTip,
AllowNull:=False), PXML, ControlNumber(22), PClonable> AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(22), PClonable>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)> <Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users"), PXML, ControlNumber(23), PClonable> <PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(23), PClonable>
Friend ReadOnly Property GetTimeline As PropertyValue Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get reels", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24), PClonable> <PropertyOption(ControlText:="Get reels", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(24), PClonable>
Friend ReadOnly Property GetReels As PropertyValue Friend ReadOnly Property GetReels As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25), PClonable> <PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(25), PClonable>
Friend ReadOnly Property GetStories As PropertyValue Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), PXML, ControlNumber(26), PClonable> <PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(26), PClonable>
Friend ReadOnly Property GetStoriesUser As PropertyValue Friend ReadOnly Property GetStoriesUser As PropertyValue
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(27), PClonable> <PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(27), PClonable>
Friend ReadOnly Property GetTagged As PropertyValue Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit", <PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr & ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
@@ -190,19 +203,19 @@ Namespace API.Instagram
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region #End Region
#Region "Download ready" #Region "Download ready"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline"), PXML, ControlNumber(10), PClonable> <PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline", Category:=CAT_DOWN), PXML, ControlNumber(10), PClonable>
Friend ReadOnly Property DownloadTimeline As PropertyValue Friend ReadOnly Property DownloadTimeline As PropertyValue
<PXML> Private ReadOnly Property DownloadTimeline_Def As PropertyValue <PXML> Private ReadOnly Property DownloadTimeline_Def As PropertyValue
<PropertyOption(ControlText:="Download reels", ControlToolTip:="Download reels"), PXML, ControlNumber(11), PClonable> <PropertyOption(ControlText:="Download reels", ControlToolTip:="Download reels", Category:=CAT_DOWN), PXML, ControlNumber(11), PClonable>
Friend ReadOnly Property DownloadReels As PropertyValue Friend ReadOnly Property DownloadReels As PropertyValue
<PXML> Private ReadOnly Property DownloadReels_Def As PropertyValue <PXML> Private ReadOnly Property DownloadReels_Def As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(12), PClonable> <PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories", Category:=CAT_DOWN), PXML, ControlNumber(12), PClonable>
Friend ReadOnly Property DownloadStories As PropertyValue Friend ReadOnly Property DownloadStories As PropertyValue
<PXML> Private ReadOnly Property DownloadStories_Def As PropertyValue <PXML> Private ReadOnly Property DownloadStories_Def As PropertyValue
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(13), PClonable> <PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)", Category:=CAT_DOWN), PXML, ControlNumber(13), PClonable>
Friend ReadOnly Property DownloadStoriesUser As PropertyValue Friend ReadOnly Property DownloadStoriesUser As PropertyValue
<PXML> Private ReadOnly Property DownloadStoriesUser_Def As PropertyValue <PXML> Private ReadOnly Property DownloadStoriesUser_Def As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(14), PClonable> <PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts", Category:=CAT_DOWN), PXML, ControlNumber(14), PClonable>
Friend ReadOnly Property DownloadTagged As PropertyValue Friend ReadOnly Property DownloadTagged As PropertyValue
<PXML> Private ReadOnly Property DownloadTagged_Def As PropertyValue <PXML> Private ReadOnly Property DownloadTagged_Def As PropertyValue
#End Region #End Region
@@ -352,8 +365,11 @@ Namespace API.Instagram
platform = .Value(Header_Platform_Verion) platform = .Value(Header_Platform_Verion)
End If End If
'.Add(Header_IG_WWW_CLAIM, 0) '.Add(Header_IG_WWW_CLAIM, 0)
.Add("Origin", "https://www.instagram.com")
.Add("authority", "www.instagram.com")
.Add("Dnt", 1) .Add("Dnt", 1)
.Add("Dpr", 1) '.Add("Dpr", 1)
.Remove("Dpr")
.Add("Sec-Ch-Ua-Mobile", "?0") .Add("Sec-Ch-Ua-Mobile", "?0")
.Add("Sec-Ch-Ua-Model", """""") .Add("Sec-Ch-Ua-Model", """""")
.Add("Sec-Ch-Ua-Platform", """Windows""") .Add("Sec-Ch-Ua-Platform", """Windows""")
@@ -396,6 +412,9 @@ Namespace API.Instagram
DownloadTagged = New PropertyValue(False) DownloadTagged = New PropertyValue(False)
DownloadTagged_Def = New PropertyValue(DownloadTagged.Value, GetType(Boolean)) DownloadTagged_Def = New PropertyValue(DownloadTagged.Value, GetType(Boolean))
DownDetectorValue = New PropertyValue(20)
DownDetectorValueProvider = New TimersChecker(-1)
DownDetectorValueAddToLog = New PropertyValue(False)
RequestsWaitTimer_Any = New PropertyValue(1000) RequestsWaitTimer_Any = New PropertyValue(1000)
RequestsWaitTimer_AnyProvider = New TimersChecker(0) RequestsWaitTimer_AnyProvider = New TimersChecker(0)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
@@ -413,7 +432,7 @@ Namespace API.Instagram
TaggedNotifyLimit = New PropertyValue(200) TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New PropertyValue(Now.AddYears(10), GetType(Date)) DownloadingErrorDate = New PropertyValue(Now.AddYears(-10), GetType(Date))
LastDownloadDate = New PropertyValue(Now.AddDays(-1)) LastDownloadDate = New PropertyValue(Now.AddDays(-1))
LastRequestsCount = New PropertyValue(0) LastRequestsCount = New PropertyValue(0)
LastRequestsCountLabel = New PropertyValue(String.Empty, GetType(String)) LastRequestsCountLabel = New PropertyValue(String.Empty, GetType(String))
@@ -456,16 +475,85 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "Downloading" #Region "Downloading"
Private ____DownloadStarted As Boolean = False
Private ____AvailableRequested As Boolean = False
Private ____AvailableSilent As Boolean = True
Private ____AvailableChecked As Boolean = False
Private ____AvailableResult As Boolean = False
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If MyBase.Available(What, Silent) Then
If CInt(DownDetectorValue.Value) >= 0 Then
If ____DownloadStarted Then
____AvailableRequested = True
____AvailableSilent = Silent
Return True
Else
Return AvailableImpl(What, Silent)
End If
Else
Return True
End If
Else
Return False
End If
End Function
#Disable Warning IDE0060
Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean
#Enable Warning
Try
AvailableText = String.Empty
If CInt(DownDetectorValue.Value) = -1 Then
Return True
Else
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("instagram")
If dl.ListExists Then
dl = dl.Take(4).ToList
Dim avg% = dl.Average(Function(d) d.Value)
If avg > CInt(DownDetectorValue.Value) Then
AvailableText = "Over the past hour, Instagram has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr)
If CBool(DownDetectorValueAddToLog.Value) Then MyMainLOG = AvailableText
If Silent Then
Return False
Else
Return MsgBoxE({$"{AvailableText}{vbCr}{vbCr}Do you want to continue parsing Instagram data?",
"There are outage reports on Instagram"}, vbYesNo) = vbYes
End If
End If
End If
Return True
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Instagram.SiteSettings.Available]", True)
End Try
End Function
Friend Property SkipUntilNextSession As Boolean = False Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso DownloadTimeline.Value If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso CBool(DownloadTimeline.Value) Then
If ____DownloadStarted And ____AvailableRequested Then
____AvailableResult = AvailableImpl(What, ____AvailableSilent)
____AvailableChecked = True
____AvailableRequested = False
Return ____AvailableResult
ElseIf ____AvailableChecked Then
Return ____AvailableResult
Else
Return True
End If
Else
Return False
End If
End Function End Function
Private ActiveJobs As Integer = 0 Private ActiveJobs As Integer = 0
Private ActiveSessionDate As Date Private ActiveSessionDate As Date
Private ActiveSessionRequestsExists As Boolean = False
Private _NextWNM As UserData.WNM = UserData.WNM.Notify Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download) Friend Overrides Sub DownloadStarted(ByVal What As Download)
If ActiveJobs = 0 Then ActiveSessionRequestsExists = False
ActiveJobs += 1 ActiveJobs += 1
If What = Download.Main Then ____DownloadStarted = True
If ActiveJobs = 1 Then ActiveSessionDate = Now If ActiveJobs = 1 Then ActiveSessionDate = Now
If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso
( (
@@ -498,6 +586,7 @@ Namespace API.Instagram
If _NextWNM = UserData.WNM.SkipTemp Or _NextWNM = UserData.WNM.SkipCurrent Then _NextWNM = UserData.WNM.Notify If _NextWNM = UserData.WNM.SkipTemp Or _NextWNM = UserData.WNM.SkipCurrent Then _NextWNM = UserData.WNM.Notify
_NextTagged = .TaggedCheckSession _NextTagged = .TaggedCheckSession
MyLastRequestsCount = .RequestsCountSession MyLastRequestsCount = .RequestsCountSession
If .RequestsCountSession > 0 Then ActiveSessionRequestsExists = True
_FieldsChangerSuspended = True _FieldsChangerSuspended = True
HH_IG_WWW_CLAIM.Value = Responser.Headers.Value(Header_IG_WWW_CLAIM) HH_IG_WWW_CLAIM.Value = Responser.Headers.Value(Header_IG_WWW_CLAIM)
HH_CSRF_TOKEN.Value = Responser.Headers.Value(Header_CSRF_TOKEN) HH_CSRF_TOKEN.Value = Responser.Headers.Value(Header_CSRF_TOKEN)
@@ -507,9 +596,16 @@ Namespace API.Instagram
Friend Overrides Sub DownloadDone(ByVal What As Download) Friend Overrides Sub DownloadDone(ByVal What As Download)
_NextWNM = UserData.WNM.Notify _NextWNM = UserData.WNM.Notify
_NextTagged = True _NextTagged = True
RefreshMyLastRequests(Now) If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
ActiveJobs -= 1 ActiveJobs -= 1
SkipUntilNextSession = False SkipUntilNextSession = False
If What = Download.Main Then ____DownloadStarted = False
If ActiveJobs = 0 Then
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
End If
End Sub End Sub
#End Region #End Region
#Region "Settings" #Region "Settings"

View File

@@ -862,15 +862,20 @@ NextPageBlock:
Protected DefaultParser_IgnorePass As Boolean = False Protected DefaultParser_IgnorePass As Boolean = False
Private ReadOnly DefaultParser_PostUrlCreator_Default As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/" Private ReadOnly DefaultParser_PostUrlCreator_Default As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/" Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected DefaultParser_Pinned As Func(Of IEnumerable(Of EContainer), Integer, Boolean) = Nothing
Protected DefaultParser_SkipPost As Func(Of IEnumerable(Of EContainer), Integer, PostKV, Boolean) = Nothing
Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken, Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown, Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) As Boolean Optional ByVal Attempts As Integer = 0) As Boolean
ThrowAny(Token) ThrowAny(Token)
If Items.Count > 0 Then If Items.ListExists Then
Dim PostIDKV As PostKV Dim PostIDKV As PostKV
Dim Pinned As Boolean Dim Pinned As Boolean
Dim PostDate$, PostOriginUrl$ Dim PostDate$, PostOriginUrl$
Dim before% Dim i%, before%
Dim usePinFunc As Boolean = Not DefaultParser_Pinned Is Nothing
Dim skipPostFuncExists As Boolean = Not DefaultParser_SkipPost Is Nothing
Dim nn As EContainer
If SpecFolder.IsEmptyString Then If SpecFolder.IsEmptyString Then
Select Case Section Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder Case Sections.Tagged : SpecFolder = TaggedFolder
@@ -879,14 +884,21 @@ NextPageBlock:
End Select End Select
End If End If
ProgressPre.ChangeMax(Items.Count) ProgressPre.ChangeMax(Items.Count)
For Each nn In Items For i = 0 To Items.Count - 1
nn = Items(i)
ProgressPre.Perform() ProgressPre.Perform()
With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn) With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn)
If .ListExists Then If .ListExists Then
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section) PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV) PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV)
Pinned = .Contains("timeline_pinned_user_ids") 'Pinned = .Contains("timeline_pinned_user_ids")
If Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then If usePinFunc Then
Pinned = DefaultParser_Pinned.Invoke(Items, i)
Else
Pinned = If(.Item("timeline_pinned_user_ids")?.Count, 0) > 0
End If
If skipPostFuncExists AndAlso DefaultParser_SkipPost.Invoke(Items, i, PostIDKV) Then
ElseIf Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
If Not Section = Sections.Timeline OrElse Not Pinned Then Return False If Not Section = Sections.Timeline OrElse Not Pinned Then Return False
Else Else
_TempPostsList.Add(PostIDKV.ID) _TempPostsList.Add(PostIDKV.ID)

View File

@@ -14,6 +14,7 @@ Namespace API.Mastodon
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelProfile As Boolean <PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelProfile As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelSearch As Boolean <PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelSearch As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelForceApply As Boolean <PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelForceApply As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelLikes As Boolean
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s) MyBase.New(s)
End Sub End Sub

View File

@@ -63,15 +63,15 @@ Namespace API.Mastodon
End Sub End Sub
#End Region #End Region
#Region "Other properties" #Region "Other properties"
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption), PXML, PClonable> <PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsDownload As PropertyValue Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML, PClonable> <PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML, PClonable> <PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsPrefix As PropertyValue Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)> <Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider Private ReadOnly Property GifStringChecker As IFormatProvider
<PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML, PClonable> <PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property UseMD5Comparison As PropertyValue Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="User related to my domain", <PropertyOption(IsAuth:=False, ControlText:="User related to my domain",
ControlToolTip:="Open user profiles and user posts through my domain."), PXML, PClonable> ControlToolTip:="Open user profiles and user posts through my domain."), PXML, PClonable>

View File

@@ -13,18 +13,22 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.OnlyFans Namespace API.OnlyFans
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)> <Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Categories"
Private Const CAT_OFS As String = "OF-Scraper support"
#End Region
#Region "Options" #Region "Options"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download user timeline"), PXML, PClonable> <PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download user timeline", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadTimeline As PropertyValue Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download profile stories if they exists"), PXML, PClonable> <PropertyOption(ControlText:="Download stories", ControlToolTip:="Download profile stories if they exists", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadStories As PropertyValue Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists"), PXML, PClonable> <PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadHighlights As PropertyValue Friend ReadOnly Property DownloadHighlights As PropertyValue
<PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media"), PXML, PClonable> <PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadChatMedia As PropertyValue Friend ReadOnly Property DownloadChatMedia As PropertyValue
#End Region #End Region
#Region "Headers" #Region "Headers"
@@ -32,16 +36,16 @@ Namespace API.OnlyFans
Private Const HeaderUserID As String = "User-Id" Private Const HeaderUserID As String = "User-Id"
Friend Const HeaderXBC As String = "X-Bc" Friend Const HeaderXBC As String = "X-Bc"
Friend Const HeaderAppToken As String = "App-Token" Friend Const HeaderAppToken As String = "App-Token"
<PropertyOption(ControlText:=HeaderUserID, AllowNull:=False), PClonable(Clone:=False)> <PropertyOption(ControlText:=HeaderUserID, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Friend ReadOnly Property HH_USER_ID As PropertyValue Friend ReadOnly Property HH_USER_ID As PropertyValue
<PropertyOption(ControlText:=HeaderXBC, AllowNull:=False), PClonable(Clone:=False)> <PropertyOption(ControlText:=HeaderXBC, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Private ReadOnly Property HH_X_BC As PropertyValue Private ReadOnly Property HH_X_BC As PropertyValue
<PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False), PClonable(Clone:=False)> <PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Private ReadOnly Property HH_APP_TOKEN As PropertyValue Private ReadOnly Property HH_APP_TOKEN As PropertyValue
<PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True, <PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), PClonable, PXML(OnlyForChecked:=True)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua, IsAuth:=True), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(AllowNull:=False, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), PClonable, PXML(OnlyForChecked:=True)> <PropertyOption(AllowNull:=False, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent, IsAuth:=True), PClonable, PXML(OnlyForChecked:=True)>
Friend ReadOnly Property UserAgent As PropertyValue Friend ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String) Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String)
Dim hName$ = String.Empty Dim hName$ = String.Empty
@@ -82,20 +86,21 @@ Namespace API.OnlyFans
End Property End Property
<PropertyOption(ControlText:="Use old authorization rules", <PropertyOption(ControlText:="Use old authorization rules",
ControlToolTip:="Use old dynamic rules (from 'DATAHOARDERS') or new ones (from 'DIGITALCRIMINALS')." & vbCr & ControlToolTip:="Use old dynamic rules (from 'DATAHOARDERS') or new ones (from 'DIGITALCRIMINALS')." & vbCr &
"Change this value only if you know what you are doing."), PXML, PClonable> "Change this value only if you know what you are doing.", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property UseOldAuthRules As PropertyValue Friend ReadOnly Property UseOldAuthRules As PropertyValue
<PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440", LeftOffset:=110), PXML, PClonable> <PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440",
LeftOffset:=110, IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue
<Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)> <Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider
<PropertyOption(ControlText:="Dynamic rules", <PropertyOption(ControlText:="Dynamic rules",
ControlToolTip:="Overwrite 'Dynamic rules' with this URL" & vbCr & ControlToolTip:="Overwrite 'Dynamic rules' with this URL" & vbCr &
"Change this value only if you know what you are doing."), PXML, PClonable> "Change this value only if you know what you are doing.", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property DynamicRules As PropertyValue Friend ReadOnly Property DynamicRules As PropertyValue
#End Region #End Region
#Region "OFScraper" #Region "OFScraper"
<PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue <PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'")> <PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'", Category:=CAT_OFS)>
Friend ReadOnly Property OFScraperPath As PropertyValue Friend ReadOnly Property OFScraperPath As PropertyValue
Get Get
If Not DefaultInstance Is Nothing Then If Not DefaultInstance Is Nothing Then
@@ -106,7 +111,7 @@ Namespace API.OnlyFans
End Get End Get
End Property End Property
<PClonable, PXML("OFScraperMP4decrypt")> Private ReadOnly Property OFScraperMP4decrypt_XML As PropertyValue <PClonable, PXML("OFScraperMP4decrypt")> Private ReadOnly Property OFScraperMP4decrypt_XML As PropertyValue
<PropertyOption(ControlText:="mp4decrypt path", ControlToolTip:="The path to the 'mp4decrypt.exe'")> <PropertyOption(ControlText:="mp4decrypt path", ControlToolTip:="The path to the 'mp4decrypt.exe'", Category:=CAT_OFS)>
Friend ReadOnly Property OFScraperMP4decrypt As PropertyValue Friend ReadOnly Property OFScraperMP4decrypt As PropertyValue
Get Get
If Not DefaultInstance Is Nothing Then If Not DefaultInstance Is Nothing Then
@@ -118,7 +123,7 @@ Namespace API.OnlyFans
End Property End Property
Friend Const KeyModeDefault_Default As String = "cdrm" Friend Const KeyModeDefault_Default As String = "cdrm"
<PClonable, PXML("KeyModeDefault")> Private ReadOnly Property KeyModeDefault_XML As PropertyValue <PClonable, PXML("KeyModeDefault")> Private ReadOnly Property KeyModeDefault_XML As PropertyValue
<PropertyOption(ControlText:="key-mode-default")> <PropertyOption(ControlText:="key-mode-default", Category:=CAT_OFS)>
Friend ReadOnly Property KeyModeDefault As PropertyValue Friend ReadOnly Property KeyModeDefault As PropertyValue
Get Get
If Not DefaultInstance Is Nothing Then If Not DefaultInstance Is Nothing Then
@@ -134,6 +139,8 @@ Namespace API.OnlyFans
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean) Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("OnlyFans", ".onlyfans.com", AccName, Temp, My.Resources.SiteResources.OnlyFansIcon_32, My.Resources.SiteResources.OnlyFansPic_32) MyBase.New("OnlyFans", ".onlyfans.com", AccName, Temp, My.Resources.SiteResources.OnlyFansIcon_32, My.Resources.SiteResources.OnlyFansPic_32)
_AllowUserAgentUpdate = False
With Responser With Responser
.Accept = "application/json, text/plain, */*" .Accept = "application/json, text/plain, */*"
.AutomaticDecompression = Net.DecompressionMethods.GZip .AutomaticDecompression = Net.DecompressionMethods.GZip

View File

@@ -8,6 +8,7 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.M3U8_Declarations Imports SCrawler.API.Reddit.M3U8_Declarations
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web Imports PersonalUtilities.Tools.Web
@@ -61,15 +62,18 @@ Namespace API.Reddit
Private ReadOnly ProgressExists As Boolean Private ReadOnly ProgressExists As Boolean
Private ReadOnly Property ProgressPre As PreProgress Private ReadOnly Property ProgressPre As PreProgress
Private ReadOnly UsePreProgress As Boolean Private ReadOnly UsePreProgress As Boolean
Private ReadOnly Media As UserMedia
#End Region #End Region
Private Sub New(ByVal URL As String, ByVal OutFile As SFile, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) Private Sub New(ByVal URL As String, ByVal Media As UserMedia, ByVal OutFile As SFile, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean)
PlayListURL = URL PlayListURL = URL
Me.Media = Media
BaseURL = RegexReplace(URL, BaseUrlPattern) BaseURL = RegexReplace(URL, BaseUrlPattern)
Video = New List(Of String) Video = New List(Of String)
Audio = New List(Of String) Audio = New List(Of String)
Me.OutFile = OutFile Me.OutFile = OutFile
Me.OutFile.Name = "PlayListFile" Me.OutFile.Name = "PlayListFile"
Me.OutFile.Extension = "mp4" Me.OutFile.Extension = "mp4"
If Media.Post.Date.HasValue Then Me.OutFile.Name = Media.Post.Date.Value.ToString("yyyyMMdd_HHmmss")
Me.Progress = Progress Me.Progress = Progress
ProgressExists = Not Me.Progress Is Nothing ProgressExists = Not Me.Progress Is Nothing
ProgressPre = New PreProgress(Progress) ProgressPre = New PreProgress(Progress)
@@ -202,9 +206,9 @@ Namespace API.Reddit
End Function End Function
#End Region #End Region
#Region "Statics" #Region "Statics"
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile, ByVal Token As CancellationToken, Friend Shared Function Download(ByVal URL As String, ByVal Media As UserMedia, ByVal f As SFile, ByVal Token As CancellationToken,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Using m As New M3U8(URL, f, Progress, UsePreProgress) : Return m.Download(Token) : End Using Using m As New M3U8(URL, Media, f, Progress, UsePreProgress) : Return m.Download(Token) : End Using
End Function End Function
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"

View File

@@ -58,7 +58,6 @@ Namespace API.Reddit
Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString) Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
End Get End Get
End Property End Property
#End Region #End Region
#Region "Other" #Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable>

View File

@@ -225,6 +225,7 @@ Namespace API.Reddit
#End Region #End Region
#Region "Download Overrides" #Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken) Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
Err429Count = 0
_CrossPosts.Clear() _CrossPosts.Clear()
If CreatedByChannel And Settings.FromChannelDownloadTopUse And Settings.FromChannelDownloadTop > 0 Then _ If CreatedByChannel And Settings.FromChannelDownloadTopUse And Settings.FromChannelDownloadTop > 0 Then _
DownloadTopCount = Settings.FromChannelDownloadTop.Value DownloadTopCount = Settings.FromChannelDownloadTop.Value
@@ -287,6 +288,7 @@ Namespace API.Reddit
End Sub End Sub
#End Region #End Region
#Region "Download Functions (User, Channel)" #Region "Download Functions (User, Channel)"
Private Err429Count As Integer = 0
Private _TotalPostsDownloaded As Integer = 0 Private _TotalPostsDownloaded As Integer = 0
Private ReadOnly _CrossPosts As List(Of String) Private ReadOnly _CrossPosts As List(Of String)
Private Const SiteGfycatKey As String = "gfycat" Private Const SiteGfycatKey As String = "gfycat"
@@ -375,6 +377,7 @@ Namespace API.Reddit
Loop While Not _completed Loop While Not _completed
End Sub End Sub
Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken) Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken)
Const savedPostsSleepTimer% = 2000
Dim eObj% = 0 Dim eObj% = 0
Dim round% = 0 Dim round% = 0
Dim URL$ = String.Empty Dim URL$ = String.Empty
@@ -392,12 +395,14 @@ Namespace API.Reddit
If IsSavedPosts Then If IsSavedPosts Then
URL = $"https://www.reddit.com/user/{TrueName}/saved.json?after={POST}" URL = $"https://www.reddit.com/user/{TrueName}/saved.json?after={POST}"
If Not POST.IsEmptyString Then Thread.Sleep(savedPostsSleepTimer)
Else Else
URL = $"https://reddit.com/r/{TrueName}/{View}.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic" URL = $"https://reddit.com/r/{TrueName}/{View}.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
End If End If
ThrowAny(Token) ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
If IsSavedPosts Then Err429Count = 0
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then If w.Count > 0 Then
@@ -458,8 +463,12 @@ Namespace API.Reddit
End If End If
_completed = True _completed = True
Catch ex As Exception Catch ex As Exception
If ProcessException(ex, Token, $"channel data downloading error [{URL}]",, eObj) = HttpStatusCode.InternalServerError Then Dim errValue% = ProcessException(ex, Token, $"{IIf(IsSavedPosts, "saved posts", "channel")} data downloading error [{URL}]",, eObj)
If errValue = HttpStatusCode.InternalServerError Then
If round = 2 Then eObj = HttpStatusCode.InternalServerError If round = 2 Then eObj = HttpStatusCode.InternalServerError
ElseIf errValue = 429 And round = 0 Then
Thread.Sleep(savedPostsSleepTimer)
round += 1
Else Else
_completed = True _completed = True
End If End If
@@ -975,7 +984,7 @@ Namespace API.Reddit
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}} Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}}
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CreateFileFromUrl(m.URL) Else m.File = Nothing If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CreateFileFromUrl(m.URL) Else m.File = Nothing
If ReplacePreview And m.URL.Contains("preview") And Not t = UTypes.Picture Then m.URL = $"https://i.redd.it/{m.File.File}" If ReplacePreview And m.URL.Contains("preview") And Not t = UTypes.Picture Then m.URL = $"https://i.redd.it/{m.File.File}"
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel), Nothing) Else m.Post.Date = Nothing If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel Or IsSavedPosts), Nothing) Else m.Post.Date = Nothing
Return m Return m
End Function End Function
Private Function TryFile(ByVal URL As String) As Boolean Private Function TryFile(ByVal URL As String) As Boolean
@@ -1027,7 +1036,7 @@ Namespace API.Reddit
Return URL.Contains(SiteRedGifsKey) Return URL.Contains(SiteRedGifsKey)
End Function End Function
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload) Return M3U8.Download(URL, Media, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
If Not IsChannel Or Not SaveToCache Then If Not IsChannel Or Not SaveToCache Then
@@ -1057,8 +1066,11 @@ Namespace API.Reddit
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500 ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1 If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError Return HttpStatusCode.InternalServerError
ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then
Err429Count += 1
Return 429
ElseIf .StatusCode = 429 AndAlso ElseIf .StatusCode = 429 AndAlso
((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And MySiteSettings.UseTokenForSavedPosts.Value)) AndAlso ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
Not MySiteSettings.CredentialsExists Then '429 Not MySiteSettings.CredentialsExists Then '429
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " & MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " &
IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines") IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines")

View File

@@ -18,9 +18,9 @@ Namespace API.RedGifs
<Manifest(RedGifsSiteKey)> <Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), DependentFields(NameOf(UserAgent)), ControlNumber(1), PClonable(Clone:=False)> <PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), DependentFields(NameOf(UserAgent)), ControlNumber(1), PClonable(Clone:=False), HiddenControl>
Friend ReadOnly Property Token As PropertyValue Friend ReadOnly Property Token As PropertyValue
<PropertyOption, ControlNumber(2), PClonable> <PropertyOption, ControlNumber(2), PClonable, HiddenControl>
Private ReadOnly Property UserAgent As PropertyValue Private ReadOnly Property UserAgent As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue <PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization" Private Const TokenName As String = "authorization"
@@ -107,7 +107,9 @@ Namespace API.RedGifs
Friend Overrides Sub Update() Friend Overrides Sub Update()
If _SiteEditorFormOpened Then If _SiteEditorFormOpened Then
Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty) Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now If Not _LastTokenValue = NewToken And Not NewToken.IsEmptyString Then TokenLastDateUpdated.Value = Now
If Responser.CookiesExists AndAlso MsgBoxE({"RedGifs doesn't require cookies! Do you still want to use cookies?", "RedGifs cookies"},
vbExclamation,,, {"Use", "Don't use"}) = 1 Then Responser.Cookies.Clear()
End If End If
MyBase.Update() MyBase.Update()
End Sub End Sub

View File

@@ -13,6 +13,7 @@ Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports IG = SCrawler.API.Instagram.SiteSettings Imports IG = SCrawler.API.Instagram.SiteSettings
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.ThreadsNet Namespace API.ThreadsNet
<Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)> <Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -75,14 +76,14 @@ Namespace API.ThreadsNet
#Region "Other properties" #Region "Other properties"
<PropertyOption(ControlText:="Request timer (any)", <PropertyOption(ControlText:="Request timer (any)",
ControlToolTip:="The timer (in milliseconds) that SCrawler should wait before executing the next request." & ControlToolTip:="The timer (in milliseconds) that SCrawler should wait before executing the next request." &
vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & IG.TimersUrgentTip, AllowNull:=False), vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & IG.TimersUrgentTip, AllowNull:=False, Category:=DN.CAT_Timers),
PXML, PClonable> PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue
<Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider
<PropertyOption(ControlText:="Download data", <PropertyOption(ControlText:="Download data",
ControlToolTip:="The internal value indicates that site data should be downloaded." & vbCr & ControlToolTip:="The internal value indicates that site data should be downloaded." & vbCr &
"It becomes unchecked when the site returns an error."), PXML> "It becomes unchecked when the site returns an error.", Category:="Download"), PXML>
Friend ReadOnly Property DownloadData_Impl As PropertyValue Friend ReadOnly Property DownloadData_Impl As PropertyValue
#End Region #End Region
#End Region #End Region

View File

@@ -17,6 +17,10 @@ Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports IGS = SCrawler.API.Instagram.SiteSettings Imports IGS = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet Namespace API.ThreadsNet
Friend Class UserData : Inherits Instagram.UserData Friend Class UserData : Inherits Instagram.UserData
#Region "XML names"
Private Const Name_MaxLastDownDate As String = "MaxLastDownDate"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
#End Region
#Region "Declarations" #Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
@@ -29,9 +33,20 @@ Namespace API.ThreadsNet
Return ValidateBaseTokens() And Not ID.IsEmptyString Return ValidateBaseTokens() And Not ID.IsEmptyString
End Get End Get
End Property End Property
Private Property MaxLastDownDate As Date? = Nothing
Private Property FirstLoadingDone As Boolean = False
#End Region #End Region
#Region "Loader" #Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
MaxLastDownDate = AConvert(Of Date)(.Value(Name_MaxLastDownDate), DateTimeDefaultProvider, Nothing)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
Else
.Add(Name_MaxLastDownDate, AConvert(Of String)(MaxLastDownDate, DateTimeDefaultProvider, String.Empty))
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
End If
End With
End Sub End Sub
#End Region #End Region
#Region "Exchange" #Region "Exchange"
@@ -49,6 +64,7 @@ Namespace API.ThreadsNet
DefaultParser_PostUrlCreator = Function(post) $"https://www.threads.net/@{NameTrue}/post/{post.Code}" DefaultParser_PostUrlCreator = Function(post) $"https://www.threads.net/@{NameTrue}/post/{post.Code}"
_ResponserAutoUpdateCookies = True _ResponserAutoUpdateCookies = True
_ResponserAddResponseReceivedHandler = True _ResponserAddResponseReceivedHandler = True
DefaultParser_Pinned = AddressOf IsPinnedPost
End Sub End Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
@@ -66,7 +82,27 @@ Namespace API.ThreadsNet
Responser.Method = "POST" Responser.Method = "POST"
LoadSavePostsKV(True) LoadSavePostsKV(True)
ResetBaseTokens() ResetBaseTokens()
Dim setMaxPostDate As Action(Of List(Of UserMedia)) =
Sub(ByVal l As List(Of UserMedia))
With (From c As UserMedia In l Where c.Post.Date.HasValue Select c.Post.Date.Value)
If .ListExists Then MaxLastDownDate = .Max : _ForceSaveUserInfo = True
End With
End Sub
If FirstLoadingDone Then
If Not MaxLastDownDate.HasValue And _ContentList.Count > 0 Then setMaxPostDate.Invoke(_ContentList)
Else
If _ContentList.Count > 0 Then
FirstLoadingDone = True
If Not MaxLastDownDate.HasValue Then setMaxPostDate.Invoke(_ContentList)
End If
End If
If FirstLoadingDone Then
DefaultParser_SkipPost = Nothing
Else
DefaultParser_SkipPost = AddressOf SkipPost
End If
DownloadData(String.Empty, Token) DownloadData(String.Empty, Token)
If _TempMediaList.Count > 0 Then FirstLoadingDone = True : setMaxPostDate.Invoke(_TempMediaList)
Catch ex As Exception Catch ex As Exception
errorFound = True errorFound = True
Throw ex Throw ex
@@ -78,6 +114,21 @@ Namespace API.ThreadsNet
End Try End Try
End If End If
End Sub End Sub
Private Function IsPinnedPost(ByVal Items As IEnumerable(Of EContainer), ByVal Index As Integer) As Boolean
Try
If MaxLastDownDate.HasValue Then
Dim d As Date? = AConvert(Of Date)(Items(Index).ItemF(DefaultParser_ElemNode_Default).Value("taken_at"), UnixDate32Provider, Nothing)
If d.HasValue Then Return d.Value < MaxLastDownDate.Value
End If
Return Not FirstLoadingDone
Catch ex As Exception
LogError(ex, "IsPinnedPost")
Return Not FirstLoadingDone
End Try
End Function
Private Function SkipPost(ByVal Items As IEnumerable(Of EContainer), ByVal Index As Integer, ByVal Post As PostKV) As Boolean
Return PostKvExists(Post)
End Function
Protected Overrides Sub UpdateResponser() Protected Overrides Sub UpdateResponser()
If Not Responser Is Nothing AndAlso Not Responser.Disposed Then If Not Responser Is Nothing AndAlso Not Responser.Disposed Then
RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
@@ -166,7 +217,6 @@ Namespace API.ThreadsNet
With .Headers With .Headers
.Clear() .Clear()
.Add("dnt", 1) .Add("dnt", 1)
.Add("drp", 1)
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.threads.net")) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.threads.net"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.threads.net")) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.threads.net"))
.Add("Sec-Ch-Ua-Model", "") .Add("Sec-Ch-Ua-Model", "")

View File

@@ -15,6 +15,7 @@ Namespace API.Twitter
Friend Const TwitterSiteKey As String = "AndyProgram_Twitter" Friend Const TwitterSiteKey As String = "AndyProgram_Twitter"
Friend ReadOnly DateProvider As ADateTime = GetDateProvider() Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue) Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly StatusRegEx As RParams = RParams.DM(".*?(twitter|x)\.com/\S+/status/\d+", 0, EDP.ReturnValue)
Private Function GetDateProvider() As ADateTime Private Function GetDateProvider() As ADateTime
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy" n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"

View File

@@ -28,16 +28,20 @@ Namespace API.Twitter
Friend Overridable Property MediaModelAllowNonUserTweets As Boolean = False Friend Overridable Property MediaModelAllowNonUserTweets As Boolean = False
<PSetting(Address:=SettingAddress.User, <PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Media'", Caption:="Download model 'Media'",
ToolTip:="Download the data using the 'https://twitter.com/UserName/media' command.", LeftOffset:=DefaultOffset)> ToolTip:="Download the data using the 'https://x.com/UserName/media' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelMedia As Boolean = False Friend Overridable Property DownloadModelMedia As Boolean = False
<PSetting(Address:=SettingAddress.User, <PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Profile'", Caption:="Download model 'Profile'",
ToolTip:="Download the data using the 'https://twitter.com/UserName' command.", LeftOffset:=DefaultOffset)> ToolTip:="Download the data using the 'https://x.com/UserName' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelProfile As Boolean = False Friend Overridable Property DownloadModelProfile As Boolean = False
<PSetting(Address:=SettingAddress.User, <PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Search'", Caption:="Download model 'Search'",
ToolTip:="Download the data using the 'https://twitter.com/search?q=from:UserName+include:nativeretweets' command.", LeftOffset:=DefaultOffset)> ToolTip:="Download the data using the 'https://x.com/search?q=from:UserName+include:nativeretweets' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelSearch As Boolean = False Friend Overridable Property DownloadModelSearch As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Likes'",
ToolTip:="Download the data using the 'https://x.com/UserName/likes' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelLikes As Boolean = False
<PSetting(Address:=SettingAddress.User, <PSetting(Address:=SettingAddress.User,
Caption:="Force apply", Caption:="Force apply",
ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)> ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)>
@@ -73,6 +77,7 @@ Namespace API.Twitter
DownloadModelMedia = dm.Contains(DModels.Media) DownloadModelMedia = dm.Contains(DModels.Media)
DownloadModelProfile = dm.Contains(DModels.Profile) DownloadModelProfile = dm.Contains(DModels.Profile)
DownloadModelSearch = dm.Contains(DModels.Search) DownloadModelSearch = dm.Contains(DModels.Search)
DownloadModelLikes = dm.Contains(DModels.Likes)
End If End If
End If End If
MySettings = u.HOST.Source MySettings = u.HOST.Source

View File

@@ -16,32 +16,37 @@ Namespace API.Twitter
<Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)> <Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Categories"
Private Const CAT_DOWN As String = "Downloading"
#End Region
#Region "Other properties" #Region "Other properties"
<PropertyOption(ControlText:="Use the appropriate model", <PropertyOption(ControlText:="Use the appropriate model",
ControlToolTip:="Use the appropriate model for new users." & vbCr & ControlToolTip:="Use the appropriate model for new users." & vbCr &
"If disabled, all download models will be used for the first download. " & "If disabled, all download models will be used for the first download. " &
"Next, the appropriate download model will be automatically selected." & vbCr & "Next, the appropriate download model will be automatically selected." & vbCr &
"Otherwise the appropriate download model will be selected right from the start."), PXML, PClonable> "Otherwise the appropriate download model will be selected right from the start.", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property UseAppropriateModel As PropertyValue Friend ReadOnly Property UseAppropriateModel As PropertyValue
#Region "End points" #Region "End points"
<PropertyOption(ControlText:="New endpoint: search", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the search model."), PXML, PClonable> <PropertyOption(ControlText:="New endpoint: search", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the search model.",
Category:=CAT_DOWN), PXML, PClonable>
Friend Property UseNewEndPointSearch As PropertyValue Friend Property UseNewEndPointSearch As PropertyValue
<PropertyOption(ControlText:="New endpoint: profiles", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the profile models."), PXML, PClonable> <PropertyOption(ControlText:="New endpoint: profiles", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the profile models.",
Category:=CAT_DOWN), PXML, PClonable>
Friend Property UseNewEndPointProfiles As PropertyValue Friend Property UseNewEndPointProfiles As PropertyValue
#End Region #End Region
#Region "Limits" #Region "Limits"
<PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached"), PXML, PClonable> <PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached", Category:=CAT_DOWN), PXML, PClonable>
Friend Property AbortOnLimit As PropertyValue Friend Property AbortOnLimit As PropertyValue
<PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort"), PXML, PClonable> <PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort", Category:=CAT_DOWN), PXML, PClonable>
Friend Property DownloadAlreadyParsed As PropertyValue Friend Property DownloadAlreadyParsed As PropertyValue
#End Region #End Region
<PropertyOption(ControlText:="Media Model: allow non-user tweets", ControlToolTip:="Allow downloading non-user tweets in the media-model."), PXML, PClonable> <PropertyOption(ControlText:="Media Model: allow non-user tweets", ControlToolTip:="Allow downloading non-user tweets in the media-model.", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property MediaModelAllowNonUserTweets As PropertyValue Friend ReadOnly Property MediaModelAllowNonUserTweets As PropertyValue
<PropertyOption(ControlText:=DN.GifsDownloadCaption), PXML, PClonable> <PropertyOption(ControlText:=DN.GifsDownloadCaption, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsDownload As PropertyValue Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML, PClonable> <PropertyOption(ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML, PClonable> <PropertyOption(ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsPrefix As PropertyValue Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)> <Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider Private ReadOnly Property GifStringChecker As IFormatProvider
@@ -63,17 +68,17 @@ Namespace API.Twitter
Throw New NotImplementedException("[GetFormat] is not available in the context of [GifStringProvider]") Throw New NotImplementedException("[GetFormat] is not available in the context of [GifStringProvider]")
End Function End Function
End Class End Class
<PropertyOption(ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML, PClonable> <PropertyOption(ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property UseMD5Comparison As PropertyValue Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption, <PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption,
ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120), PXML, TaskCounter, PClonable> ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120, Category:=CAT_DOWN), PXML, TaskCounter, PClonable>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue Friend ReadOnly Property ConcurrentDownloads As PropertyValue
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)> <Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider
#End Region #End Region
#End Region #End Region
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean) Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(TwitterSite, "twitter.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap) MyBase.New(TwitterSite, "x.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap)
LimitSkippedUsers = New List(Of UserDataBase) LimitSkippedUsers = New List(Of UserDataBase)
@@ -97,7 +102,7 @@ Namespace API.Twitter
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "/(twitter|x).com/"), 2) UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "/(twitter|x).com/"), 2)
UrlPatternUser = "https://twitter.com/{0}" UrlPatternUser = "https://x.com/{0}"
ImageVideoContains = "twitter" ImageVideoContains = "twitter"
CheckNetscapeCookiesOnEndInit = True CheckNetscapeCookiesOnEndInit = True
UseNetscapeCookies = True UseNetscapeCookies = True
@@ -106,7 +111,7 @@ Namespace API.Twitter
Return New UserData Return New UserData
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://twitter.com/{User.Name}/status/{Media.Post.ID}" Return $"https://x.com/{User.Name}/status/{Media.Post.ID}"
End Function End Function
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists Return Responser.CookiesExists

View File

@@ -33,6 +33,7 @@ Namespace API.Twitter
Media = 1 Media = 1
Profile = 2 Profile = 2
Search = 5 Search = 5
Likes = 10
End Enum End Enum
Private FirstDownloadComplete As Boolean = False Private FirstDownloadComplete As Boolean = False
Friend Property DownloadModelForceApply As Boolean = False Friend Property DownloadModelForceApply As Boolean = False
@@ -41,6 +42,7 @@ Namespace API.Twitter
Friend Property GifsDownload As Boolean = True Friend Property GifsDownload As Boolean = True
Friend Property GifsSpecialFolder As String = String.Empty Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty Friend Property GifsPrefix As String = String.Empty
Private ReadOnly LikesPosts As List(Of String)
Private ReadOnly _DataNames As List(Of String) Private ReadOnly _DataNames As List(Of String)
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
@@ -74,6 +76,7 @@ Namespace API.Twitter
If .DownloadModelMedia Then DownloadModel += DownloadModels.Media If .DownloadModelMedia Then DownloadModel += DownloadModels.Media
If .DownloadModelProfile Then DownloadModel += DownloadModels.Profile If .DownloadModelProfile Then DownloadModel += DownloadModels.Profile
If .DownloadModelSearch Then DownloadModel += DownloadModels.Search If .DownloadModelSearch Then DownloadModel += DownloadModels.Search
If .DownloadModelLikes Then DownloadModel += DownloadModels.Likes
End With End With
End If End If
End Sub End Sub
@@ -81,6 +84,7 @@ Namespace API.Twitter
#Region "Initializer, loader" #Region "Initializer, loader"
Friend Sub New() Friend Sub New()
_DataNames = New List(Of String) _DataNames = New List(Of String)
LikesPosts = New List(Of String)
End Sub End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container With Container
@@ -142,21 +146,32 @@ Namespace API.Twitter
} }
End Function End Function
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If MySettings.LIMIT_ABORT Then Try
Throw New TwitterLimitException(Me) If MySettings.LIMIT_ABORT Then
Else Throw New TwitterLimitException(Me)
If IsSavedPosts Then
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_SavedPosts(Token)
Else Else
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly) If IsSavedPosts Then
DownloadData_Timeline(Token) If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_SavedPosts(Token)
Else
LikesPosts.Clear()
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_Timeline(Token)
If LikesPosts.Count > 0 Then
_ReparseLikes = True
ReparseMissing(Token)
_ReparseLikes = False
End If
End If
End If End If
End If Finally
_ReparseLikes = False
End Try
End Sub End Sub
Private Sub DownloadData_Timeline(ByVal Token As CancellationToken) Private Sub DownloadData_Timeline(ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim tCache As CacheKeeper = Nothing Dim tCache As CacheKeeper = Nothing
Dim likesDetected As Boolean = False
Try Try
Const entry$ = "entry" Const entry$ = "entry"
Dim PostID$ = String.Empty Dim PostID$ = String.Empty
@@ -199,6 +214,7 @@ Namespace API.Twitter
If Not _TempPostsList.Contains(PostID) Then If Not _TempPostsList.Contains(PostID) Then
_TempPostsList.Add(PostID) _TempPostsList.Add(PostID)
ElseIf dirIndx = 3 Then
ElseIf isPins Then ElseIf isPins Then
Return False Return False
Else Else
@@ -211,9 +227,22 @@ Namespace API.Twitter
If tmpUserId.IsEmptyString Then tmpUserId = nn.ItemF({"extended_entities", "media", 0, sourceIdPredicate}).XmlIfNothingValue. If tmpUserId.IsEmptyString Then tmpUserId = nn.ItemF({"extended_entities", "media", 0, sourceIdPredicate}).XmlIfNothingValue.
IfNullOrEmpty(nn.Value("user_id")).IfNullOrEmpty(nn.Value("user_id_str")).IfNullOrEmpty("/") IfNullOrEmpty(nn.Value("user_id")).IfNullOrEmpty(nn.Value("user_id_str")).IfNullOrEmpty("/")
If Not ParseUserMediaOnly OrElse If (Not ParseUserMediaOnly Or dirIndx = 3) OrElse
(dirIndx = 0 AndAlso MediaModelAllowNonUserTweets) OrElse (dirIndx = 0 AndAlso MediaModelAllowNonUserTweets) OrElse
(Not ID.IsEmptyString AndAlso tmpUserId = ID) Then ObtainMedia(nn, PostID, PostDate) (Not ID.IsEmptyString AndAlso tmpUserId = ID) Then
If dirIndx = 3 Then
Dim lUrl$ = nn.ItemF({"content", "itemContent", "tweet_results", "result", "legacy", "entities", "media", 0}, "expanded_url").XmlIfNothingValue
If Not lUrl.IsEmptyString Then
lUrl = RegexReplace(lUrl, StatusRegEx)
If Not lUrl.IsEmptyString Then
If Not _TempPostsList.Contains(lUrl) Then _TempPostsList.Add(lUrl) Else Return False
LikesPosts.ListAddValue(lUrl, LNC)
End If
End If
Else
ObtainMedia(nn, PostID, PostDate)
End If
End If
End If End If
Return True Return True
End Function End Function
@@ -225,6 +254,8 @@ Namespace API.Twitter
For Each dir As SFile In dirs For Each dir As SFile In dirs
dirIndx += 1 dirIndx += 1
If dirIndx = 3 Then likesDetected = True
ExistsDetected = False ExistsDetected = False
If Not dir.IsEmptyString Then If Not dir.IsEmptyString Then
@@ -287,17 +318,22 @@ Namespace API.Twitter
End If End If
End If End If
Else Else
For pIndx = 0 To IIf(dirIndx < 2, 1, 0) For pIndx = 0 To IIf(dirIndx < 2 Or dirIndx = 3, 1, 0)
optionalNode = Nothing optionalNode = Nothing
Select Case dirIndx Select Case dirIndx
Case 0, 1 Case 0, 1, 3
rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"}) rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"})
If rootNode.ListExists Then If rootNode.ListExists Then
p = If(pIndx = 0, pinNode, timelineNode) If dirIndx = 3 Then
isPins = pIndx = 0 p = entriesNode
isPins = False
Else
p = If(pIndx = 0, pinNode, timelineNode)
isPins = pIndx = 0
End If
optionalNode = rootNode optionalNode = rootNode
rootNode = rootNode.Find(p, False) rootNode = rootNode.Find(p, dirIndx = 3)
If rootNode.ListExists Then rootNode = rootNode.Find(entriesNode, False) If dirIndx <> 3 And rootNode.ListExists Then rootNode = rootNode.Find(entriesNode, dirIndx = 3)
End If End If
Case Else Case Else
isPins = False isPins = False
@@ -369,12 +405,12 @@ Namespace API.Twitter
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"data downloading error [{URL}]")
Finally Finally
If Not tCache Is Nothing Then tCache.Dispose() If Not tCache Is Nothing Then tCache.Dispose()
If _TempPostsList.Count > 0 Then _TempPostsList.Sort() If _TempPostsList.Count > 0 And Not likesDetected Then _TempPostsList.Sort()
End Try End Try
End Sub End Sub
Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken) Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken)
Try Try
Dim f As SFile = GetDataFromGalleryDL("https://twitter.com/i/bookmarks", Settings.Cache, True, Token) Dim f As SFile = GetDataFromGalleryDL("https://x.com/i/bookmarks", Settings.Cache, True, Token)
Dim files As List(Of SFile) = SFile.GetFiles(f, "*.txt") Dim files As List(Of SFile) = SFile.GetFiles(f, "*.txt")
If files.ListExists Then If files.ListExists Then
ResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3)) ResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3))
@@ -417,21 +453,24 @@ Namespace API.Twitter
#End Region #End Region
#Region "Obtain media" #Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown, Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) Optional ByVal Attempts As Integer = 0, Optional ByVal SpecialFolder As String = Nothing)
Dim s As EContainer = e({"extended_entities", "media"}) Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"}) If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"}) If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
If If(s?.Count, 0) > 0 Then If If(s?.Count, 0) > 0 Then
Dim mUrl$ Dim mUrl$
Dim media As UserMedia
For Each m As EContainer In s For Each m As EContainer In s
If Not CheckVideoNode(m, PostID, PostDate, State) Then If Not CheckVideoNode(m, PostID, PostDate, State, SpecialFolder) Then
mUrl = m.Value("media_url").IfNullOrEmpty(m.Value("media_url_https")) mUrl = m.Value("media_url").IfNullOrEmpty(m.Value("media_url_https"))
If Not mUrl.IsEmptyString Then If Not mUrl.IsEmptyString Then
Dim dName$ = UrlFile(mUrl) Dim dName$ = UrlFile(mUrl)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName) _DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture, Attempts), LNC) media = MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture, Attempts)
If Not SpecialFolder.IsEmptyString Then media.SpecialFolder = SpecialFolder
_TempMediaList.ListAddValue(media, LNC)
End If End If
End If End If
End If End If
@@ -439,15 +478,17 @@ Namespace API.Twitter
End If End If
End Sub End Sub
Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String, Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal State As UStates = UStates.Unknown) As Boolean Optional ByVal State As UStates = UStates.Unknown, Optional ByVal SpecialFolder As String = Nothing) As Boolean
Try Try
If CheckForGif(w, PostID, PostDate, State) Then Return True If CheckForGif(w, PostID, PostDate, State, SpecialFolder) Then Return True
Dim URL$ = GetVideoNodeURL(w) Dim URL$ = GetVideoNodeURL(w)
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Dim f$ = UrlFile(URL) Dim f$ = UrlFile(URL)
If Not f.IsEmptyString AndAlso Not _DataNames.Contains(f) Then If Not f.IsEmptyString AndAlso Not _DataNames.Contains(f) Then
_DataNames.Add(f) _DataNames.Add(f)
_TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate,, State, UTypes.Video), LNC) Dim m As UserMedia = MediaFromData(URL, PostID, PostDate,, State, UTypes.Video)
If Not SpecialFolder.IsEmptyString Then m.SpecialFolder = SpecialFolder
_TempMediaList.ListAddValue(m, LNC)
End If End If
Return True Return True
End If End If
@@ -458,7 +499,7 @@ Namespace API.Twitter
End Try End Try
End Function End Function
Private Function CheckForGif(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String, Private Function CheckForGif(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal State As UStates = UStates.Unknown) As Boolean Optional ByVal State As UStates = UStates.Unknown, Optional ByVal SpecialFolder As String = Nothing) As Boolean
Try Try
Dim gifUrl As Predicate(Of EContainer) = Function(e) Not e.Value("content_type").IsEmptyString AndAlso Dim gifUrl As Predicate(Of EContainer) = Function(e) Not e.Value("content_type").IsEmptyString AndAlso
e.Value("content_type").Contains("mp4") AndAlso e.Value("content_type").Contains("mp4") AndAlso
@@ -477,9 +518,13 @@ Namespace API.Twitter
If Not ff.IsEmptyString Then If Not ff.IsEmptyString Then
If GifsDownload And Not _DataNames.Contains(ff) Then If GifsDownload And Not _DataNames.Contains(ff) Then
m = MediaFromData(url, PostID, PostDate,, State, UTypes.Video) m = MediaFromData(url, PostID, PostDate,, State, UTypes.Video)
If Not SpecialFolder.IsEmptyString Then m.SpecialFolder = SpecialFolder
f = m.File f = m.File
If Not f.IsEmptyString And Not GifsPrefix.IsEmptyString Then f.Name = $"{GifsPrefix}{f.Name}" : m.File = f If Not f.IsEmptyString And Not GifsPrefix.IsEmptyString Then f.Name = $"{GifsPrefix}{f.Name}" : m.File = f
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = $"{GifsSpecialFolder}*" If Not GifsSpecialFolder.IsEmptyString Then
If Not m.SpecialFolder.IsEmptyString Then m.SpecialFolder &= "\"
m.SpecialFolder &= $"{GifsSpecialFolder}*"
End If
_TempMediaList.ListAddValue(m, LNC) _TempMediaList.ListAddValue(m, LNC)
End If End If
Return True Return True
@@ -621,11 +666,12 @@ Namespace API.Twitter
.AutoClear = True, .AutoClear = True,
.AutoReset = True, .AutoReset = True,
.CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}", .CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}",
.FileExchanger = confCache .FileExchanger = confCache,
.DebugMode = True
} }
tgdl.FileExchanger.DeleteCacheOnDispose = False tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = False tgdl.FileExchanger.DeleteRootOnDispose = False
For i As Byte = 0 To 2 For i As Byte = 0 To 3
dir = rootDir.NewPath dir = rootDir.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException) dir.Exists(SFO.Path, True, EDP.ThrowException)
outList.Add(dir) outList.Add(dir)
@@ -633,9 +679,10 @@ Namespace API.Twitter
command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages " command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages "
command &= GdlGetIdFilterString() command &= GdlGetIdFilterString()
Select Case i Select Case i
Case 0 : command &= $"https://twitter.com/{Name}/media" : process = dm.Contains(DownloadModels.Media) Case 0 : command &= $"https://x.com/{Name}/media" : process = dm.Contains(DownloadModels.Media)
Case 1 : command &= $"https://twitter.com/{Name}" : process = dm.Contains(DownloadModels.Profile) Case 1 : command &= $"https://x.com/{Name}" : process = dm.Contains(DownloadModels.Profile)
Case 2 : command &= $"-o search-endpoint=graphql https://twitter.com/search?q=from:{Name}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search) Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{Name}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search)
Case 3 : command &= $"https://x.com/{Name}/likes" : process = dm.Contains(DownloadModels.Likes)
Case Else : process = False Case Else : process = False
End Select End Select
'#If DEBUG Then '#If DEBUG Then
@@ -687,13 +734,14 @@ Namespace API.Twitter
End Function End Function
#End Region #End Region
#Region "ReparseMissing" #Region "ReparseMissing"
Private _ReparseLikes As Boolean = False
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const SinglePostPattern$ = "https://twitter.com/{0}/status/{1}" Const SinglePostPattern$ = "https://x.com/{0}/status/{1}"
Dim rList As New List(Of Integer) Dim rList As New List(Of Integer)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim cache As CacheKeeper = Nothing Dim cache As CacheKeeper = Nothing
Try Try
If ContentMissingExists Then If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then
Dim m As UserMedia Dim m As UserMedia
Dim PostDate$ Dim PostDate$
Dim nodes As List(Of String()) = GetContainerSubnodes() Dim nodes As List(Of String()) = GetContainerSubnodes()
@@ -702,22 +750,29 @@ Namespace API.Twitter
Dim f As SFile Dim f As SFile
Dim i%, ii% Dim i%, ii%
Dim files As List(Of SFile) Dim files As List(Of SFile)
Dim lim%
Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty)
ResetFileNameProvider() ResetFileNameProvider()
If IsSingleObjectDownload Then If IsSingleObjectDownload Then
cache = Settings.Cache cache = Settings.Cache
ElseIf _ReparseLikes Then
cache = CreateCache()
Else Else
cache = New CacheKeeper(DownloadContentDefault_GetRootDir.CSFilePS) cache = New CacheKeeper(DownloadContentDefault_GetRootDir.CSFilePS)
cache.CacheDeleteError = CacheDeletionError(cache) cache.CacheDeleteError = CacheDeletionError(cache)
End If End If
ProgressPre.ChangeMax(_ContentList.Count) If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count
For i = 0 To _ContentList.Count - 1 ProgressPre.ChangeMax(lim)
For i = 0 To lim - 1
ProgressPre.Perform() ProgressPre.Perform()
If _ContentList(i).State = UStates.Missing Then If _ReparseLikes OrElse _ContentList(i).State = UStates.Missing Then
m = _ContentList(i) m = If(_ReparseLikes, Nothing, _ContentList(i))
If Not m.Post.ID.IsEmptyString Or (IsSingleObjectDownload And Not m.URL_BASE.IsEmptyString) Then If Not m.Post.ID.IsEmptyString Or (IsSingleObjectDownload And Not m.URL_BASE.IsEmptyString) Or _ReparseLikes Then
ThrowAny(Token) ThrowAny(Token)
If IsSingleObjectDownload Then If IsSingleObjectDownload Then
URL = m.URL_BASE URL = m.URL_BASE
ElseIf _ReparseLikes Then
URL = LikesPosts(i)
Else Else
URL = String.Format(SinglePostPattern, Name, m.Post.ID) URL = String.Format(SinglePostPattern, Name, m.Post.ID)
End If End If
@@ -737,7 +792,7 @@ Namespace API.Twitter
If .ListExists Then If .ListExists Then
PostDate = String.Empty PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts) ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder)
rList.ListAddValue(i, LNC) rList.ListAddValue(i, LNC)
End If End If
End With End With
@@ -759,7 +814,7 @@ Namespace API.Twitter
ProcessException(ex, Token, $"ReparseMissing error [{URL}]") ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally Finally
If Not cache Is Nothing And Not IsSingleObjectDownload Then cache.Dispose() If Not cache Is Nothing And Not IsSingleObjectDownload Then cache.Dispose()
If rList.Count > 0 Then If rList.Count > 0 And Not _ReparseLikes Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear() rList.Clear()
End If End If
@@ -856,7 +911,7 @@ Namespace API.Twitter
#End Region #End Region
#Region "IDisposable support" #Region "IDisposable support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _DataNames.Clear() If Not disposedValue And disposing Then _DataNames.Clear() : LikesPosts.Clear()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -558,7 +558,7 @@ Namespace API
End Sub End Sub
#End Region #End Region
#Region "Move, Merge" #Region "Move, Merge"
Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile, Optional ByVal NewUser As SplitCollectionUserInfo? = Nothing) As Boolean
Throw New NotImplementedException("Move files is not available in the collection context") Throw New NotImplementedException("Move files is not available in the collection context")
End Function End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean) Friend Overloads Sub MergeData(ByVal Merging As Boolean)
@@ -601,7 +601,19 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical) "Operation canceled", MsgBoxStyle.Critical)
Return False Return False
Else Else
_Item.MoveFiles(String.Empty, Nothing) Dim uObj As SplitCollectionUserInfo? = DirectCast(_Item, UserDataBase).SplitCollectionGetNewUserInfo
If uObj.Value.SameDrive Then
uObj = Nothing
Else
Using f As New SplitCollectionUserInfoChangePathsForm({uObj})
f.ShowDialog()
Select Case f.DialogResult
Case DialogResult.OK : If f.Users(0).Changed Then uObj = f.Users(0) Else uObj = Nothing
Case DialogResult.Abort : Return False
End Select
End Using
End If
_Item.MoveFiles(String.Empty, Nothing, uObj)
MainFrameObj.ImageHandler(_Item) MainFrameObj.ImageHandler(_Item)
AddRemoveBttDeleteHandler(_Item, False) AddRemoveBttDeleteHandler(_Item, False)
RaiseEvent OnUserRemoved(_Item) RaiseEvent OnUserRemoved(_Item)
@@ -618,7 +630,7 @@ Namespace API
End If End If
Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr & Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr &
"Are you sure you want to delete the collection and all of its files?", MsgTitle, "Are you sure you want to delete the collection and all of its files?", MsgTitle,
{New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files", .KeyCode = Keys.Enter}, {New MsgBoxButton("Delete", "Delete the collection and all files") With {.KeyCode = Keys.Enter},
New MsgBoxButton("Split") With { New MsgBoxButton("Split") With {
.ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr & .ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr &
"All user data will remain.", "All user data will remain.",
@@ -653,12 +665,31 @@ Namespace API
MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation) MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation)
Return 0 Return 0
Else Else
Collections.ForEach(Sub(ByVal c As IUserData) Dim uu As New List(Of SplitCollectionUserInfo)(Collections.Select(Function(uuu As UserDataBase) uuu.SplitCollectionGetNewUserInfo))
If c.MoveFiles(String.Empty, Nothing) Then If uu.All(Function(uuu) uuu.SameDrive) Then
UserListLoader.UpdateUser(Settings.GetUser(c), True) uu.Clear()
MainFrameObj.ImageHandler(c) Else
End If Using colPaths As New SplitCollectionUserInfoChangePathsForm(uu)
End Sub) colPaths.ShowDialog()
Select Case colPaths.DialogResult
Case DialogResult.OK
If colPaths.Users.Any(Function(uuu) uuu.Changed) Then
uu = New List(Of SplitCollectionUserInfo)(colPaths.Users)
Else
uu.Clear()
End If
Case DialogResult.Abort : Return 0
End Select
End Using
End If
Collections.ListForEach(Sub(ByVal c As IUserData, ByVal indx As Integer)
Dim uObj As SplitCollectionUserInfo? = Nothing
If uu.Count > 0 AndAlso indx.ValueBetween(0, uu.Count - 1) AndAlso uu(indx).Changed Then uObj = uu(indx)
If c.MoveFiles(String.Empty, Nothing, uObj) Then
UserListLoader.UpdateUser(Settings.GetUser(c), True)
MainFrameObj.ImageHandler(c)
End If
End Sub)
If Collections.All(Function(c) c.CollectionName.IsEmptyString) Then If Collections.All(Function(c) c.CollectionName.IsEmptyString) Then
Settings.Users.Remove(Me) Settings.Users.Remove(Me)
Collections.Clear() Collections.Clear()

View File

@@ -21,6 +21,7 @@ Namespace DownloadObjects
Specified = 3 Specified = 3
Groups = 4 Groups = 4
End Enum End Enum
Friend Const NoPauseMode As Integer = -100
Friend Enum PauseModes As Integer Friend Enum PauseModes As Integer
Disabled = -2 Disabled = -2
Enabled = -1 Enabled = -1

View File

@@ -28,9 +28,10 @@ Namespace DownloadObjects
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(AutoDownloaderEditorForm)) Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(AutoDownloaderEditorForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim ActionButton4 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()
Dim TT_MAIN As System.Windows.Forms.ToolTip Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults() Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
Me.OPT_SPEC = New System.Windows.Forms.RadioButton() Me.OPT_SPEC = New System.Windows.Forms.RadioButton()
@@ -178,9 +179,14 @@ Namespace DownloadObjects
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image) ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Edit" ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image) ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear" ActionButton2.Name = "Info"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Info
ActionButton2.ToolTipText = "Open group"
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1) Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2) Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.Buttons.Add(ActionButton3)
Me.TXT_GROUPS.CaptionText = "Groups" Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
@@ -260,9 +266,9 @@ Namespace DownloadObjects
' '
'TXT_TIMER 'TXT_TIMER
' '
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image) ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh" ActionButton4.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3) Me.TXT_TIMER.Buttons.Add(ActionButton4)
Me.TXT_TIMER.CaptionText = "Timer" Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)" Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
@@ -275,9 +281,9 @@ Namespace DownloadObjects
' '
'NUM_DELAY 'NUM_DELAY
' '
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image) ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh" ActionButton5.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4) Me.NUM_DELAY.Buttons.Add(ActionButton5)
Me.NUM_DELAY.CaptionText = "Delay" Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay" Me.NUM_DELAY.CaptionToolTipText = "Startup delay"

View File

@@ -189,6 +189,18 @@
</value> </value>
</data> </data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1
MAAA6mAAADqYAAAXb5JfxUYAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAFQSURBVFhH7ZfNDcIwFIMZoXcm
YBtGYRHECIgTR1ZhBsS9YoJgQ1Poi5sfqhIOWPqkqvV7dWlI0oVzriry5Dd5HSS0PFwasAEn0AJn4Dle
o6fpykaVHYDNwB7YG6ZgzWiQrABosAbqaXNh7bprN1AyAAp3b42msuva9ooGYIFpELA931D2FI+VxzAI
gTIdAEb+7KpBz+p4RclQyifoXwdKwgAwcMAl3/mEAOz9GJgokQGyR/sHr8CzlwFwgU+vCuagUQE4gSjz
HGxUAM5iyiyxUp4IJ5QEAYomHCvlidCiJAigjKNYKU8M6B/g9wJUH4TV/4ZFE5GV8kSQE1HRVGylPBHC
qbh0MbJSnhH0YtQFyFqOiZXyCOLLMQVDckNCrJRHEN+QeMGY3JJZKY8hb0vmxQLTYAplm1IvFNbblnuh
Qb0Pk3exGZjv06wW8uT3cIs7jQnSONrSxH0AAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -203,22 +215,6 @@
<value>Show a simple notification instead of a user notification. <value>Show a simple notification instead of a user notification.
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded. This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value> The 'Image' and 'User icon' parameters will be ignored.</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data> </data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
@@ -234,6 +230,22 @@ The 'Image' and 'User icon' parameters will be ignored.</value>
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74 HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value> </value>
</data> </data>
</root> </root>

View File

@@ -134,11 +134,26 @@ Namespace DownloadObjects
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GROUPS.ActionOnButtonClick Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GROUPS.ActionOnButtonClick
Select Case Sender.DefaultButton Select Case Sender.DefaultButton
Case ActionButton.DefaultButtons.Edit Case ActionButton.DefaultButtons.Edit
Using f As New LabelsForm(MyGroups, (From g As DownloadGroup In Settings.Groups Where Not g.IsViewFilter Select g.Name)) With {.Text = "Groups", .Icon = My.Resources.GroupByIcon_16} Using f As New LabelsForm(MyGroups, (From g As DownloadGroup In Settings.Groups Where Not g.IsViewFilter Select g.Name)) With {
.Text = "Groups (F3 to edit)",
.Icon = My.Resources.GroupByIcon_16,
.IsGroups = True
}
f.ShowDialog() f.ShowDialog()
If f.DialogResult = DialogResult.OK Then MyGroups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : TXT_GROUPS.Text = MyGroups.ListToString If f.DialogResult = DialogResult.OK Then MyGroups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : TXT_GROUPS.Text = MyGroups.ListToString
End Using End Using
Case ActionButton.DefaultButtons.Clear : MyGroups.Clear() Case ActionButton.DefaultButtons.Clear : MyGroups.Clear()
Case ActionButton.DefaultButtons.Info
Try
If MyGroups.Count > 0 Then
Dim i% = Settings.Groups.IndexOf(MyGroups(0))
If i >= 0 Then
Using gf As New GroupEditorForm(Settings.Groups(i)) : gf.ShowDialog() : End Using
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Show group")
End Try
End Select End Select
End Sub End Sub
Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged, Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged,

View File

@@ -8,6 +8,8 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports ECI = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem Imports ECI = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
@@ -235,6 +237,25 @@ Namespace DownloadObjects
Private Function GetSchedulerFiles() As List(Of SFile) Private Function GetSchedulerFiles() As List(Of SFile)
Return SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue) Return SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue)
End Function End Function
Private Class SchedulerList : Inherits SimpleListForm(Of String)
Friend Sub New(ByVal Source As IEnumerable(Of String), Optional ByRef DesignXML As EContainer = Nothing)
MyBase.New(Source, DesignXML)
End Sub
Protected Overrides Sub MyForm_Load(sender As Object, e As EventArgs)
MyBase.MyForm_Load(sender, e)
CMB_DATA.Button(ADB.Add).ToolTipText = "Create a new scheduler"
CMB_DATA.Button(ADB.SaveAs).ToolTipText = "Clone an existing scheduler and save it as a new one"
CMB_DATA.Button(ADB.Delete).ToolTipText = "Delete the selected scheduler"
CMB_DATA.Buttons.UpdateButtonsPositions()
End Sub
Protected Overrides Sub CMB_DATA_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs)
If e.DefaultButton = ADB.SaveAs Then
AddNewItem(e, e.Key, e.KeyEventArgs)
Else
MyBase.CMB_DATA_ActionOnButtonClick(Sender, e)
End If
End Sub
End Class
Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
Const msgTitle$ = "Change scheduler" Const msgTitle$ = "Change scheduler"
Try Try
@@ -244,7 +265,7 @@ Namespace DownloadObjects
If .ListExists Then .ForEach(Sub(ff) l.Add(ff, ff.Name.Replace(Scheduler.FileNameDefault, String.Empty).StringTrimStart("_").IfNullOrEmpty(defName))) If .ListExists Then .ForEach(Sub(ff) l.Add(ff, ff.Name.Replace(Scheduler.FileNameDefault, String.Empty).StringTrimStart("_").IfNullOrEmpty(defName)))
End With End With
If l.Count > 0 Then If l.Count > 0 Then
Using chooser As New SimpleListForm(Of String)(l.Values.Cast(Of String), Settings.Design) With { Using chooser As New SchedulerList(l.Values.Cast(Of String), Settings.Design) With {
.DesignXMLNodeName = "SchedulerChooserForm", .DesignXMLNodeName = "SchedulerChooserForm",
.Icon = ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue), .Icon = ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue),
.FormText = "Schedulers", .FormText = "Schedulers",
@@ -256,17 +277,56 @@ Namespace DownloadObjects
Dim f As SFile Dim f As SFile
Dim selectedName$ Dim selectedName$
Dim addedObj$ = String.Empty Dim addedObj$ = String.Empty
Dim addedObjIsClone As Boolean = False
Dim createSchedulerPath As Func(Of String, SFile) = Function(n) $"{SettingsFolderName}\{Scheduler.FileNameDefault}_{n.StringRemoveWinForbiddenSymbols}.xml"
.ClearButtons() .ClearButtons()
.Buttons = {ADB.Add, ADB.Delete} .Buttons = {ADB.Add, ADB.SaveAs, ADB.Delete}
AddHandler .AddClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs) AddHandler .AddClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs)
If addedObj.IsEmptyString Then If addedObj.IsEmptyString Then
addedObj = InputBoxE("Enter a new scheduler name:", msgTitle) addedObj = InputBoxE("Enter a new scheduler name:", msgTitle)
args.Result = Not addedObj.IsEmptyString args.Result = Not addedObj.IsEmptyString
If args.Result Then args.Item = addedObj If args.Result Then
If l.Values.Count > 0 AndAlso l.Values.ListIndexOf(Function(n) n.StringToLower = addedObj.StringToLower) >= 0 Then
args.Result = False
MsgBoxE({$"A scheduler named '{addedObj}' already exists", msgTitle}, vbCritical)
Else
args.Item = addedObj
addedObjIsClone = Not args.ButtonEventArgs Is Nothing AndAlso
TypeOf args.ButtonEventArgs Is ActionButtonEventArgs AndAlso
DirectCast(args.ButtonEventArgs, ActionButtonEventArgs).DefaultButton = ADB.SaveAs
If addedObjIsClone Then
Dim cloneF As SFile = createSchedulerPath.Invoke(addedObj)
If Not cloneF.Exists And Settings.Automation.File.Exists Then
Using x As New XmlFile(Settings.Automation.File, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
x.Save(cloneF, EDP.SendToLog)
End Using
End If
End If
End If
End If
Else Else
MsgBoxE({"You can only create one scheduler at a time", "Create a new scheduler"}, vbCritical) MsgBoxE({"You can only create one scheduler at a time", "Create a new scheduler"}, vbCritical)
End If End If
End Sub End Sub
AddHandler .DeleteClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs)
Dim n$ = AConvert(Of String)(args.Item, String.Empty)
If Not n.IsEmptyString Then
If MsgBoxE({$"Are you sure you want to delete the '{n}' scheduler?", msgTitle}, vbExclamation,,,
{"Process", "Cancel"}) = 0 Then
Dim delF As SFile = createSchedulerPath.Invoke(n)
If delF.Exists AndAlso delF.Delete Then
args.Result = True
If l.ContainsKey(delF) Then
l.Remove(delF)
Else
Dim delIndx% = l.ListIndexOf(Function(dd) dd.Value = n)
If delIndx >= 0 Then l.Remove(l.Keys(delIndx))
End If
End If
End If
End If
End Sub
If Settings.Automation.File.Name = Scheduler.FileNameDefault Then If Settings.Automation.File.Name = Scheduler.FileNameDefault Then
.DataSelectedIndexes.Add(0) .DataSelectedIndexes.Add(0)
Else Else
@@ -279,7 +339,7 @@ Namespace DownloadObjects
If selectedName = defName Then If selectedName = defName Then
f = Settings.Automation.FileDefault f = Settings.Automation.FileDefault
Else Else
f = $"{SettingsFolderName}\{Scheduler.FileNameDefault}_{selectedName.StringRemoveWinForbiddenSymbols}.xml" f = createSchedulerPath.Invoke(selectedName)
End If End If
If Not Settings.Automation.File = f AndAlso Settings.Automation.Reset(f, False) Then If Not Settings.Automation.File = f AndAlso Settings.Automation.Reset(f, False) Then
Settings.Automation.File = f Settings.Automation.File = f

View File

@@ -20,6 +20,7 @@ Namespace DownloadObjects.Groups
Private Const Name_FilterViewMode As String = "FilterViewMode" Private Const Name_FilterViewMode As String = "FilterViewMode"
Private Const Name_FilterGroupUsers As String = "FilterGroupUsers" Private Const Name_FilterGroupUsers As String = "FilterGroupUsers"
Private Const Name_FilterShowGroupsInsteadLabels As String = "FilterShowGroupsInsteadLabels" Private Const Name_FilterShowGroupsInsteadLabels As String = "FilterShowGroupsInsteadLabels"
Private Const Name_FilterShowAllUsers As String = "FilterShowAllUsers"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
#Region "Controls" #Region "Controls"
@@ -36,6 +37,7 @@ Namespace DownloadObjects.Groups
Friend Property FilterViewMode As ViewModes = ViewModes.IconLarge Friend Property FilterViewMode As ViewModes = ViewModes.IconLarge
Friend Property FilterGroupUsers As Boolean = True Friend Property FilterGroupUsers As Boolean = True
Friend Property FilterShowGroupsInsteadLabels As Boolean = True Friend Property FilterShowGroupsInsteadLabels As Boolean = True
Friend Property FilterShowAllUsers As Boolean = False
#End Region #End Region
Private File As SFile = Nothing Private File As SFile = Nothing
Friend Overrides Property Name As String Friend Overrides Property Name As String
@@ -144,13 +146,15 @@ Namespace DownloadObjects.Groups
FilterViewMode = e.Value(Name_FilterViewMode).FromXML(Of Integer)(ViewModes.IconLarge) FilterViewMode = e.Value(Name_FilterViewMode).FromXML(Of Integer)(ViewModes.IconLarge)
FilterGroupUsers = e.Value(Name_FilterGroupUsers).FromXML(Of Boolean)(True) FilterGroupUsers = e.Value(Name_FilterGroupUsers).FromXML(Of Boolean)(True)
FilterShowGroupsInsteadLabels = e.Value(Name_FilterShowGroupsInsteadLabels).FromXML(Of Boolean)(True) FilterShowGroupsInsteadLabels = e.Value(Name_FilterShowGroupsInsteadLabels).FromXML(Of Boolean)(True)
FilterShowAllUsers = e.Value(Name_FilterShowAllUsers).FromXML(Of Boolean)(False)
End If End If
End Sub End Sub
Protected Overrides Function Export(ByVal e As EContainer) As EContainer Protected Overrides Function Export(ByVal e As EContainer) As EContainer
MyBase.Export(e) MyBase.Export(e)
e.AddRange({New EContainer(Name_FilterViewMode, CInt(FilterViewMode)), e.AddRange({New EContainer(Name_FilterViewMode, CInt(FilterViewMode)),
New EContainer(Name_FilterGroupUsers, FilterGroupUsers.BoolToInteger), New EContainer(Name_FilterGroupUsers, FilterGroupUsers.BoolToInteger),
New EContainer(Name_FilterShowGroupsInsteadLabels, FilterShowGroupsInsteadLabels.BoolToInteger)}) New EContainer(Name_FilterShowGroupsInsteadLabels, FilterShowGroupsInsteadLabels.BoolToInteger),
New EContainer(Name_FilterShowAllUsers, FilterShowAllUsers.BoolToInteger)})
Return e Return e
End Function End Function
#End Region #End Region
@@ -166,6 +170,7 @@ Namespace DownloadObjects.Groups
FilterViewMode = .FilterViewMode FilterViewMode = .FilterViewMode
FilterGroupUsers = .FilterGroupUsers FilterGroupUsers = .FilterGroupUsers
FilterShowGroupsInsteadLabels = .FilterShowGroupsInsteadLabels FilterShowGroupsInsteadLabels = .FilterShowGroupsInsteadLabels
FilterShowAllUsers = .FilterShowAllUsers
End If End If
End With End With
End If End If

View File

@@ -117,6 +117,8 @@ Namespace DownloadObjects.Groups
RefillList() RefillList()
If Not IsViewFilter Then Settings.Groups.BeginUpdate() If Not IsViewFilter Then Settings.Groups.BeginUpdate()
If IsViewFilter And LIST_GROUPS.Items.Count > 0 Then .MyOkCancel.EnableOK = True : _LatestSelected = 0
.DelegateClosingChecker = False .DelegateClosingChecker = False
.EndLoaderOperations() .EndLoaderOperations()

View File

@@ -19,6 +19,7 @@ Namespace Editors
Friend Property HeadersChanged As Boolean = False Friend Property HeadersChanged As Boolean = False
Friend Property PictureChanged As Boolean = False Friend Property PictureChanged As Boolean = False
Friend Property EnvironmentProgramsChanged As Boolean = False Friend Property EnvironmentProgramsChanged As Boolean = False
Friend Property UserAgentChanged As Boolean = False
Friend Sub New() Friend Sub New()
InitializeComponent() InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design) MyDefs = New DefaultFormOptions(Me, Settings.Design)
@@ -183,6 +184,7 @@ Namespace Editors
"Do you really want to continue?", "Do you really want to continue?",
"Increasing download tasks"}, "Increasing download tasks"},
vbExclamation,,, {"Confirm", $"Set to default ({SettingsCLS.DefaultMaxDownloadingTasks})", "Cancel"}) vbExclamation,,, {"Confirm", $"Set to default ({SettingsCLS.DefaultMaxDownloadingTasks})", "Cancel"})
If CInt(TXT_MAX_JOBS_USERS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then If CInt(TXT_MAX_JOBS_USERS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then
Select Case a.Invoke("users", TXT_MAX_JOBS_USERS.Value) Select Case a.Invoke("users", TXT_MAX_JOBS_USERS.Value)
Case 1 : TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks Case 1 : TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks
@@ -213,6 +215,25 @@ Namespace Editors
"If this case, the functionality of SCrawler will be limited, and some sites will not work at all.", "If this case, the functionality of SCrawler will be limited, and some sites will not work at all.",
"Environment missing"}, vbExclamation,,, {"Process", "Cancel"}) = 1 Then Exit Sub "Environment missing"}, vbExclamation,,, {"Process", "Cancel"}) = 1 Then Exit Sub
If Not .GlobalPath.Value.PathWithSeparator = TXT_GLOBAL_PATH.Text.CSFilePS Or Not .CollectionsPath.Value = TXT_COLLECTIONS_PATH.Text Then
If Not Plugin.Hosts.SettingsHostCollection.UpdateHostPath_CheckDownloader Then Exit Sub
If MsgBoxE({"You have changed the global path or collections folder!" & vbCr & vbCr &
$"Global path ({IIf(.GlobalPath.Value.PathWithSeparator = TXT_GLOBAL_PATH.Text.CSFilePS, "not changed", "CHANGED")})" & vbCr &
$"Current: { .GlobalPath.Value}" & vbCr &
$"New: {TXT_GLOBAL_PATH.Text}" & vbCr & vbCr &
$"Collections folder ({IIf(.CollectionsPath.Value = TXT_COLLECTIONS_PATH.Text, "not changed", "CHANGED")})" & vbCr &
$"Current: { .CollectionsPath.Value}" & vbCr &
$"New: {TXT_COLLECTIONS_PATH.Text}" & vbCr & vbCr &
"Are you sure you want to continue?",
"Global path changed"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
If Not Plugin.Hosts.SettingsHostCollection.UpdateHostPath(.GlobalPath, TXT_GLOBAL_PATH.Text.CSFileP,
.CollectionsPath, TXT_COLLECTIONS_PATH.Text) Then _
MsgBoxE({"Something went wrong while updating the global paths.", "Global path changed"}, vbCritical)
Else
Exit Sub
End If
End If
Dim detector As Func(Of IXMLValue, Boolean) = Function(hh) hh.ChangesDetected Dim detector As Func(Of IXMLValue, Boolean) = Function(hh) hh.ChangesDetected
.BeginUpdate() .BeginUpdate()
@@ -225,7 +246,7 @@ Namespace Editors
.ChannelsMaxJobsCount.Value = TXT_MAX_JOBS_CHANNELS.Value .ChannelsMaxJobsCount.Value = TXT_MAX_JOBS_CHANNELS.Value
.CheckUpdatesAtStart.Value = CH_CHECK_VER_START.Checked .CheckUpdatesAtStart.Value = CH_CHECK_VER_START.Checked
.UserAgent.Value = TXT_USER_AGENT.Text .UserAgent.Value = TXT_USER_AGENT.Text
DefaultUserAgent = TXT_USER_AGENT.Text UserAgentChanged = .UserAgent.ChangesDetected
.ImgurClientID.Value = TXT_IMGUR_CLIENT_ID.Text .ImgurClientID.Value = TXT_IMGUR_CLIENT_ID.Text
'Design 'Design
.ProgramText.Value = TXT_PRG_TITLE.Text .ProgramText.Value = TXT_PRG_TITLE.Text

View File

@@ -27,6 +27,7 @@ Friend Class LabelsForm
End Property End Property
Friend Property WithDeleteButton As Boolean = False Friend Property WithDeleteButton As Boolean = False
Private ReadOnly AddNoParsed As Boolean = False Private ReadOnly AddNoParsed As Boolean = False
Friend Property IsGroups As Boolean = False
Friend Sub New(ByVal LabelsArr As IEnumerable(Of String), Optional ByVal AddNoParsed As Boolean = True) Friend Sub New(ByVal LabelsArr As IEnumerable(Of String), Optional ByVal AddNoParsed As Boolean = True)
InitializeComponent() InitializeComponent()
Me.AddNoParsed = AddNoParsed Me.AddNoParsed = AddNoParsed
@@ -65,7 +66,15 @@ Friend Class LabelsForm
End Try End Try
End Sub End Sub
Private Sub LabelsForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown Private Sub LabelsForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.Insert And _Source Is Nothing Then AddNewLabel() : e.Handled = True Dim b As Boolean = True
If e.KeyCode = Keys.Insert And _Source Is Nothing Then
AddNewLabel()
ElseIf e.KeyCode = Keys.F3 And IsGroups Then
EditSelectedGroup()
Else
b = False
End If
If b Then e.Handled = True
End Sub End Sub
Private Sub LabelsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed Private Sub LabelsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
LabelsList.Clear() LabelsList.Clear()
@@ -101,4 +110,20 @@ Friend Class LabelsForm
End If End If
End If End If
End Sub End Sub
Private Sub EditSelectedGroup()
Try
If CMB_LABELS.Count > 0 And CMB_LABELS.SelectedIndex >= 0 Then
Dim gName$ = CMB_LABELS.Value
Dim i%
If Not gName.IsEmptyString Then
i = Settings.Groups.IndexOf(gName)
If i >= 0 Then
Using f As New DownloadObjects.Groups.GroupEditorForm(Settings.Groups(i)) : f.ShowDialog() : End Using
End If
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Show group")
End Try
End Sub
End Class End Class

View File

@@ -7,6 +7,7 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports SCrawler.Plugin.Hosts Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls Imports PersonalUtilities.Forms.Controls
@@ -15,13 +16,13 @@ Imports PersonalUtilities.Tools.Web.Cookies
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace Editors Namespace Editors
Friend Class SiteEditorForm Friend Class SiteEditorForm
Private ReadOnly LBL_AUTH As Label
Private ReadOnly LBL_OTHER As Label
Private WithEvents MyDefs As DefaultFormOptions Private WithEvents MyDefs As DefaultFormOptions
Private WithEvents SpecialButton As Button Private WithEvents SpecialButton As Button
Private Property Cookies As CookieKeeper Private Property Cookies As CookieKeeper
Private ReadOnly CookiesControlsInteraction As List(Of PropertyValueHost) Private ReadOnly CookiesControlsInteraction As List(Of PropertyValueHost)
Private CookiesChanged As Boolean = False Private CookiesChanged As Boolean = False
Private Const OtherOptionsText As String = "Other Parameters"
Private ReadOnly LabelControls As List(Of Label)
#Region "Providers" #Region "Providers"
Private Class SavedPostsChecker : Inherits AccountsNameChecker Private Class SavedPostsChecker : Inherits AccountsNameChecker
Friend ReadOnly PathControl As TextBoxExtended Friend ReadOnly PathControl As TextBoxExtended
@@ -138,6 +139,108 @@ Namespace Editors
Return Nothing Return Nothing
End Function End Function
End Class End Class
#End Region
#Region "CatReorder"
Private Class CatReorder : Implements IDisposable
Private ReadOnly Items As Dictionary(Of String, List(Of PropertyValueHost))
Private Const EmptyCat As String = "----"
Friend Sub New()
Items = New Dictionary(Of String, List(Of PropertyValueHost))
End Sub
Friend ReadOnly Property Count As Integer
Get
Return Items.Count
End Get
End Property
Friend Sub Add(ByVal Item As PropertyValueHost)
Dim category$ = Item.Category.IfNullOrEmpty(EmptyCat)
If Items.ContainsKey(category) Then
Items(category).Add(Item)
Else
Items.Add(category, New List(Of PropertyValueHost) From {Item})
End If
End Sub
Friend Overloads Shared Sub AddToTable(ByRef Form As SiteEditorForm, ByVal cnt As Control, ByVal _height As Integer,
ByRef h As Integer, ByRef c As Integer)
With Form.TP_SITE_PROPS
.RowStyles.Add(New RowStyle(SizeType.Absolute, _height))
.RowCount += 1
.Controls.Add(cnt, 0, .RowStyles.Count - 1)
End With
h += _height
c += 1
End Sub
Friend Overloads Sub AddToTable(ByRef Form As SiteEditorForm, ByRef h As Integer, ByRef c As Integer, ByRef offset As Integer)
If Items.Count > 0 Then
Dim iCount% = Items.Count
Dim otherOptionsCat As KeyValuePair(Of String, List(Of PropertyValueHost)) = Nothing
Dim otherOptionsCatExists As Boolean = False
Dim AuthCat As KeyValuePair(Of String, List(Of PropertyValueHost)) = Nothing
Dim AuthCatExists As Boolean = False
If Items.Count > 1 Then
Dim catIndx% = Items.ListIndexOf(Function(cc) Not cc.Key.IsEmptyString AndAlso (cc.Key = EmptyCat Or cc.Key = OtherOptionsText))
If catIndx >= 0 Then
otherOptionsCat = New KeyValuePair(Of String, List(Of PropertyValueHost))(Items.Keys(catIndx), Items(Items.Keys(catIndx)))
otherOptionsCatExists = True
Items.Remove(otherOptionsCat.Key)
End If
catIndx = Items.ListIndexOf(Function(cc) Not cc.Key.IsEmptyString AndAlso (cc.Key = PropertyOption.CategoryAuth))
If catIndx >= 0 Then
AuthCat = New KeyValuePair(Of String, List(Of PropertyValueHost))(Items.Keys(catIndx), Items(Items.Keys(catIndx)))
AuthCatExists = True
Items.Remove(AuthCat.Key)
End If
End If
If AuthCatExists Then AddToTable(Form, iCount, AuthCat, h, c, offset)
For Each obj As KeyValuePair(Of String, List(Of PropertyValueHost)) In Items
AddToTable(Form, iCount, obj, h, c, offset)
Next
If otherOptionsCatExists Then AddToTable(Form, iCount, otherOptionsCat, h, c, offset)
End If
End Sub
Private Overloads Sub AddToTable(ByRef Form As SiteEditorForm, ByVal ItemsCount As Integer,
ByVal obj As KeyValuePair(Of String, List(Of PropertyValueHost)),
ByRef h As Integer, ByRef c As Integer, ByRef offset As Integer)
If ItemsCount > 1 And obj.Value.Count > 0 Then
Dim category$ = obj.Key.IfNullOrEmpty(OtherOptionsText)
If category = EmptyCat Then category = OtherOptionsText
Form.LabelControls.Add(New Label With {.Text = category,
.TextAlign = ContentAlignment.MiddleCenter,
.Dock = DockStyle.Fill})
AddToTable(Form, Form.LabelControls.Last, 25, h, c)
End If
If obj.Value.Count > 0 Then
For Each prop As PropertyValueHost In obj.Value
With prop
If .CookieValueExtractorExists Then Form.CookiesControlsInteraction.Add(prop)
.CreateControl(Form.TT_MAIN)
AddToTable(Form, .Control, .ControlHeight, h, c)
If .LeftOffset > offset Then offset = .LeftOffset
If Not .Options.AllowNull Or Not .ProviderFieldsChecker Is Nothing Then _
Form.MyDefs.MyFieldsCheckerE.AddControl(.Control, .Options.ControlText, .Type,
.Options.AllowNull, .ProviderFieldsChecker)
End With
Next
End If
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing And Items.Count > 0 Then Items.Clear()
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
#End Region #End Region
Private ReadOnly PropertyValid As Predicate(Of PropertyValueHost) = Function(p) (Not p.IsHidden Or SiteSettingsShowHiddenControls) And Not p.Options Is Nothing Private ReadOnly PropertyValid As Predicate(Of PropertyValueHost) = Function(p) (Not p.IsHidden Or SiteSettingsShowHiddenControls) And Not p.Options Is Nothing
Private ReadOnly Property Host As SettingsHost Private ReadOnly Property Host As SettingsHost
@@ -148,8 +251,7 @@ Namespace Editors
Host = h Host = h
CookiesControlsInteraction = New List(Of PropertyValueHost) CookiesControlsInteraction = New List(Of PropertyValueHost)
If Not Host.Responser Is Nothing Then Cookies = Host.Responser.Cookies.Copy If Not Host.Responser Is Nothing Then Cookies = Host.Responser.Cookies.Copy
LBL_AUTH = New Label With {.Text = "Authorization", .TextAlign = ContentAlignment.MiddleCenter, .Dock = DockStyle.Fill} LabelControls = New List(Of Label)
LBL_OTHER = New Label With {.Text = "Other Parameters", .TextAlign = ContentAlignment.MiddleCenter, .Dock = DockStyle.Fill}
Host.BeginEdit() Host.BeginEdit()
End Sub End Sub
Private Sub SiteEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub SiteEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
@@ -191,13 +293,6 @@ Namespace Editors
Dim offset% = PropertyValueHost.LeftOffsetDefault Dim offset% = PropertyValueHost.LeftOffsetDefault
Dim h% = 0, c% = 0 Dim h% = 0, c% = 0
Dim AddTpControl As Action(Of Control, Integer) = Sub(ByVal cnt As Control, ByVal _height As Integer)
TP_SITE_PROPS.RowStyles.Add(New RowStyle(SizeType.Absolute, _height))
TP_SITE_PROPS.RowCount += 1
TP_SITE_PROPS.Controls.Add(cnt, 0, TP_SITE_PROPS.RowStyles.Count - 1)
h += _height
c += 1
End Sub
If Host.Responser Is Nothing Then If Host.Responser Is Nothing Then
h -= 28 h -= 28
@@ -214,41 +309,17 @@ Namespace Editors
Dim laAdded As Boolean = False Dim laAdded As Boolean = False
Dim loAdded As Boolean = False 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}
If .PropList.Exists(Function(p) p.ControlNumber >= 0) Then .PropList.Sort() If .PropList.Exists(Function(p) p.ControlNumber >= 0) Then .PropList.Sort()
For Each pAuth As Boolean In pArr Using pc As New CatReorder
For Each prop As PropertyValueHost In .PropList For Each prop As PropertyValueHost In .PropList
If PropertyValid.Invoke(prop) Then If PropertyValid.Invoke(prop) Then pc.Add(prop)
With prop
If .Options.IsAuth = pAuth Then
If .CookieValueExtractorExists Then CookiesControlsInteraction.Add(prop)
If pArr.Length = 2 Then
Select Case pAuth
Case True
If Not laAdded Then AddTpControl(LBL_AUTH, 25) : laAdded = True
Case False
If Not loAdded Then AddTpControl(LBL_OTHER, 25) : loAdded = True
End Select
End If
.CreateControl(TT_MAIN)
AddTpControl(.Control, .ControlHeight)
If .LeftOffset > offset Then offset = .LeftOffset
If Not .Options.AllowNull Or Not .ProviderFieldsChecker Is Nothing Then _
MyDefs.MyFieldsCheckerE.AddControl(.Control, .Options.ControlText, .Type,
.Options.AllowNull, .ProviderFieldsChecker)
End If
End With
End If
Next Next
Next If pc.Count > 0 Then pc.AddToTable(Me, h, c, offset)
End Using
End If End If
SpecialButton = .GetSettingsButtonInternal SpecialButton = .GetSettingsButtonInternal
If Not SpecialButton Is Nothing Then AddTpControl(SpecialButton, 28) If Not SpecialButton Is Nothing Then CatReorder.AddToTable(Me, SpecialButton, 28, h, c)
TP_SITE_PROPS.BaseControlsPadding = New Padding(offset, 0, 0, 0) TP_SITE_PROPS.BaseControlsPadding = New Padding(offset, 0, 0, 0)
offset += PaddingE.GetOf({TP_SITE_PROPS}).Left offset += PaddingE.GetOf({TP_SITE_PROPS}).Left
TXT_PATH.CaptionWidth = offset TXT_PATH.CaptionWidth = offset
@@ -290,8 +361,7 @@ Namespace Editors
If Host.PropList.Count > 0 Then Host.PropList.ForEach(Sub(p) p.DisposeControl()) If Host.PropList.Count > 0 Then Host.PropList.ForEach(Sub(p) p.DisposeControl())
If Not SpecialButton Is Nothing Then SpecialButton.Dispose() If Not SpecialButton Is Nothing Then SpecialButton.Dispose()
CookiesControlsInteraction.Clear() CookiesControlsInteraction.Clear()
LBL_AUTH.Dispose() LabelControls.ListClearDispose
LBL_OTHER.Dispose()
Host.EndEdit() Host.EndEdit()
If Not Cookies Is Nothing Then Cookies.Dispose() If Not Cookies Is Nothing Then Cookies.Dispose()
End Sub End Sub
@@ -317,6 +387,13 @@ Namespace Editors
Next Next
End If End If
If TXT_PATH.Text.IsEmptyString Then TXT_PATH.Text = .PathGenerate.CSFilePS
If Not .Path.PathWithSeparator = TXT_PATH.Text Then
If Not SettingsHostCollection.UpdateHostPath_CheckDownloader Then Exit Sub
If Not SettingsHostCollection.UpdateHostPath(.Self, .Path, TXT_PATH.Text.CSFileP, True) Then _
MsgBoxE({"Something went wrong while updating the site path.", "Site path changed"}, vbCritical)
End If
SiteDefaultsFunctions.SetPropByChecker(TP_SITE_PROPS, Host) SiteDefaultsFunctions.SetPropByChecker(TP_SITE_PROPS, Host)
If TXT_PATH.IsEmptyString Then .Path = Nothing Else .Path = TXT_PATH.Text If TXT_PATH.IsEmptyString Then .Path = Nothing Else .Path = TXT_PATH.Text
.SavedPostsPath = TXT_PATH_SAVED_POSTS.Text .SavedPostsPath = TXT_PATH_SAVED_POSTS.Text

View File

@@ -325,9 +325,10 @@ CloseResume:
TrayIcon.Visible = .CloseToTray TrayIcon.Visible = .CloseToTray
If f.EnvironmentProgramsChanged Then Settings.UpdateEnvironmentPrograms() If f.EnvironmentProgramsChanged Then Settings.UpdateEnvironmentPrograms()
If f.FeedParametersChanged And Not MyFeed Is Nothing Then MyFeed.UpdateSettings() If f.FeedParametersChanged And Not MyFeed Is Nothing Then MyFeed.UpdateSettings()
If f.HeadersChanged Then If f.HeadersChanged Or (f.UserAgentChanged And Not Settings.UserAgent.IsEmptyString) Then
Settings.BeginUpdate() Settings.BeginUpdate()
Settings.Plugins.ForEach(Sub(p) p.Settings.UpdateInheritance()) If f.UserAgentChanged Then Settings.UpdatePluginsUserAgent(False)
If f.HeadersChanged Then Settings.Plugins.ForEach(Sub(p) p.Settings.UpdateInheritance())
Settings.EndUpdate() Settings.EndUpdate()
End If End If
UpdateSilentButtons() UpdateSilentButtons()
@@ -781,6 +782,7 @@ CloseResume:
f.FilterViewMode = Settings.ViewMode f.FilterViewMode = Settings.ViewMode
f.FilterGroupUsers = Settings.GroupUsers f.FilterGroupUsers = Settings.GroupUsers
f.FilterShowGroupsInsteadLabels = Settings.ShowGroupsInsteadLabels f.FilterShowGroupsInsteadLabels = Settings.ShowGroupsInsteadLabels
f.FilterShowAllUsers = Settings.ShowAllUsers
f.Name = fName f.Name = fName
Settings.Groups.Add(f, isFilter, True) Settings.Groups.Add(f, isFilter, True)
MsgBoxE({$"The '{fName}' {IIf(isFilter, "filter", "group")} has been saved", $"Save {IIf(isFilter, "filter", "group")}"}) MsgBoxE({$"The '{fName}' {IIf(isFilter, "filter", "group")} has been saved", $"Save {IIf(isFilter, "filter", "group")}"})
@@ -825,8 +827,11 @@ CloseResume:
Settings.ViewMode.Value = .FilterViewMode Settings.ViewMode.Value = .FilterViewMode
Settings.GroupUsers.Value = .FilterGroupUsers Settings.GroupUsers.Value = .FilterGroupUsers
Settings.ShowGroupsInsteadLabels.Value = .FilterShowGroupsInsteadLabels Settings.ShowGroupsInsteadLabels.Value = .FilterShowGroupsInsteadLabels
Settings.ShowAllUsers.Value = .FilterShowAllUsers
End With End With
ApplyViewPattern(Settings.ViewMode.Value, True) ApplyViewPattern(Settings.ViewMode.Value, True)
Else
Settings.ShowAllUsers.Value = False
End If End If
Settings.AdvancedFilter.Copy(filter) Settings.AdvancedFilter.Copy(filter)
Settings.AdvancedFilter.UpdateFile() Settings.AdvancedFilter.UpdateFile()

View File

@@ -80,7 +80,6 @@ Friend Module MainMod
Friend ReadOnly SessionDateTimeProvider As New ADateTime("yyyyMMdd_HHmmss") Friend ReadOnly SessionDateTimeProvider As New ADateTime("yyyyMMdd_HHmmss")
Friend ReadOnly FeedVideoLengthProvider As New ADateTime("hh\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan} Friend ReadOnly FeedVideoLengthProvider As New ADateTime("hh\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
Friend ReadOnly LogConnector As New LogHost Friend ReadOnly LogConnector As New LogHost
Friend DefaultUserAgent As String = String.Empty
Friend SiteSettingsShowHiddenControls As Boolean = False Friend SiteSettingsShowHiddenControls As Boolean = False
#Region "NonExistingUsersLog" #Region "NonExistingUsersLog"
Friend ReadOnly NonExistingUsersLog As New TextSaver($"LOGs\NonExistingUsers.txt") With {.LogMode = True, .AutoSave = True} Friend ReadOnly NonExistingUsersLog As New TextSaver($"LOGs\NonExistingUsers.txt") With {.LogMode = True, .AutoSave = True}

View File

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

View File

@@ -54,6 +54,7 @@ Namespace Plugin.Hosts
#Region "Control" #Region "Control"
Friend Property Control As Control Friend Property Control As Control
Friend Property ControlNumber As Integer = -1 Friend Property ControlNumber As Integer = -1
Friend Property Category As String = String.Empty
Friend ReadOnly Property ControlHeight As Integer Friend ReadOnly Property ControlHeight As Integer
Get Get
If Not Control Is Nothing Then If Not Control Is Nothing Then
@@ -333,6 +334,8 @@ Namespace Plugin.Hosts
If DirectCast(Member, PropertyInfo).PropertyType Is GetType(PropertyValue) Then If DirectCast(Member, PropertyInfo).PropertyType Is GetType(PropertyValue) Then
UpdateMember() UpdateMember()
Options = Member.GetCustomAttribute(Of PropertyOption)() Options = Member.GetCustomAttribute(Of PropertyOption)()
Category = If(Options?.Category, String.Empty)
If Category.IsEmptyString Then Category = If(Member.GetCustomAttribute(Of ComponentModel.CategoryAttribute)?.Category, String.Empty)
IsTaskCounter = Not Member.GetCustomAttribute(Of TaskCounter)() Is Nothing IsTaskCounter = Not Member.GetCustomAttribute(Of TaskCounter)() Is Nothing
IsHidden = If(Member.GetCustomAttribute(Of HiddenControlAttribute)?.IsHidden, False) IsHidden = If(Member.GetCustomAttribute(Of HiddenControlAttribute)?.IsHidden, False)
With Member.GetCustomAttribute(Of PXML) With Member.GetCustomAttribute(Of PXML)

View File

@@ -219,10 +219,10 @@ Namespace Plugin.Hosts
Friend ReadOnly Property DownloadImages As XMLValue(Of Boolean) Friend ReadOnly Property DownloadImages As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadVideos As XMLValue(Of Boolean) Friend ReadOnly Property DownloadVideos As XMLValue(Of Boolean)
Private ReadOnly _Path As XMLValue(Of SFile) Private ReadOnly _Path As XMLValue(Of SFile)
Friend Property Path(Optional ByVal SetProp As Boolean = True) As SFile Friend Property Path(Optional ByVal SetProp As Boolean = True, Optional ByVal GetActualValue As Boolean = False) As SFile
Get Get
If _Path.IsEmptyString Then If Not GetActualValue And _Path.IsEmptyString Then
Dim tmpPath As SFile = SFile.GetPath($"{Settings.GlobalPath.Value.PathWithSeparator}{Source.Site}") Dim tmpPath As SFile = PathGenerate()
If SetProp Then _Path.Value = tmpPath Else Return tmpPath If SetProp Then _Path.Value = tmpPath Else Return tmpPath
End If End If
Return _Path.Value Return _Path.Value
@@ -231,6 +231,9 @@ Namespace Plugin.Hosts
_Path.Value = NewPath _Path.Value = NewPath
End Set End Set
End Property End Property
Friend Function PathGenerate() As SFile
Return SFile.GetPath($"{Settings.GlobalPath.Value.PathWithSeparator}{Source.Site}")
End Function
Friend Const SavedPostsFolderName As String = "!Saved" Friend Const SavedPostsFolderName As String = "!Saved"
Private ReadOnly _SavedPostsPath As XMLValue(Of SFile) Private ReadOnly _SavedPostsPath As XMLValue(Of SFile)
Friend Property SavedPostsPath(Optional ByVal GetAny As Boolean = True) As SFile Friend Property SavedPostsPath(Optional ByVal GetAny As Boolean = True) As SFile

View File

@@ -25,6 +25,7 @@ Namespace Plugin.Hosts
Private ReadOnly Hosts As List(Of SettingsHost) Private ReadOnly Hosts As List(Of SettingsHost)
Private ReadOnly HostsUnavailableIndexes As List(Of Integer) Private ReadOnly HostsUnavailableIndexes As List(Of Integer)
Private ReadOnly HostsXml As List(Of XmlFile) Private ReadOnly HostsXml As List(Of XmlFile)
Private Const NoPauseMode As Integer = DownloadObjects.AutoDownloader.NoPauseMode
#Region "Controls" #Region "Controls"
Private WithEvents BTT_SETTINGS As ToolStripMenuItem Private WithEvents BTT_SETTINGS As ToolStripMenuItem
Private BTT_SETTINGS_SEP_1 As ToolStripSeparator Private BTT_SETTINGS_SEP_1 As ToolStripSeparator
@@ -226,8 +227,7 @@ Namespace Plugin.Hosts
''' 1 - error ''' 1 - error
''' </summary> ''' </summary>
Private Function Hosts_Deleted_MoveAcc(ByVal Obj As SettingsHost) As Integer Private Function Hosts_Deleted_MoveAcc(ByVal Obj As SettingsHost) As Integer
Const np% = -100 Dim p As PauseModes = NoPauseMode
Dim p As PauseModes = np
Dim changedUsers As New List(Of String) Dim changedUsers As New List(Of String)
Try Try
With Settings With Settings
@@ -294,10 +294,10 @@ Namespace Plugin.Hosts
.UpdateUsersList() .UpdateUsersList()
End If End If
Else Else
p = np p = NoPauseMode
End If End If
Else Else
p = np p = NoPauseMode
End If End If
End With End With
Return 0 Return 0
@@ -309,11 +309,13 @@ Namespace Plugin.Hosts
End If End If
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, msg, 1) Return ErrorsDescriber.Execute(EDP.SendToLog, ex, msg, 1)
Finally Finally
If p <> np Then Settings.Automation.Pause = p If p <> NoPauseMode Then Settings.Automation.Pause = p
End Try End Try
End Function End Function
Friend Shared Sub UpdateUserAccount(ByRef ChangingUser As UserInfo, ByVal HostOld As SettingsHost, ByVal HostNew As SettingsHost, Friend Shared Function UpdateUserAccount(ByRef ChangingUser As UserInfo, ByVal HostOld As SettingsHost, ByVal HostNew As SettingsHost,
ByVal UpdateUserInTheList As Boolean, Optional ByRef UserIndex As Integer = -1) ByVal UpdateUserInTheList As Boolean, Optional ByRef UserIndex As Integer = -1,
Optional ByVal ForceCollections As Boolean = False) As Boolean
Dim result As Boolean = False
With Settings With Settings
UserIndex = .UsersList.IndexOf(ChangingUser) UserIndex = .UsersList.IndexOf(ChangingUser)
If UserIndex = -1 Then If UserIndex = -1 Then
@@ -322,16 +324,17 @@ Namespace Plugin.Hosts
Dim processUserPath As Boolean Dim processUserPath As Boolean
Dim samePath As Boolean = HostOld.Path(False) = HostNew.Path(False) Dim samePath As Boolean = HostOld.Path(False) = HostNew.Path(False)
With ChangingUser With ChangingUser
If Not samePath AndAlso .SpecialPath.IsEmptyString AndAlso .SpecialCollectionPath.IsEmptyString Then If (Not samePath Or ForceCollections) AndAlso .SpecialPath.IsEmptyString AndAlso .SpecialCollectionPath.IsEmptyString Then
processUserPath = False processUserPath = False
If .IncludedInCollection Then If .IncludedInCollection Then
If Not .IsVirtual Then If Not .IsVirtual Then
.SpecialCollectionPath = .GetCollectionRootPath .SpecialCollectionPath = .GetCollectionRootPath
result = True
Else Else
processUserPath = True If Not samePath Then processUserPath = True
End If End If
End If End If
If Not .IncludedInCollection Or processUserPath Then .SpecialPath = .File.CutPath.PathWithSeparator If Not .IncludedInCollection Or processUserPath Then .SpecialPath = .File.CutPath.PathWithSeparator : result = True
End If End If
End With End With
ChangingUser.AccountName = HostNew.AccountName ChangingUser.AccountName = HostNew.AccountName
@@ -339,7 +342,108 @@ Namespace Plugin.Hosts
If UpdateUserInTheList Then .UsersList(UserIndex) = ChangingUser If UpdateUserInTheList Then .UsersList(UserIndex) = ChangingUser
End If End If
End With End With
End Sub Return result
End Function
Friend Shared Function UpdateHostPath_CheckDownloader() As Boolean
If Downloader.Working Then
MsgBoxE({"You cannot change global paths while the downloader is working!", "Changing paths"}, vbCritical)
Return False
Else
Return True
End If
End Function
Friend Overloads Shared Function UpdateHostPath(ByVal PathOld As SFile, ByVal PathNew As SFile,
ByVal ColNameOld As String, ByVal ColNameNew As String) As Boolean
Dim p As PauseModes = NoPauseMode
Try
If UpdateHostPath_CheckDownloader() Then Return False
If Not AEquals(Of String)(PathOld.PathWithSeparator, PathNew.PathWithSeparator) Or Not AEquals(Of String)(ColNameOld, ColNameNew) Then
p = Settings.Automation.Pause
Settings.Automation.Pause = PauseModes.Unlimited
With Settings.Plugins
If .Count > 0 Then
Dim h As SettingsHost
For Each plugin As PluginHost In .Self
If plugin.Settings.Count > 0 Then
For Each h In plugin.Settings
If Not UpdateHostPath(h, PathOld, PathNew, False, False, Not ColNameOld = ColNameNew) Then Return False
Next
End If
Next
End If
End With
End If
Return True
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[SettingsHostCollection.UpdateHostPath]", False)
Finally
If p <> NoPauseMode Then Settings.Automation.Pause = p
End Try
End Function
Friend Overloads Shared Function UpdateHostPath(ByVal Host As SettingsHost, ByVal PathOld As SFile, ByVal PathNew As SFile,
Optional ByVal Abs As Boolean = True,
Optional ByVal PauseDownloader As Boolean = True,
Optional ByVal ForceCollections As Boolean = False) As Boolean
Dim p As PauseModes = NoPauseMode
Try
If UpdateHostPath_CheckDownloader() Then Return False
If Not PathNew.IsEmptyString And Settings.UsersList.Count > 0 Then
Dim hp As SFile = Host.Path(False, True)
Dim diffPaths As Boolean = (Abs And hp.PathWithSeparator = PathOld.PathWithSeparator) Or
(Not Abs And hp.PathWithSeparator.StartsWith(PathOld.PathWithSeparator))
If Not hp.IsEmptyString AndAlso (diffPaths Or ForceCollections) Then
If PauseDownloader Then
p = Settings.Automation.Pause
Settings.Automation.Pause = PauseModes.Unlimited
End If
Dim checkAccName As Func(Of UserInfo, Boolean) = Function(u) _
(
(Host.AccountName.IsEmptyString Or Host.AccountName = SettingsHost.NameAccountNameDefault) And
(u.AccountName.IsEmptyString Or u.AccountName = SettingsHost.NameAccountNameDefault)
) Or
(Host.AccountName = u.AccountName)
Dim tUser As UserInfo, tUserNew As UserInfo
Dim tUserBase As UserDataBase
Dim i%
Dim newHost As SettingsHost = Nothing
Dim userListUpdated As Boolean = False
For i = 0 To Settings.UsersList.Count - 1
tUser = Settings.UsersList(i)
tUserNew = tUser
If tUser.Plugin = Host.Key And checkAccName.Invoke(tUser) Then
If newHost Is Nothing Then
newHost = Host.Clone
newHost.AccountName = Host.AccountName
If Abs Then
newHost.Path = PathNew
Else
newHost.Path = $"{PathNew.PathWithSeparator}{Host.Source.Site}".CSFileP
End If
End If
If UpdateUserAccount(tUserNew, Host, newHost, False,, ForceCollections) Then
tUserBase = Settings.GetUser(tUser)
If Not tUserBase Is Nothing Then tUserBase.User = tUserNew : tUserBase.UpdateUserInformation(True)
Settings.UsersList(i) = tUserNew
userListUpdated = True
End If
End If
Next
newHost.DisposeIfReady(False)
If userListUpdated Then Settings.UpdateUsersList()
If Abs Then
Host.Path = PathNew
Else
Host.Path = $"{PathNew.PathWithSeparator}{Host.Source.Site}".CSFileP
End If
End If
End If
Return True
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[SettingsHostCollection.UpdateHostPath(HOST)]", False)
Finally
If p <> NoPauseMode Then Settings.Automation.Pause = p
End Try
End Function
#End Region #End Region
#Region "Count, Item" #Region "Count, Item"
Friend ReadOnly Property Count As Integer Implements IMyEnumerator(Of SettingsHost).MyEnumeratorCount Friend ReadOnly Property Count As Integer Implements IMyEnumerator(Of SettingsHost).MyEnumeratorCount

View File

@@ -173,6 +173,19 @@
<Compile Include="API\Base\M3U8Base.vb" /> <Compile Include="API\Base\M3U8Base.vb" />
<Compile Include="API\Base\ProfileSaved.vb" /> <Compile Include="API\Base\ProfileSaved.vb" />
<Compile Include="API\Base\SiteSettingsBase.vb" /> <Compile Include="API\Base\SiteSettingsBase.vb" />
<Compile Include="API\Base\SplitCollectionUserInfo.vb" />
<Compile Include="API\Base\SplitCollectionUserInfoChangePathsForm.Designer.vb">
<DependentUpon>SplitCollectionUserInfoChangePathsForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoChangePathsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoPathForm.Designer.vb">
<DependentUpon>SplitCollectionUserInfoPathForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoPathForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Base\Structures.vb" /> <Compile Include="API\Base\Structures.vb" />
<Compile Include="API\Base\TokenBatch.vb" /> <Compile Include="API\Base\TokenBatch.vb" />
<Compile Include="API\Base\YTDLP.vb" /> <Compile Include="API\Base\YTDLP.vb" />
@@ -518,6 +531,12 @@
<EmbeddedResource Include="API\BaseObjects\InternalSettingsForm.resx"> <EmbeddedResource Include="API\BaseObjects\InternalSettingsForm.resx">
<DependentUpon>InternalSettingsForm.vb</DependentUpon> <DependentUpon>InternalSettingsForm.vb</DependentUpon>
</EmbeddedResource> </EmbeddedResource>
<EmbeddedResource Include="API\Base\SplitCollectionUserInfoChangePathsForm.resx">
<DependentUpon>SplitCollectionUserInfoChangePathsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Base\SplitCollectionUserInfoPathForm.resx">
<DependentUpon>SplitCollectionUserInfoPathForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\OnlyFans\OFResources.resx"> <EmbeddedResource Include="API\OnlyFans\OFResources.resx">
<CustomToolNamespace>My.Resources</CustomToolNamespace> <CustomToolNamespace>My.Resources</CustomToolNamespace>
<Generator>ResXFileCodeGenerator</Generator> <Generator>ResXFileCodeGenerator</Generator>

View File

@@ -54,6 +54,14 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
a.Invoke(CurlFile) a.Invoke(CurlFile)
Plugins.ForEach(Sub(p) p.Settings.UpdateEnvironmentPrograms(EnvironmentProgramsList, CMDEncoding.Value)) Plugins.ForEach(Sub(p) p.Settings.UpdateEnvironmentPrograms(EnvironmentProgramsList, CMDEncoding.Value))
End Sub End Sub
Friend Sub UpdatePluginsUserAgent(Optional ByVal InvokeUpdate As Boolean = True)
If Not UserAgent.IsEmptyString Then
If InvokeUpdate Then BeginUpdate()
Dim __userAgent$ = UserAgent
Plugins.ForEach(Sub(p) p.Settings.ListForEach(Sub(ps, psi) ps.Source.UserAgentDefault = __userAgent))
If InvokeUpdate Then EndUpdate()
End If
End Sub
Friend Class ProgramFile Friend Class ProgramFile
Friend Const File_FFMPEG As String = "ffmpeg.exe" Friend Const File_FFMPEG As String = "ffmpeg.exe"
Friend Const File_YTDLP As String = "yt-dlp.exe" Friend Const File_YTDLP As String = "yt-dlp.exe"
@@ -244,7 +252,6 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
MaxUsersJobsCount = New XMLValue(Of Integer)("MaxJobsCount", DefaultMaxDownloadingTasks, MyXML, n) MaxUsersJobsCount = New XMLValue(Of Integer)("MaxJobsCount", DefaultMaxDownloadingTasks, MyXML, n)
UserAgent = New XMLValue(Of String)("UserAgent",, MyXML, n) UserAgent = New XMLValue(Of String)("UserAgent",, MyXML, n)
If Not SettingsReoranized Then UserAgent.Value = New XMLValue(Of String)("UserAgent",, MyXML).Value 'URGENT: remove this line If Not SettingsReoranized Then UserAgent.Value = New XMLValue(Of String)("UserAgent",, MyXML).Value 'URGENT: remove this line
If Not UserAgent.IsEmptyString Then DefaultUserAgent = UserAgent
ImgurClientID = New XMLValue(Of String)("ImgurClientID", String.Empty, MyXML, {Name_Node_Sites}) ImgurClientID = New XMLValue(Of String)("ImgurClientID", String.Empty, MyXML, {Name_Node_Sites})
'Basis: new version 'Basis: new version
@@ -462,6 +469,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Plugins.AddRange(tmpPluginList) Plugins.AddRange(tmpPluginList)
End If End If
UpdateEnvironmentPrograms() UpdateEnvironmentPrograms()
UpdatePluginsUserAgent(False)
#End Region #End Region
Labels = New LabelsKeeper(MyXML) Labels = New LabelsKeeper(MyXML)
@@ -1001,7 +1009,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property CollectionsPathF As SFile Friend ReadOnly Property CollectionsPathF As SFile
Get Get
If GlobalPath.IsEmptyString Then If GlobalPath.IsEmptyString Then
Throw New ArgumentNullException("GlobalPath", "GlobalPath not set") Throw New ArgumentNullException("GlobalPath", "Global path not set")
Else Else
Return SFile.GetPath($"{GlobalPath.Value.PathWithSeparator}{CollectionsPath.Value}") Return SFile.GetPath($"{GlobalPath.Value.PathWithSeparator}{CollectionsPath.Value}")
End If End If