diff --git a/Changelog.md b/Changelog.md index 8f0cbfd..f87378f 100644 --- a/Changelog.md +++ b/Changelog.md @@ -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 diff --git a/ProgramScreenshots/SettingsSiteFacebook.png b/ProgramScreenshots/SettingsSiteFacebook.png index f21d083..a505f92 100644 Binary files a/ProgramScreenshots/SettingsSiteFacebook.png and b/ProgramScreenshots/SettingsSiteFacebook.png differ diff --git a/ProgramScreenshots/SettingsSiteInstagram.png b/ProgramScreenshots/SettingsSiteInstagram.png index ad9865e..241c61c 100644 Binary files a/ProgramScreenshots/SettingsSiteInstagram.png and b/ProgramScreenshots/SettingsSiteInstagram.png differ diff --git a/ProgramScreenshots/SettingsSiteMastodon.png b/ProgramScreenshots/SettingsSiteMastodon.png index 5c2b069..e23a83f 100644 Binary files a/ProgramScreenshots/SettingsSiteMastodon.png and b/ProgramScreenshots/SettingsSiteMastodon.png differ diff --git a/ProgramScreenshots/SettingsSiteOnlyFans.png b/ProgramScreenshots/SettingsSiteOnlyFans.png index 6cb5353..f4186d7 100644 Binary files a/ProgramScreenshots/SettingsSiteOnlyFans.png and b/ProgramScreenshots/SettingsSiteOnlyFans.png differ diff --git a/ProgramScreenshots/SettingsSiteRedGifs.png b/ProgramScreenshots/SettingsSiteRedGifs.png index ddccbdf..1620d8a 100644 Binary files a/ProgramScreenshots/SettingsSiteRedGifs.png and b/ProgramScreenshots/SettingsSiteRedGifs.png differ diff --git a/ProgramScreenshots/SettingsSiteThreads.png b/ProgramScreenshots/SettingsSiteThreads.png index 4040752..773bd60 100644 Binary files a/ProgramScreenshots/SettingsSiteThreads.png and b/ProgramScreenshots/SettingsSiteThreads.png differ diff --git a/ProgramScreenshots/SettingsSiteTwitter.png b/ProgramScreenshots/SettingsSiteTwitter.png index dd7b574..51aafd2 100644 Binary files a/ProgramScreenshots/SettingsSiteTwitter.png and b/ProgramScreenshots/SettingsSiteTwitter.png differ diff --git a/SCrawler.PluginProvider/Attributes/Attributes.vb b/SCrawler.PluginProvider/Attributes/Attributes.vb index e1b9aa2..1237982 100644 --- a/SCrawler.PluginProvider/Attributes/Attributes.vb +++ b/SCrawler.PluginProvider/Attributes/Attributes.vb @@ -36,8 +36,22 @@ Namespace Plugin.Attributes Public Property IsInformationLabel As Boolean = False ''' Label text alignment.
Default: Public Property LabelTextAlign As Drawing.ContentAlignment = Drawing.ContentAlignment.TopCenter + Private _IsAuth As Boolean = False ''' This is an authorization property - 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 ''' Initialize a new property option attribute diff --git a/SCrawler.PluginProvider/Interfaces/ISiteSettings.vb b/SCrawler.PluginProvider/Interfaces/ISiteSettings.vb index ba65151..7d96012 100644 --- a/SCrawler.PluginProvider/Interfaces/ISiteSettings.vb +++ b/SCrawler.PluginProvider/Interfaces/ISiteSettings.vb @@ -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 diff --git a/SCrawler.PluginProvider/My Project/AssemblyInfo.vb b/SCrawler.PluginProvider/My Project/AssemblyInfo.vb index 5c197ea..b98d3e2 100644 --- a/SCrawler.PluginProvider/My Project/AssemblyInfo.vb +++ b/SCrawler.PluginProvider/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler.YouTube/Base/YouTubeSettings.vb b/SCrawler.YouTube/Base/YouTubeSettings.vb index 12504af..a70091d 100644 --- a/SCrawler.YouTube/Base/YouTubeSettings.vb +++ b/SCrawler.YouTube/Base/YouTubeSettings.vb @@ -361,6 +361,12 @@ Namespace API.YouTube.Base Throw New NotImplementedException("'GetFormat' is not available in 'FpsFormatProvider'") End Function End Class + + Public ReadOnly Property DefaultVideoHighlightFPS_H As XMLValue(Of Integer) + + Public ReadOnly Property DefaultVideoHighlightFPS_L As XMLValue(Of Integer) #End Region #Region "Defaults Audio" 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 diff --git a/SCrawler.YouTube/My Project/AssemblyInfo.vb b/SCrawler.YouTube/My Project/AssemblyInfo.vb index 4acca89..8dce322 100644 --- a/SCrawler.YouTube/My Project/AssemblyInfo.vb +++ b/SCrawler.YouTube/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb b/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb index ef02e8f..f2c11fa 100644 --- a/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb +++ b/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler/API/Base/DeclaredNames.vb b/SCrawler/API/Base/DeclaredNames.vb index 2076ab4..34af8da 100644 --- a/SCrawler/API/Base/DeclaredNames.vb +++ b/SCrawler/API/Base/DeclaredNames.vb @@ -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" diff --git a/SCrawler/API/Base/IUserData.vb b/SCrawler/API/Base/IUserData.vb index 14077f7..758571b 100644 --- a/SCrawler/API/Base/IUserData.vb +++ b/SCrawler/API/Base/IUserData.vb @@ -77,7 +77,7 @@ Namespace API.Base ''' 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? diff --git a/SCrawler/API/Base/SiteSettingsBase.vb b/SCrawler/API/Base/SiteSettingsBase.vb index 1e2b52e..c1448b1 100644 --- a/SCrawler/API/Base/SiteSettingsBase.vb +++ b/SCrawler/API/Base/SiteSettingsBase.vb @@ -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 diff --git a/SCrawler/API/Base/SplitCollectionUserInfo.vb b/SCrawler/API/Base/SplitCollectionUserInfo.vb new file mode 100644 index 0000000..4e9ec1b --- /dev/null +++ b/SCrawler/API/Base/SplitCollectionUserInfo.vb @@ -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 \ No newline at end of file diff --git a/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.Designer.vb b/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.Designer.vb new file mode 100644 index 0000000..556a481 --- /dev/null +++ b/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.Designer.vb @@ -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 + + Partial Friend Class SplitCollectionUserInfoChangePathsForm : Inherits System.Windows.Forms.Form + + 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 + + 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 \ No newline at end of file diff --git a/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.resx b/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.resx new file mode 100644 index 0000000..152bcac --- /dev/null +++ b/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.resx @@ -0,0 +1,129 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + False + + + False + + + False + + \ No newline at end of file diff --git a/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.vb b/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.vb new file mode 100644 index 0000000..1bc9c2e --- /dev/null +++ b/SCrawler/API/Base/SplitCollectionUserInfoChangePathsForm.vb @@ -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) + ''' + ''' Cancel = use initial
+ ''' Abort = abort operation
+ ''' OK = use changes + ''' + 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 \ No newline at end of file diff --git a/SCrawler/API/Base/SplitCollectionUserInfoPathForm.Designer.vb b/SCrawler/API/Base/SplitCollectionUserInfoPathForm.Designer.vb new file mode 100644 index 0000000..85d2148 --- /dev/null +++ b/SCrawler/API/Base/SplitCollectionUserInfoPathForm.Designer.vb @@ -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 + + Partial Friend Class SplitCollectionUserInfoPathForm : Inherits System.Windows.Forms.Form + + 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 + + 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 \ No newline at end of file diff --git a/SCrawler/API/Base/SplitCollectionUserInfoPathForm.resx b/SCrawler/API/Base/SplitCollectionUserInfoPathForm.resx new file mode 100644 index 0000000..59c4986 --- /dev/null +++ b/SCrawler/API/Base/SplitCollectionUserInfoPathForm.resx @@ -0,0 +1,154 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + False + + + False + + + + + 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== + + + + + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO + wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP + WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP + aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+ + 5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8 + vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB + cMaRN0UdBBkAAAAASUVORK5CYII= + + + \ No newline at end of file diff --git a/SCrawler/API/Base/SplitCollectionUserInfoPathForm.vb b/SCrawler/API/Base/SplitCollectionUserInfoPathForm.vb new file mode 100644 index 0000000..32e2272 --- /dev/null +++ b/SCrawler/API/Base/SplitCollectionUserInfoPathForm.vb @@ -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 \ No newline at end of file diff --git a/SCrawler/API/Base/UserDataBase.vb b/SCrawler/API/Base/UserDataBase.vb index ee823b4..154f7e8 100644 --- a/SCrawler/API/Base/UserDataBase.vb +++ b/SCrawler/API/Base/UserDataBase.vb @@ -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 diff --git a/SCrawler/API/Facebook/SiteSettings.vb b/SCrawler/API/Facebook/SiteSettings.vb index 0439de1..f246609 100644 --- a/SCrawler/API/Facebook/SiteSettings.vb +++ b/SCrawler/API/Facebook/SiteSettings.vb @@ -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 Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings @@ -31,11 +32,11 @@ Namespace API.Facebook End Property #End Region #Region "Defaults" - + Friend ReadOnly Property ParsePhotoBlock As PropertyValue - + Friend ReadOnly Property ParseVideoBlock As PropertyValue - + Friend ReadOnly Property ParseStoriesBlock As PropertyValue #End Region #End Region diff --git a/SCrawler/API/Instagram/SiteSettings.vb b/SCrawler/API/Instagram/SiteSettings.vb index eb02e4b..ac8fa19 100644 --- a/SCrawler/API/Instagram/SiteSettings.vb +++ b/SCrawler/API/Instagram/SiteSettings.vb @@ -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 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" + + Private ReadOnly Property DownDetectorValue As PropertyValue + + Private ReadOnly Property DownDetectorValueProvider As IFormatProvider + + Private ReadOnly Property DownDetectorValueAddToLog As PropertyValue Friend Const TimersUrgentTip As String = vbCr & "It is highly recommended not to change the default value." Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue @@ -154,33 +167,33 @@ Namespace API.Instagram + AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(20), PClonable> Friend ReadOnly Property RequestsWaitTimer As PropertyValue Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider + AllowNull:=False, LeftOffset:=120, Category:=DN.CAT_Timers), PXML, ControlNumber(21), PClonable> Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider + AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(22), PClonable> Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider - + Friend ReadOnly Property GetTimeline As PropertyValue - + Friend ReadOnly Property GetReels As PropertyValue - + Friend ReadOnly Property GetStories As PropertyValue - + Friend ReadOnly Property GetStoriesUser As PropertyValue - + Friend ReadOnly Property GetTagged As PropertyValue + Friend ReadOnly Property DownloadTimeline As PropertyValue Private ReadOnly Property DownloadTimeline_Def As PropertyValue - + Friend ReadOnly Property DownloadReels As PropertyValue Private ReadOnly Property DownloadReels_Def As PropertyValue - + Friend ReadOnly Property DownloadStories As PropertyValue Private ReadOnly Property DownloadStories_Def As PropertyValue - + Friend ReadOnly Property DownloadStoriesUser As PropertyValue Private ReadOnly Property DownloadStoriesUser_Def As PropertyValue - + Friend ReadOnly Property DownloadTagged As PropertyValue 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" diff --git a/SCrawler/API/Instagram/UserData.vb b/SCrawler/API/Instagram/UserData.vb index a71b593..b00fa96 100644 --- a/SCrawler/API/Instagram/UserData.vb +++ b/SCrawler/API/Instagram/UserData.vb @@ -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) diff --git a/SCrawler/API/Mastodon/EditorExchangeOptions.vb b/SCrawler/API/Mastodon/EditorExchangeOptions.vb index 6e1576f..a218601 100644 --- a/SCrawler/API/Mastodon/EditorExchangeOptions.vb +++ b/SCrawler/API/Mastodon/EditorExchangeOptions.vb @@ -14,6 +14,7 @@ Namespace API.Mastodon Friend Overrides Property DownloadModelProfile As Boolean Friend Overrides Property DownloadModelSearch As Boolean Friend Overrides Property DownloadModelForceApply As Boolean + Friend Overrides Property DownloadModelLikes As Boolean Friend Sub New(ByVal s As SiteSettings) MyBase.New(s) End Sub diff --git a/SCrawler/API/Mastodon/SiteSettings.vb b/SCrawler/API/Mastodon/SiteSettings.vb index 5b86e6e..76dbafd 100644 --- a/SCrawler/API/Mastodon/SiteSettings.vb +++ b/SCrawler/API/Mastodon/SiteSettings.vb @@ -63,15 +63,15 @@ Namespace API.Mastodon End Sub #End Region #Region "Other properties" - + Friend ReadOnly Property GifsDownload As PropertyValue - + Friend ReadOnly Property GifsSpecialFolder As PropertyValue - + Friend ReadOnly Property GifsPrefix As PropertyValue Private ReadOnly Property GifStringChecker As IFormatProvider - + Friend ReadOnly Property UseMD5Comparison As PropertyValue diff --git a/SCrawler/API/OnlyFans/SiteSettings.vb b/SCrawler/API/OnlyFans/SiteSettings.vb index 59f7991..0922b9c 100644 --- a/SCrawler/API/OnlyFans/SiteSettings.vb +++ b/SCrawler/API/OnlyFans/SiteSettings.vb @@ -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 Friend Class SiteSettings : Inherits SiteSettingsBase #Region "Declarations" +#Region "Categories" + Private Const CAT_OFS As String = "OF-Scraper support" +#End Region #Region "Options" - + Friend ReadOnly Property DownloadTimeline As PropertyValue - + Friend ReadOnly Property DownloadStories As PropertyValue - + Friend ReadOnly Property DownloadHighlights As PropertyValue - + 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" - + Friend ReadOnly Property HH_USER_ID As PropertyValue - + Private ReadOnly Property HH_X_BC As PropertyValue - + Private ReadOnly Property HH_APP_TOKEN As PropertyValue + InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua, IsAuth:=True), PClonable, PXML(OnlyForChecked:=True)> Private ReadOnly Property HH_BROWSER As PropertyValue - + 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 + "Change this value only if you know what you are doing.", IsAuth:=True), PXML, PClonable> Friend ReadOnly Property UseOldAuthRules As PropertyValue - + Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider + "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" Private ReadOnly Property OFScraperPath_XML As PropertyValue - + Friend ReadOnly Property OFScraperPath As PropertyValue Get If Not DefaultInstance Is Nothing Then @@ -106,7 +111,7 @@ Namespace API.OnlyFans End Get End Property Private ReadOnly Property OFScraperMP4decrypt_XML As PropertyValue - + 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" Private ReadOnly Property KeyModeDefault_XML As PropertyValue - + 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 diff --git a/SCrawler/API/Reddit/M3U8.vb b/SCrawler/API/Reddit/M3U8.vb index c064beb..4fbd52e 100644 --- a/SCrawler/API/Reddit/M3U8.vb +++ b/SCrawler/API/Reddit/M3U8.vb @@ -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" diff --git a/SCrawler/API/Reddit/SiteSettings.vb b/SCrawler/API/Reddit/SiteSettings.vb index fff9d0c..56c6bcf 100644 --- a/SCrawler/API/Reddit/SiteSettings.vb +++ b/SCrawler/API/Reddit/SiteSettings.vb @@ -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" diff --git a/SCrawler/API/Reddit/UserData.vb b/SCrawler/API/Reddit/UserData.vb index a6ac46a..254d83a 100644 --- a/SCrawler/API/Reddit/UserData.vb +++ b/SCrawler/API/Reddit/UserData.vb @@ -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") diff --git a/SCrawler/API/Redgifs/SiteSettings.vb b/SCrawler/API/Redgifs/SiteSettings.vb index 5f4fe7f..798f76b 100644 --- a/SCrawler/API/Redgifs/SiteSettings.vb +++ b/SCrawler/API/Redgifs/SiteSettings.vb @@ -18,9 +18,9 @@ Namespace API.RedGifs Friend Class SiteSettings : Inherits SiteSettingsBase #Region "Declarations" - + Friend ReadOnly Property Token As PropertyValue - + Private ReadOnly Property UserAgent As PropertyValue 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 diff --git a/SCrawler/API/ThreadsNet/SiteSettings.vb b/SCrawler/API/ThreadsNet/SiteSettings.vb index acd7017..69dd25e 100644 --- a/SCrawler/API/ThreadsNet/SiteSettings.vb +++ b/SCrawler/API/ThreadsNet/SiteSettings.vb @@ -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 Friend Class SiteSettings : Inherits SiteSettingsBase @@ -75,14 +76,14 @@ Namespace API.ThreadsNet #Region "Other properties" Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider + "It becomes unchecked when the site returns an error.", Category:="Download"), PXML> Friend ReadOnly Property DownloadData_Impl As PropertyValue #End Region #End Region diff --git a/SCrawler/API/ThreadsNet/UserData.vb b/SCrawler/API/ThreadsNet/UserData.vb index 1009f97..e1a1eb4 100644 --- a/SCrawler/API/ThreadsNet/UserData.vb +++ b/SCrawler/API/ThreadsNet/UserData.vb @@ -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", "") diff --git a/SCrawler/API/Twitter/Declarations.vb b/SCrawler/API/Twitter/Declarations.vb index ac2a3fa..46d4de1 100644 --- a/SCrawler/API/Twitter/Declarations.vb +++ b/SCrawler/API/Twitter/Declarations.vb @@ -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" diff --git a/SCrawler/API/Twitter/EditorExchangeOptions.vb b/SCrawler/API/Twitter/EditorExchangeOptions.vb index 60f6a78..c6a9e1c 100644 --- a/SCrawler/API/Twitter/EditorExchangeOptions.vb +++ b/SCrawler/API/Twitter/EditorExchangeOptions.vb @@ -28,16 +28,20 @@ Namespace API.Twitter Friend Overridable Property MediaModelAllowNonUserTweets As Boolean = False + ToolTip:="Download the data using the 'https://x.com/UserName/media' command.", LeftOffset:=DefaultOffset)> Friend Overridable Property DownloadModelMedia As Boolean = False + ToolTip:="Download the data using the 'https://x.com/UserName' command.", LeftOffset:=DefaultOffset)> Friend Overridable Property DownloadModelProfile As Boolean = False + ToolTip:="Download the data using the 'https://x.com/search?q=from:UserName+include:nativeretweets' command.", LeftOffset:=DefaultOffset)> Friend Overridable Property DownloadModelSearch As Boolean = False + + Friend Overridable Property DownloadModelLikes As Boolean = False @@ -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 diff --git a/SCrawler/API/Twitter/SiteSettings.vb b/SCrawler/API/Twitter/SiteSettings.vb index c559af8..28f1a92 100644 --- a/SCrawler/API/Twitter/SiteSettings.vb +++ b/SCrawler/API/Twitter/SiteSettings.vb @@ -16,32 +16,37 @@ Namespace API.Twitter Friend Class SiteSettings : Inherits SiteSettingsBase #Region "Declarations" +#Region "Categories" + Private Const CAT_DOWN As String = "Downloading" +#End Region #Region "Other properties" + "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" - + Friend Property UseNewEndPointSearch As PropertyValue - + Friend Property UseNewEndPointProfiles As PropertyValue #End Region #Region "Limits" - + Friend Property AbortOnLimit As PropertyValue - + Friend Property DownloadAlreadyParsed As PropertyValue #End Region - + Friend ReadOnly Property MediaModelAllowNonUserTweets As PropertyValue - + Friend ReadOnly Property GifsDownload As PropertyValue - + Friend ReadOnly Property GifsSpecialFolder As PropertyValue - + Friend ReadOnly Property GifsPrefix As PropertyValue 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 - + Friend ReadOnly Property UseMD5Comparison As PropertyValue + ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120, Category:=CAT_DOWN), PXML, TaskCounter, PClonable> Friend ReadOnly Property ConcurrentDownloads As PropertyValue 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 diff --git a/SCrawler/API/Twitter/UserData.vb b/SCrawler/API/Twitter/UserData.vb index a439655..a732213 100644 --- a/SCrawler/API/Twitter/UserData.vb +++ b/SCrawler/API/Twitter/UserData.vb @@ -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 diff --git a/SCrawler/API/UserDataBind.vb b/SCrawler/API/UserDataBind.vb index 2de6cd9..d8f4ef4 100644 --- a/SCrawler/API/UserDataBind.vb +++ b/SCrawler/API/UserDataBind.vb @@ -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() diff --git a/SCrawler/Download/Automation/AutoDownloader.vb b/SCrawler/Download/Automation/AutoDownloader.vb index fa4cbe4..32ee52f 100644 --- a/SCrawler/Download/Automation/AutoDownloader.vb +++ b/SCrawler/Download/Automation/AutoDownloader.vb @@ -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 diff --git a/SCrawler/Download/Automation/AutoDownloaderEditorForm.Designer.vb b/SCrawler/Download/Automation/AutoDownloaderEditorForm.Designer.vb index aee5ea9..430c934 100644 --- a/SCrawler/Download/Automation/AutoDownloaderEditorForm.Designer.vb +++ b/SCrawler/Download/Automation/AutoDownloaderEditorForm.Designer.vb @@ -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" diff --git a/SCrawler/Download/Automation/AutoDownloaderEditorForm.resx b/SCrawler/Download/Automation/AutoDownloaderEditorForm.resx index bdebe69..e2ab359 100644 --- a/SCrawler/Download/Automation/AutoDownloaderEditorForm.resx +++ b/SCrawler/Download/Automation/AutoDownloaderEditorForm.resx @@ -189,6 +189,18 @@ + + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1 + MAAA6mAAADqYAAAXb5JfxUYAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAFQSURBVFhH7ZfNDcIwFIMZoXcm + YBtGYRHECIgTR1ZhBsS9YoJgQ1Poi5sfqhIOWPqkqvV7dWlI0oVzriry5Dd5HSS0PFwasAEn0AJn4Dle + o6fpykaVHYDNwB7YG6ZgzWiQrABosAbqaXNh7bprN1AyAAp3b42msuva9ooGYIFpELA931D2FI+VxzAI + gTIdAEb+7KpBz+p4RclQyifoXwdKwgAwcMAl3/mEAOz9GJgokQGyR/sHr8CzlwFwgU+vCuagUQE4gSjz + HGxUAM5iyiyxUp4IJ5QEAYomHCvlidCiJAigjKNYKU8M6B/g9wJUH4TV/4ZFE5GV8kSQE1HRVGylPBHC + qbh0MbJSnhH0YtQFyFqOiZXyCOLLMQVDckNCrJRHEN+QeMGY3JJZKY8hb0vmxQLTYAplm1IvFNbblnuh + Qb0Pk3exGZjv06wW8uT3cIs7jQnSONrSxH0AAAAASUVORK5CYII= + + + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go @@ -204,7 +216,7 @@ 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. - + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE @@ -220,7 +232,7 @@ The 'Image' and 'User icon' parameters will be ignored. VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== - + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE diff --git a/SCrawler/Download/Automation/AutoDownloaderEditorForm.vb b/SCrawler/Download/Automation/AutoDownloaderEditorForm.vb index eaebf45..0a8390c 100644 --- a/SCrawler/Download/Automation/AutoDownloaderEditorForm.vb +++ b/SCrawler/Download/Automation/AutoDownloaderEditorForm.vb @@ -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, diff --git a/SCrawler/Download/Automation/SchedulerEditorForm.vb b/SCrawler/Download/Automation/SchedulerEditorForm.vb index 1bb045b..112514c 100644 --- a/SCrawler/Download/Automation/SchedulerEditorForm.vb +++ b/SCrawler/Download/Automation/SchedulerEditorForm.vb @@ -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 diff --git a/SCrawler/Download/Groups/DownloadGroup.vb b/SCrawler/Download/Groups/DownloadGroup.vb index a3d711c..914f25e 100644 --- a/SCrawler/Download/Groups/DownloadGroup.vb +++ b/SCrawler/Download/Groups/DownloadGroup.vb @@ -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 diff --git a/SCrawler/Download/Groups/GroupListForm.vb b/SCrawler/Download/Groups/GroupListForm.vb index 23a5c70..bb5e32d 100644 --- a/SCrawler/Download/Groups/GroupListForm.vb +++ b/SCrawler/Download/Groups/GroupListForm.vb @@ -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() diff --git a/SCrawler/Editors/GlobalSettingsForm.vb b/SCrawler/Editors/GlobalSettingsForm.vb index 8369f70..2ca3930 100644 --- a/SCrawler/Editors/GlobalSettingsForm.vb +++ b/SCrawler/Editors/GlobalSettingsForm.vb @@ -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 diff --git a/SCrawler/Editors/LabelsForm.vb b/SCrawler/Editors/LabelsForm.vb index 5888b0b..b43955e 100644 --- a/SCrawler/Editors/LabelsForm.vb +++ b/SCrawler/Editors/LabelsForm.vb @@ -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 \ No newline at end of file diff --git a/SCrawler/Editors/SiteEditorForm.vb b/SCrawler/Editors/SiteEditorForm.vb index da467a3..053cd03 100644 --- a/SCrawler/Editors/SiteEditorForm.vb +++ b/SCrawler/Editors/SiteEditorForm.vb @@ -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 diff --git a/SCrawler/MainFrame.vb b/SCrawler/MainFrame.vb index f9006e5..b3c3241 100644 --- a/SCrawler/MainFrame.vb +++ b/SCrawler/MainFrame.vb @@ -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() diff --git a/SCrawler/MainMod.vb b/SCrawler/MainMod.vb index f95ee96..b9ec1d0 100644 --- a/SCrawler/MainMod.vb +++ b/SCrawler/MainMod.vb @@ -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} diff --git a/SCrawler/My Project/AssemblyInfo.vb b/SCrawler/My Project/AssemblyInfo.vb index c9017bd..7403443 100644 --- a/SCrawler/My Project/AssemblyInfo.vb +++ b/SCrawler/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler/PluginsEnvironment/Hosts/PropertyValueHost.vb b/SCrawler/PluginsEnvironment/Hosts/PropertyValueHost.vb index 24795d4..aa998d9 100644 --- a/SCrawler/PluginsEnvironment/Hosts/PropertyValueHost.vb +++ b/SCrawler/PluginsEnvironment/Hosts/PropertyValueHost.vb @@ -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) diff --git a/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb b/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb index 2517607..5a7371d 100644 --- a/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb +++ b/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb @@ -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 diff --git a/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb b/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb index 18101ce..a485b1f 100644 --- a/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb +++ b/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb @@ -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 ''' 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 diff --git a/SCrawler/SCrawler.vbproj b/SCrawler/SCrawler.vbproj index 4b5f446..d565a15 100644 --- a/SCrawler/SCrawler.vbproj +++ b/SCrawler/SCrawler.vbproj @@ -173,6 +173,19 @@ + + + SplitCollectionUserInfoChangePathsForm.vb + + + Form + + + SplitCollectionUserInfoPathForm.vb + + + Form + @@ -518,6 +531,12 @@ InternalSettingsForm.vb + + SplitCollectionUserInfoChangePathsForm.vb + + + SplitCollectionUserInfoPathForm.vb + My.Resources ResXFileCodeGenerator diff --git a/SCrawler/SettingsCLS.vb b/SCrawler/SettingsCLS.vb index 11cc414..f67a475 100644 --- a/SCrawler/SettingsCLS.vb +++ b/SCrawler/SettingsCLS.vb @@ -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