geonu/SCrawler
1
0
Fork 0
mirror of https://github.com/AAndyProgram/SCrawler.git synced 2026-03-14 15:52:18 +00:00
Code Issues Packages Projects Releases Wiki Activity

2024.5.18.0

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

31
Changelog.md
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-05-04*
@@ -5,13 +32,13 @@
- Added
- YouTube (standalone app): setting to remove specific characters (`Defaults` - `Remove characters`)
- Instagram: simplify the `Connection closed` error
- Users search: add 'FriendlyName' to search results
- Users search: add `Friendly name` to search results
- Fixed
- 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
- Sites
- Reddit: token update error
- Threads: unable to obtain credentials (ID)
- Threads: unable to obtain credentials (`ID`)
# 2024.4.26.0

BIN
ProgramScreenshots/SettingsSiteFacebook.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 26 KiB

BIN
ProgramScreenshots/SettingsSiteInstagram.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 35 KiB

After

Width:  |  Height:  |  Size: 40 KiB

BIN
ProgramScreenshots/SettingsSiteMastodon.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 24 KiB

BIN
ProgramScreenshots/SettingsSiteOnlyFans.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 29 KiB

After

Width:  |  Height:  |  Size: 30 KiB

BIN
ProgramScreenshots/SettingsSiteRedGifs.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 16 KiB

BIN
ProgramScreenshots/SettingsSiteThreads.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 24 KiB

After

Width:  |  Height:  |  Size: 25 KiB

BIN
ProgramScreenshots/SettingsSiteTwitter.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 25 KiB

16
SCrawler.PluginProvider/Attributes/Attributes.vb
View File

@@ -36,8 +36,22 @@ Namespace Plugin.Attributes
Public Property IsInformationLabel As Boolean = False
''' <summary>Label text alignment.<br/>Default: <see cref="Drawing.ContentAlignment.TopCenter"/></summary>
Public Property LabelTextAlign As Drawing.ContentAlignment = Drawing.ContentAlignment.TopCenter
Private _IsAuth As Boolean = False
''' <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 InheritanceName As String = Nothing
''' <summary>Initialize a new property option attribute</summary>

1
SCrawler.PluginProvider/Interfaces/ISiteSettings.vb
View File

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

4
SCrawler.PluginProvider/My Project/AssemblyInfo.vb
View File

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

6
SCrawler.YouTube/Base/YouTubeSettings.vb
View File

@@ -361,6 +361,12 @@ Namespace API.YouTube.Base
Throw New NotImplementedException("'GetFormat' is not available in 'FpsFormatProvider'")
End Function
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
#Region "Defaults Audio"
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"),

5
SCrawler.YouTube/Controls/VideoOption.vb
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 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 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
Dim sv% = m.Size / 1024

4
SCrawler.YouTube/My Project/AssemblyInfo.vb
View File

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

4
SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb
View File

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

3
SCrawler/API/Base/DeclaredNames.vb
View File

@@ -11,6 +11,9 @@ Namespace API.Base
Friend Const Header_Authorization As String = "authorization"
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 ConcurrentDownloadsToolTip As String = "The number of concurrent downloads."
Friend Const SavedPostsUserNameCaption As String = "Saved posts user"

2
SCrawler/API/Base/IUserData.vb
View File

@@ -77,7 +77,7 @@ Namespace API.Base
''' </summary>
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 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
Sub OpenFolder()
Property DownloadTopCount As Integer?

11
SCrawler/API/Base/SiteSettingsBase.vb
View File

@@ -34,6 +34,16 @@ Namespace API.Base
Friend Property AccountName As String Implements ISiteSettings.AccountName
Friend Property Temporary As Boolean = False Implements ISiteSettings.Temporary
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 _SubscriptionsAllowed As Boolean = False
Friend ReadOnly Property SubscriptionsAllowed As Boolean Implements ISiteSettings.SubscriptionsAllowed
@@ -138,7 +148,6 @@ Namespace API.Base
Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit
End Sub
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)
End Sub
#End Region

28
SCrawler/API/Base/SplitCollectionUserInfo.vb Normal file
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

111
SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.Designer.vb generated Normal file
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

129
SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.resx Normal file
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>

78
SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.vb Normal file
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

134
SCrawler/API/Base/SplitCollectionUserInfoPathForm.Designer.vb generated Normal file
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

154
SCrawler/API/Base/SplitCollectionUserInfoPathForm.resx Normal file
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>

68
SCrawler/API/Base/SplitCollectionUserInfoPathForm.vb Normal file
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

21
SCrawler/API/Base/UserDataBase.vb
View File

@@ -950,7 +950,10 @@ BlockNullPicture:
LogError(ex, "user information loading error")
End Try
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
UpdateDataFiles()
MyFileSettings.Exists(SFO.Path)
@@ -1001,7 +1004,7 @@ BlockNullPicture:
x.Save(MyFileSettings)
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
LogError(ex, "user information saving error")
End Try
@@ -1934,7 +1937,18 @@ BlockNullPicture:
Return 0
End If
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 Removed As Boolean = True
Dim _TurnBack As Boolean = False
@@ -1950,6 +1964,7 @@ BlockNullPicture:
User.SpecialCollectionPath = String.Empty
User.UserModel = UsageModel.Default
User.CollectionModel = UsageModel.Default
If NewUser.HasValue Then User.SpecialPath = NewUser.Value.UserNew.SpecialPath
Else
Settings.Users.Remove(Me)
Removed = True

7
SCrawler/API/Facebook/SiteSettings.vb
View File

@@ -11,6 +11,7 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Facebook
<Manifest("AndyProgram_Facebook"), SavedPosts, SeparatedTasks(1), SpecialForm(False)>
Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings
@@ -31,11 +32,11 @@ Namespace API.Facebook
End Property
#End Region
#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
<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
<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
#End Region
#End Region

132
SCrawler/API/Instagram/SiteSettings.vb
View File

@@ -14,6 +14,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -54,6 +55,9 @@ Namespace API.Instagram
End Function
End Class
#End Region
#Region "Categories"
Private Const CAT_DOWN As String = "Download data"
#End Region
#Region "Authorization properties"
Friend Const Header_IG_APP_ID As String = "x-ig-app-id"
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
#End Region
#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."
<PropertyOption(ControlText:="Request timer (any)",
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>
Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue
<Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)>
@@ -154,33 +167,33 @@ Namespace API.Instagram
<PropertyOption(ControlText:="Request timer",
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,
AllowNull:=False), PXML, ControlNumber(20), PClonable>
AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(20), PClonable>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter",
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,
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
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer",
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,
AllowNull:=False), PXML, ControlNumber(22), PClonable>
AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(22), PClonable>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
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
<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
<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
<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
<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
<PropertyOption(ControlText:="Tagged notify limit",
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
#End Region
#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
<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
<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
<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
<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
<PXML> Private ReadOnly Property DownloadTagged_Def As PropertyValue
#End Region
@@ -352,8 +365,11 @@ Namespace API.Instagram
platform = .Value(Header_Platform_Verion)
End If
'.Add(Header_IG_WWW_CLAIM, 0)
.Add("Origin", "https://www.instagram.com")
.Add("authority", "www.instagram.com")
.Add("Dnt", 1)
.Add("Dpr", 1)
'.Add("Dpr", 1)
.Remove("Dpr")
.Add("Sec-Ch-Ua-Mobile", "?0")
.Add("Sec-Ch-Ua-Model", """""")
.Add("Sec-Ch-Ua-Platform", """Windows""")
@@ -396,6 +412,9 @@ Namespace API.Instagram
DownloadTagged = New PropertyValue(False)
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_AnyProvider = New TimersChecker(0)
RequestsWaitTimer = New PropertyValue(1000)
@@ -413,7 +432,7 @@ Namespace API.Instagram
TaggedNotifyLimit = New PropertyValue(200)
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))
LastRequestsCount = New PropertyValue(0)
LastRequestsCountLabel = New PropertyValue(String.Empty, GetType(String))
@@ -456,16 +475,85 @@ Namespace API.Instagram
End Function
#End Region
#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 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
Private ActiveJobs As Integer = 0
Private ActiveSessionDate As Date
Private ActiveSessionRequestsExists As Boolean = False
Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download)
If ActiveJobs = 0 Then ActiveSessionRequestsExists = False
ActiveJobs += 1
If What = Download.Main Then ____DownloadStarted = True
If ActiveJobs = 1 Then ActiveSessionDate = Now
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
_NextTagged = .TaggedCheckSession
MyLastRequestsCount = .RequestsCountSession
If .RequestsCountSession > 0 Then ActiveSessionRequestsExists = True
_FieldsChangerSuspended = True
HH_IG_WWW_CLAIM.Value = Responser.Headers.Value(Header_IG_WWW_CLAIM)
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)
_NextWNM = UserData.WNM.Notify
_NextTagged = True
RefreshMyLastRequests(Now)
If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
ActiveJobs -= 1
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 Region
#Region "Settings"

22
SCrawler/API/Instagram/UserData.vb
View File

@@ -862,15 +862,20 @@ NextPageBlock:
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}/"
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,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) As Boolean
ThrowAny(Token)
If Items.Count > 0 Then
If Items.ListExists Then
Dim PostIDKV As PostKV
Dim Pinned As Boolean
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
Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder
@@ -879,14 +884,21 @@ NextPageBlock:
End Select
End If
ProgressPre.ChangeMax(Items.Count)
For Each nn In Items
For i = 0 To Items.Count - 1
nn = Items(i)
ProgressPre.Perform()
With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn)
If .ListExists Then
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV)
Pinned = .Contains("timeline_pinned_user_ids")
If Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
'Pinned = .Contains("timeline_pinned_user_ids")
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
Else
_TempPostsList.Add(PostIDKV.ID)

1
SCrawler/API/Mastodon/EditorExchangeOptions.vb
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 DownloadModelSearch 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)
MyBase.New(s)
End Sub

8
SCrawler/API/Mastodon/SiteSettings.vb
View File

@@ -63,15 +63,15 @@ Namespace API.Mastodon
End Sub
#End Region
#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
<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
<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
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
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
<PropertyOption(IsAuth:=False, ControlText:="User related to my domain",
ControlToolTip:="Open user profiles and user posts through my domain."), PXML, PClonable>

37
SCrawler/API/OnlyFans/SiteSettings.vb
View File

@@ -13,18 +13,22 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.OnlyFans
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Categories"
Private Const CAT_OFS As String = "OF-Scraper support"
#End Region
#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
<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
<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
<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
#End Region
#Region "Headers"
@@ -32,16 +36,16 @@ Namespace API.OnlyFans
Private Const HeaderUserID As String = "User-Id"
Friend Const HeaderXBC As String = "X-Bc"
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
<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
<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
<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
<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
Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String)
Dim hName$ = String.Empty
@@ -82,20 +86,21 @@ Namespace API.OnlyFans
End Property
<PropertyOption(ControlText:="Use old authorization rules",
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
<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
<Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider
<PropertyOption(ControlText:="Dynamic rules",
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
#End Region
#Region "OFScraper"
<PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'")>
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'", Category:=CAT_OFS)>
Friend ReadOnly Property OFScraperPath As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
@@ -106,7 +111,7 @@ Namespace API.OnlyFans
End Get
End Property
<PClonable, PXML("OFScraperMP4decrypt")> Private ReadOnly Property OFScraperMP4decrypt_XML As PropertyValue
<PropertyOption(ControlText:="mp4decrypt path", ControlToolTip:="The path to the 'mp4decrypt.exe'")>
<PropertyOption(ControlText:="mp4decrypt path", ControlToolTip:="The path to the 'mp4decrypt.exe'", Category:=CAT_OFS)>
Friend ReadOnly Property OFScraperMP4decrypt As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
@@ -118,7 +123,7 @@ Namespace API.OnlyFans
End Property
Friend Const KeyModeDefault_Default As String = "cdrm"
<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
Get
If Not DefaultInstance Is Nothing Then
@@ -134,6 +139,8 @@ Namespace API.OnlyFans
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)
_AllowUserAgentUpdate = False
With Responser
.Accept = "application/json, text/plain, */*"
.AutomaticDecompression = Net.DecompressionMethods.GZip

10
SCrawler/API/Reddit/M3U8.vb
View File

@@ -8,6 +8,7 @@
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.M3U8_Declarations
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
@@ -61,15 +62,18 @@ Namespace API.Reddit
Private ReadOnly ProgressExists As Boolean
Private ReadOnly Property ProgressPre As PreProgress
Private ReadOnly UsePreProgress As Boolean
Private ReadOnly Media As UserMedia
#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
Me.Media = Media
BaseURL = RegexReplace(URL, BaseUrlPattern)
Video = New List(Of String)
Audio = New List(Of String)
Me.OutFile = OutFile
Me.OutFile.Name = "PlayListFile"
Me.OutFile.Extension = "mp4"
If Media.Post.Date.HasValue Then Me.OutFile.Name = Media.Post.Date.Value.ToString("yyyyMMdd_HHmmss")
Me.Progress = Progress
ProgressExists = Not Me.Progress Is Nothing
ProgressPre = New PreProgress(Progress)
@@ -202,9 +206,9 @@ Namespace API.Reddit
End Function
#End Region
#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
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 Region
#Region "IDisposable Support"

1
SCrawler/API/Reddit/SiteSettings.vb
View File

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

20
SCrawler/API/Reddit/UserData.vb
View File

@@ -225,6 +225,7 @@ Namespace API.Reddit
#End Region
#Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
Err429Count = 0
_CrossPosts.Clear()
If CreatedByChannel And Settings.FromChannelDownloadTopUse And Settings.FromChannelDownloadTop > 0 Then _
DownloadTopCount = Settings.FromChannelDownloadTop.Value
@@ -287,6 +288,7 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Download Functions (User, Channel)"
Private Err429Count As Integer = 0
Private _TotalPostsDownloaded As Integer = 0
Private ReadOnly _CrossPosts As List(Of String)
Private Const SiteGfycatKey As String = "gfycat"
@@ -375,6 +377,7 @@ Namespace API.Reddit
Loop While Not _completed
End Sub
Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken)
Const savedPostsSleepTimer% = 2000
Dim eObj% = 0
Dim round% = 0
Dim URL$ = String.Empty
@@ -392,12 +395,14 @@ Namespace API.Reddit
If IsSavedPosts Then
URL = $"https://www.reddit.com/user/{TrueName}/saved.json?after={POST}"
If Not POST.IsEmptyString Then Thread.Sleep(savedPostsSleepTimer)
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"
End If
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If IsSavedPosts Then Err429Count = 0
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then
@@ -458,8 +463,12 @@ Namespace API.Reddit
End If
_completed = True
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
ElseIf errValue = 429 And round = 0 Then
Thread.Sleep(savedPostsSleepTimer)
round += 1
Else
_completed = True
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}}
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 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
End Function
Private Function TryFile(ByVal URL As String) As Boolean
@@ -1027,7 +1036,7 @@ Namespace API.Reddit
Return URL.Contains(SiteRedGifsKey)
End Function
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
Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
If Not IsChannel Or Not SaveToCache Then
@@ -1057,8 +1066,11 @@ Namespace API.Reddit
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError
ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then
Err429Count += 1
Return 429
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
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")

8
SCrawler/API/Redgifs/SiteSettings.vb
View File

@@ -18,9 +18,9 @@ Namespace API.RedGifs
<Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#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
<PropertyOption, ControlNumber(2), PClonable>
<PropertyOption, ControlNumber(2), PClonable, HiddenControl>
Private ReadOnly Property UserAgent As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization"
@@ -107,7 +107,9 @@ Namespace API.RedGifs
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then
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
MyBase.Update()
End Sub

5
SCrawler/API/ThreadsNet/SiteSettings.vb
View File

@@ -13,6 +13,7 @@ Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Imports IG = SCrawler.API.Instagram.SiteSettings
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.ThreadsNet
<Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -75,14 +76,14 @@ Namespace API.ThreadsNet
#Region "Other properties"
<PropertyOption(ControlText:="Request timer (any)",
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>
Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue
<Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider
<PropertyOption(ControlText:="Download data",
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
#End Region
#End Region

52
SCrawler/API/ThreadsNet/UserData.vb
View File

@@ -17,6 +17,10 @@ Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports IGS = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet
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"
Private ReadOnly Property MySettings As SiteSettings
Get
@@ -29,9 +33,20 @@ Namespace API.ThreadsNet
Return ValidateBaseTokens() And Not ID.IsEmptyString
End Get
End Property
Private Property MaxLastDownDate As Date? = Nothing
Private Property FirstLoadingDone As Boolean = False
#End Region
#Region "Loader"
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 Region
#Region "Exchange"
@@ -49,6 +64,7 @@ Namespace API.ThreadsNet
DefaultParser_PostUrlCreator = Function(post) $"https://www.threads.net/@{NameTrue}/post/{post.Code}"
_ResponserAutoUpdateCookies = True
_ResponserAddResponseReceivedHandler = True
DefaultParser_Pinned = AddressOf IsPinnedPost
End Sub
#End Region
#Region "Download functions"
@@ -66,7 +82,27 @@ Namespace API.ThreadsNet
Responser.Method = "POST"
LoadSavePostsKV(True)
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)
If _TempMediaList.Count > 0 Then FirstLoadingDone = True : setMaxPostDate.Invoke(_TempMediaList)
Catch ex As Exception
errorFound = True
Throw ex
@@ -78,6 +114,21 @@ Namespace API.ThreadsNet
End Try
End If
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()
If Not Responser Is Nothing AndAlso Not Responser.Disposed Then
RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
@@ -166,7 +217,6 @@ Namespace API.ThreadsNet
With .Headers
.Clear()
.Add("dnt", 1)
.Add("drp", 1)
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.threads.net"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.threads.net"))
.Add("Sec-Ch-Ua-Model", "")

1
SCrawler/API/Twitter/Declarations.vb
View File

@@ -15,6 +15,7 @@ Namespace API.Twitter
Friend Const TwitterSiteKey As String = "AndyProgram_Twitter"
Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
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
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"

11
SCrawler/API/Twitter/EditorExchangeOptions.vb
View File

@@ -28,16 +28,20 @@ Namespace API.Twitter
Friend Overridable Property MediaModelAllowNonUserTweets As Boolean = False
<PSetting(Address:=SettingAddress.User,
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
<PSetting(Address:=SettingAddress.User,
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
<PSetting(Address:=SettingAddress.User,
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
<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,
Caption:="Force apply",
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)
DownloadModelProfile = dm.Contains(DModels.Profile)
DownloadModelSearch = dm.Contains(DModels.Search)
DownloadModelLikes = dm.Contains(DModels.Likes)
End If
End If
MySettings = u.HOST.Source

33
SCrawler/API/Twitter/SiteSettings.vb
View File

@@ -16,32 +16,37 @@ Namespace API.Twitter
<Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Categories"
Private Const CAT_DOWN As String = "Downloading"
#End Region
#Region "Other properties"
<PropertyOption(ControlText:="Use the appropriate model",
ControlToolTip:="Use the appropriate model for new users." & vbCr &
"If disabled, all download models will be used for the first download. " &
"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
#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
<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
#End Region
#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
<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
#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
<PropertyOption(ControlText:=DN.GifsDownloadCaption), PXML, PClonable>
<PropertyOption(ControlText:=DN.GifsDownloadCaption, Category:=DN.CAT_UserDefs), PXML, PClonable>
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
<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
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
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]")
End Function
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
<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
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider
#End Region
#End Region
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)
@@ -97,7 +102,7 @@ Namespace API.Twitter
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "/(twitter|x).com/"), 2)
UrlPatternUser = "https://twitter.com/{0}"
UrlPatternUser = "https://x.com/{0}"
ImageVideoContains = "twitter"
CheckNetscapeCookiesOnEndInit = True
UseNetscapeCookies = True
@@ -106,7 +111,7 @@ Namespace API.Twitter
Return New UserData
End Function
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
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists

139
SCrawler/API/Twitter/UserData.vb
View File

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

49
SCrawler/API/UserDataBind.vb
View File

@@ -558,7 +558,7 @@ Namespace API
End Sub
#End Region
#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")
End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
@@ -601,7 +601,19 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical)
Return False
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)
AddRemoveBttDeleteHandler(_Item, False)
RaiseEvent OnUserRemoved(_Item)
@@ -618,7 +630,7 @@ Namespace API
End If
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,
{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 {
.ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr &
"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)
Return 0
Else
Collections.ForEach(Sub(ByVal c As IUserData)
If c.MoveFiles(String.Empty, Nothing) Then
UserListLoader.UpdateUser(Settings.GetUser(c), True)
MainFrameObj.ImageHandler(c)
End If
End Sub)
Dim uu As New List(Of SplitCollectionUserInfo)(Collections.Select(Function(uuu As UserDataBase) uuu.SplitCollectionGetNewUserInfo))
If uu.All(Function(uuu) uuu.SameDrive) Then
uu.Clear()
Else
Using colPaths As New SplitCollectionUserInfoChangePathsForm(uu)
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
Settings.Users.Remove(Me)
Collections.Clear()

1
SCrawler/Download/Automation/AutoDownloader.vb
View File

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

22
SCrawler/Download/Automation/AutoDownloaderEditorForm.Designer.vb generated
View File

@@ -28,9 +28,10 @@ Namespace DownloadObjects
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 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 TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
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
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
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.Name = "Edit"
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(ActionButton2)
Me.TXT_GROUPS.Buttons.Add(ActionButton3)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
@@ -260,9 +266,9 @@ Namespace DownloadObjects
'
'TXT_TIMER
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3)
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton4)
Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
@@ -275,9 +281,9 @@ Namespace DownloadObjects
'
'NUM_DELAY
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4)
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton5)
Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay"

44
SCrawler/Download/Automation/AutoDownloaderEditorForm.resx
View File

@@ -189,6 +189,18 @@
</value>
</data>
<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>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -203,22 +215,6 @@
<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.
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 name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
@@ -234,6 +230,22 @@ The 'Image' and 'User icon' parameters will be ignored.</value>
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
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>
</data>
</root>

17
SCrawler/Download/Automation/AutoDownloaderEditorForm.vb
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
Select Case Sender.DefaultButton
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()
If f.DialogResult = DialogResult.OK Then MyGroups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : TXT_GROUPS.Text = MyGroups.ListToString
End Using
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 Sub
Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged,

68
SCrawler/Download/Automation/SchedulerEditorForm.vb
View File

@@ -8,6 +8,8 @@
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools
Imports ECI = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
@@ -235,6 +237,25 @@ Namespace DownloadObjects
Private Function GetSchedulerFiles() As List(Of SFile)
Return SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue)
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
Const msgTitle$ = "Change scheduler"
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)))
End With
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",
.Icon = ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue),
.FormText = "Schedulers",
@@ -256,17 +277,56 @@ Namespace DownloadObjects
Dim f As SFile
Dim selectedName$
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()
.Buttons = {ADB.Add, ADB.Delete}
.Buttons = {ADB.Add, ADB.SaveAs, ADB.Delete}
AddHandler .AddClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs)
If addedObj.IsEmptyString Then
addedObj = InputBoxE("Enter a new scheduler name:", msgTitle)
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
MsgBoxE({"You can only create one scheduler at a time", "Create a new scheduler"}, vbCritical)
End If
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
.DataSelectedIndexes.Add(0)
Else
@@ -279,7 +339,7 @@ Namespace DownloadObjects
If selectedName = defName Then
f = Settings.Automation.FileDefault
Else
f = $"{SettingsFolderName}\{Scheduler.FileNameDefault}_{selectedName.StringRemoveWinForbiddenSymbols}.xml"
f = createSchedulerPath.Invoke(selectedName)
End If
If Not Settings.Automation.File = f AndAlso Settings.Automation.Reset(f, False) Then
Settings.Automation.File = f

7
SCrawler/Download/Groups/DownloadGroup.vb
View File

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

2
SCrawler/Download/Groups/GroupListForm.vb
View File

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

23
SCrawler/Editors/GlobalSettingsForm.vb
View File

@@ -19,6 +19,7 @@ Namespace Editors
Friend Property HeadersChanged As Boolean = False
Friend Property PictureChanged As Boolean = False
Friend Property EnvironmentProgramsChanged As Boolean = False
Friend Property UserAgentChanged As Boolean = False
Friend Sub New()
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
@@ -183,6 +184,7 @@ Namespace Editors
"Do you really want to continue?",
"Increasing download tasks"},
vbExclamation,,, {"Confirm", $"Set to default ({SettingsCLS.DefaultMaxDownloadingTasks})", "Cancel"})
If CInt(TXT_MAX_JOBS_USERS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then
Select Case a.Invoke("users", TXT_MAX_JOBS_USERS.Value)
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.",
"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
.BeginUpdate()
@@ -225,7 +246,7 @@ Namespace Editors
.ChannelsMaxJobsCount.Value = TXT_MAX_JOBS_CHANNELS.Value
.CheckUpdatesAtStart.Value = CH_CHECK_VER_START.Checked
.UserAgent.Value = TXT_USER_AGENT.Text
DefaultUserAgent = TXT_USER_AGENT.Text
UserAgentChanged = .UserAgent.ChangesDetected
.ImgurClientID.Value = TXT_IMGUR_CLIENT_ID.Text
'Design
.ProgramText.Value = TXT_PRG_TITLE.Text

27
SCrawler/Editors/LabelsForm.vb
View File

@@ -27,6 +27,7 @@ Friend Class LabelsForm
End Property
Friend Property WithDeleteButton 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)
InitializeComponent()
Me.AddNoParsed = AddNoParsed
@@ -65,7 +66,15 @@ Friend Class LabelsForm
End Try
End Sub
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
Private Sub LabelsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
LabelsList.Clear()
@@ -101,4 +110,20 @@ Friend Class LabelsForm
End If
End If
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

161
SCrawler/Editors/SiteEditorForm.vb
View File

@@ -7,6 +7,7 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls
@@ -15,13 +16,13 @@ Imports PersonalUtilities.Tools.Web.Cookies
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace Editors
Friend Class SiteEditorForm
Private ReadOnly LBL_AUTH As Label
Private ReadOnly LBL_OTHER As Label
Private WithEvents MyDefs As DefaultFormOptions
Private WithEvents SpecialButton As Button
Private Property Cookies As CookieKeeper
Private ReadOnly CookiesControlsInteraction As List(Of PropertyValueHost)
Private CookiesChanged As Boolean = False
Private Const OtherOptionsText As String = "Other Parameters"
Private ReadOnly LabelControls As List(Of Label)
#Region "Providers"
Private Class SavedPostsChecker : Inherits AccountsNameChecker
Friend ReadOnly PathControl As TextBoxExtended
@@ -138,6 +139,108 @@ Namespace Editors
Return Nothing
End Function
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
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
@@ -148,8 +251,7 @@ Namespace Editors
Host = h
CookiesControlsInteraction = New List(Of PropertyValueHost)
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}
LBL_OTHER = New Label With {.Text = "Other Parameters", .TextAlign = ContentAlignment.MiddleCenter, .Dock = DockStyle.Fill}
LabelControls = New List(Of Label)
Host.BeginEdit()
End Sub
Private Sub SiteEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
@@ -191,13 +293,6 @@ Namespace Editors
Dim offset% = PropertyValueHost.LeftOffsetDefault
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
h -= 28
@@ -214,41 +309,17 @@ Namespace Editors
Dim laAdded 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()
For Each pAuth As Boolean In pArr
Using pc As New CatReorder
For Each prop As PropertyValueHost In .PropList
If PropertyValid.Invoke(prop) Then
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
If PropertyValid.Invoke(prop) Then pc.Add(prop)
Next
Next
If pc.Count > 0 Then pc.AddToTable(Me, h, c, offset)
End Using
End If
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)
offset += PaddingE.GetOf({TP_SITE_PROPS}).Left
TXT_PATH.CaptionWidth = offset
@@ -290,8 +361,7 @@ Namespace Editors
If Host.PropList.Count > 0 Then Host.PropList.ForEach(Sub(p) p.DisposeControl())
If Not SpecialButton Is Nothing Then SpecialButton.Dispose()
CookiesControlsInteraction.Clear()
LBL_AUTH.Dispose()
LBL_OTHER.Dispose()
LabelControls.ListClearDispose
Host.EndEdit()
If Not Cookies Is Nothing Then Cookies.Dispose()
End Sub
@@ -317,6 +387,13 @@ Namespace Editors
Next
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)
If TXT_PATH.IsEmptyString Then .Path = Nothing Else .Path = TXT_PATH.Text
.SavedPostsPath = TXT_PATH_SAVED_POSTS.Text

9
SCrawler/MainFrame.vb
View File

@@ -325,9 +325,10 @@ CloseResume:
TrayIcon.Visible = .CloseToTray
If f.EnvironmentProgramsChanged Then Settings.UpdateEnvironmentPrograms()
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.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()
End If
UpdateSilentButtons()
@@ -781,6 +782,7 @@ CloseResume:
f.FilterViewMode = Settings.ViewMode
f.FilterGroupUsers = Settings.GroupUsers
f.FilterShowGroupsInsteadLabels = Settings.ShowGroupsInsteadLabels
f.FilterShowAllUsers = Settings.ShowAllUsers
f.Name = fName
Settings.Groups.Add(f, isFilter, True)
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.GroupUsers.Value = .FilterGroupUsers
Settings.ShowGroupsInsteadLabels.Value = .FilterShowGroupsInsteadLabels
Settings.ShowAllUsers.Value = .FilterShowAllUsers
End With
ApplyViewPattern(Settings.ViewMode.Value, True)
Else
Settings.ShowAllUsers.Value = False
End If
Settings.AdvancedFilter.Copy(filter)
Settings.AdvancedFilter.UpdateFile()

1
SCrawler/MainMod.vb
View File

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

4
SCrawler/My Project/AssemblyInfo.vb
View File

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

3
SCrawler/PluginsEnvironment/Hosts/PropertyValueHost.vb
View File

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

9
SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb
View File

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

126
SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb
View File

@@ -25,6 +25,7 @@ Namespace Plugin.Hosts
Private ReadOnly Hosts As List(Of SettingsHost)
Private ReadOnly HostsUnavailableIndexes As List(Of Integer)
Private ReadOnly HostsXml As List(Of XmlFile)
Private Const NoPauseMode As Integer = DownloadObjects.AutoDownloader.NoPauseMode
#Region "Controls"
Private WithEvents BTT_SETTINGS As ToolStripMenuItem
Private BTT_SETTINGS_SEP_1 As ToolStripSeparator
@@ -226,8 +227,7 @@ Namespace Plugin.Hosts
''' 1 - error
''' </summary>
Private Function Hosts_Deleted_MoveAcc(ByVal Obj As SettingsHost) As Integer
Const np% = -100
Dim p As PauseModes = np
Dim p As PauseModes = NoPauseMode
Dim changedUsers As New List(Of String)
Try
With Settings
@@ -294,10 +294,10 @@ Namespace Plugin.Hosts
.UpdateUsersList()
End If
Else
p = np
p = NoPauseMode
End If
Else
p = np
p = NoPauseMode
End If
End With
Return 0
@@ -309,11 +309,13 @@ Namespace Plugin.Hosts
End If
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, msg, 1)
Finally
If p <> np Then Settings.Automation.Pause = p
If p <> NoPauseMode Then Settings.Automation.Pause = p
End Try
End Function
Friend Shared Sub UpdateUserAccount(ByRef ChangingUser As UserInfo, ByVal HostOld As SettingsHost, ByVal HostNew As SettingsHost,
ByVal UpdateUserInTheList As Boolean, Optional ByRef UserIndex As Integer = -1)
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,
Optional ByVal ForceCollections As Boolean = False) As Boolean
Dim result As Boolean = False
With Settings
UserIndex = .UsersList.IndexOf(ChangingUser)
If UserIndex = -1 Then
@@ -322,16 +324,17 @@ Namespace Plugin.Hosts
Dim processUserPath As Boolean
Dim samePath As Boolean = HostOld.Path(False) = HostNew.Path(False)
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
If .IncludedInCollection Then
If Not .IsVirtual Then
.SpecialCollectionPath = .GetCollectionRootPath
result = True
Else
processUserPath = True
If Not samePath Then processUserPath = True
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 With
ChangingUser.AccountName = HostNew.AccountName
@@ -339,7 +342,108 @@ Namespace Plugin.Hosts
If UpdateUserInTheList Then .UsersList(UserIndex) = ChangingUser
End If
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
#Region "Count, Item"
Friend ReadOnly Property Count As Integer Implements IMyEnumerator(Of SettingsHost).MyEnumeratorCount

19
SCrawler/SCrawler.vbproj
View File

@@ -173,6 +173,19 @@
<Compile Include="API\Base\M3U8Base.vb" />
<Compile Include="API\Base\ProfileSaved.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\TokenBatch.vb" />
<Compile Include="API\Base\YTDLP.vb" />
@@ -518,6 +531,12 @@
<EmbeddedResource Include="API\BaseObjects\InternalSettingsForm.resx">
<DependentUpon>InternalSettingsForm.vb</DependentUpon>
</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">
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<Generator>ResXFileCodeGenerator</Generator>

12
SCrawler/SettingsCLS.vb
View File

@@ -54,6 +54,14 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
a.Invoke(CurlFile)
Plugins.ForEach(Sub(p) p.Settings.UpdateEnvironmentPrograms(EnvironmentProgramsList, CMDEncoding.Value))
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 Const File_FFMPEG As String = "ffmpeg.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)
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 UserAgent.IsEmptyString Then DefaultUserAgent = UserAgent
ImgurClientID = New XMLValue(Of String)("ImgurClientID", String.Empty, MyXML, {Name_Node_Sites})
'Basis: new version
@@ -462,6 +469,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Plugins.AddRange(tmpPluginList)
End If
UpdateEnvironmentPrograms()
UpdatePluginsUserAgent(False)
#End Region
Labels = New LabelsKeeper(MyXML)
@@ -1001,7 +1009,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property CollectionsPathF As SFile
Get
If GlobalPath.IsEmptyString Then
Throw New ArgumentNullException("GlobalPath", "GlobalPath not set")
Throw New ArgumentNullException("GlobalPath", "Global path not set")
Else
Return SFile.GetPath($"{GlobalPath.Value.PathWithSeparator}{CollectionsPath.Value}")
End If