Compare commits

..

8 Commits

Author SHA1 Message Date
Andy
dea14d35af 2024.6.25.0
API.OnlyFans: new dynamic rules updating algo
API.Instagram: update settings
Feed: add ability to set the last session as the current one; wrong marking data as saved posts when moving a file
2024-06-25 11:46:33 +03:00
Andy
744698c99e 2024.6.13.0
Remove compatibility of settings of older versions
2024-06-13 12:16:38 +03:00
Andy
aef4ce1c8f 2024.6.10.0
YT
YouTubeSettings: add 'VideoPlaylist_AddExtractedMP3' property
MediaItem: improve visualization of height and bitrate
YouTubeMediaContainerBase: fix bugs on default post-processing formats; add 'HeightBase' and 'BitrateBase' properties; add extracted MP3 to playlist
VideoListForm: add 'UpdateLogButton' handlers

SCrawler
Feed: add settings to show/hide site name and file type from media title; add move/copy files of a loaded feed/session to another location; add the ability to reset current session
DownloadFeedForm: when moving saved posts files without replacing the profile, some data is lost
FeedVideo: add double-click handler to open video in external player
API.Instagram: update settings
2024-06-10 08:40:40 +03:00
Andy
93ea2a55ac 2024.6.6.0
YT
VideoOptionsForm: file path is cleared when the cancel button is clicked (browse button); remove the context menu when the right clicking on browse button; add 'ButtonRC' class

SCrawler
API.OnlyFans: add check config to the SiteSettings; update config; add 'Keydb_Api' property; reset 'LastDateUpdated' when rules change; add support 'prefix/suffix' and 'start/end' to support other rules formats
DownloadFeedForm: update 'BTT_CURR_SESSION_SET_Click' function
TDownloader: update 'FilesLoadLastSession' function
2024-06-06 05:49:50 +03:00
Andy
2ae8c3acfc 2024.6.4.0
API.Twitter: add communities downloading, change post opening URL
Feed: add the ability to select one of the download sessions and set it as the current session
2024-06-04 03:28:05 +03:00
Andy
53dcb3e2c6 2024.6.2.0
YT
Add 'FileAddDateToFileName', 'FileAddDateToFileName_VideoForm' and 'FileAddDateToFileName_VideoList' properties
Update 'YouTubeMediaContainerBase', 'VideoOptionsForm' and 'MediaItem' (new options)

SCrawler
API.Instagram: update settings values
API.Reddit: fix 'ReparseMissing' function (remove bearer token)
2024-06-02 01:19:41 +03:00
Andy
ca384e54d6 2024.5.29.0
YT
Trim urls to get rid of 'cr' & 'lf'
Get the correct 'music' url for 'url' files

SCrawler
Remove the no longer needed 'MainFrameObj.UpdateLogButton' from the classes
ProfileSaved: swap the 'ReadyToDownload' and 'Available' checks; remove the 'DownloadStarted' and 'DownloadDone' calls because they are called in the root function
API.Instagram: improve availability checking
API.Twitter: fix deleting user directory when redownloading missing posts
AutoDownloader: improve statuses; move the check thread to the scheduler; add highlighting of scheduler plans (working, stopped, pending, etc.); replace 'ListBox' with 'ListView'; highlight undownloaded plans in gray
2024-05-29 02:45:37 +03:00
Andy
5a1b5c828a 2024.5.25.0
Move files to another directory
2024-05-25 10:06:50 +03:00
73 changed files with 2757 additions and 750 deletions

View File

@@ -1,3 +1,65 @@
# 2024.6.25.0
*2024-06-25*
**ATTENTION! To support downloading of DRM protected videos (OnlyFans), please update OF-Scraper to version [3.10.7](https://github.com/datawhores/OF-Scraper/releases/tag/3.10.7) (download `zip`, not `exe`).**
- Added
- OnlyFans: **new dynamic rules updating algorithm**
- Feed: ability to set the last session as the current one
- Updated
- gallery-dl up to version **1.27.1**
- Fixed
- Minor bugs
# 2024.6.10.0
*2024-06-10*
- Added
- YouTube (standalone app): add option to add extracted MP3 to playlist (`Settings` - `Defaults Video` - `Add extracted MP3 to playlist`)
- Feed
- settings to show/hide site name and file type from media title
- ability to move/copy files of a loaded feed/session to another location
- ability to reset current session
- Fixed
- Minor bugs
# 2024.6.6.0
*2024-06-06*
**ATTENTION!**
1. **To support downloading of DRM protected videos (OnlyFans), please update OF-Scraper to version [3.10](https://github.com/datawhores/OF-Scraper/releases/tag/3.10) (download `zip`, not `exe`).**
2. **If there is a `OFScraperConfigPattern.json` file in the SCrawler settings folder, replace the text of the file with [this text](https://github.com/AAndyProgram/SCrawler/blob/main/SCrawler/API/OnlyFans/OFScraperConfigPattern.json).**
3. **Set the value to `Dynamic rules` (in the site settings) = `https://raw.githubusercontent.com/Growik/onlyfans-dynamic-rules/main/rules.json`.**
- Added
- OnlyFans: new OF-Scraper option (`keydb_api`)
- Minor improvements
- Fixed
- OnlyFans: **data is not downloading**
- Minor bugs
# 2024.6.4.0
*2024-06-04*
**If you were using the [`yt-dlp-TTUser`](https://github.com/bashonly/yt-dlp-TTUser) plugin, you should remove it because this plugin was added to yt-dlp itself! Read more [here](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-requirements).**
- Added
- Added highlighting of scheduler plans (working, stopped, pending, etc.)
- YouTube (standalone app): add option to add the video upload date before/after the file name (`Settings` - `Defaults` - `Add date to file name`)
- Twitter: **`Communities` downloading**
- Feed: ability to select one of the download sessions and set it as the current session
- Minor improvements
- Updated
- yt-dlp up to version **2024.05.27**
- gallery-dl up to version **1.27.0**
- Fixed
- Twitter: deleting user directory when redownloading missing posts
- Minor bugs
# 2024.5.19.0
*2024-05-19*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 30 KiB

After

Width:  |  Height:  |  Size: 29 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 25 KiB

View File

@@ -1,5 +1,5 @@
<!-- # :rainbow_flag: Happy LGBT Pride Month :tada:
-->
# 🏳️‍🌈 Happy LGBT Pride Month 🎉
# 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
@@ -37,8 +37,8 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks;
- Reddit images, galleries of images, videos, saved posts;
- Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts;
- OnlyFans images and videos, saved (bookmarked) posts;
- Twitter images and videos, saved (bookmarked) posts, likes, communities;
- OnlyFans images and videos, saved (bookmarked) posts, stories;
- JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts;
@@ -79,11 +79,11 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **Reddit**
- **Twitter**
- **OnlyFans** *(partial support)*[^1]
- **Mastodon**
- **Instagram**
- **Threads**
- **Facebook**
- JustForFans *(partial support)*[^1]
- Mastodon *(out of support)*
- TikTok
- RedGifs
- Pinterest

View File

@@ -78,6 +78,12 @@ Namespace API.YouTube.Base
https = 1
m3u8 = 2
End Enum
<Editor(GetType(EnumDropDownEditor), GetType(UITypeEditor))>
Public Enum FileDateMode As Integer
None = 0
Before = 1
After = 2
End Enum
Public Structure MediaObject : Implements IIndexable, IComparable(Of MediaObject)
Public Type As Plugin.UserMediaTypes
Public ID As String

View File

@@ -22,6 +22,7 @@ Namespace API.YouTube.Base
End Sub
Public Shared Function StandardizeURL(ByVal URL As String) As String
Try
URL = URL.StringTrim
Dim isMusic As Boolean = False, isShorts As Boolean = False
If Info_GetUrlType(URL, isMusic, isShorts) = YouTubeMediaType.Single Then
If Not isMusic And Not isShorts Then
@@ -45,6 +46,7 @@ Namespace API.YouTube.Base
End Function
Public Shared Function StandardizeURL_Channel(ByVal URL As String, Optional ByVal Process As Boolean = True) As String
Try
URL = URL.StringTrim
Dim ct As YouTubeChannelTab = YouTubeChannelTab.All
Dim isMusic As Boolean = False
If Process AndAlso Info_GetUrlType(URL, isMusic,,,, ct) = YouTubeMediaType.Channel AndAlso Not isMusic Then
@@ -72,6 +74,7 @@ Namespace API.YouTube.Base
Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False, Optional ByRef IsShorts As Boolean = False,
Optional ByRef IsChannelUser As Boolean = False, Optional ByRef Id As String = Nothing,
Optional ByRef ChannelOptions As YouTubeChannelTab = YouTubeChannelTab.All) As YouTubeMediaType
URL = URL.StringTrim
If Not URL.IsEmptyString Then
IsMusic = URL.Contains("music.youtube.com")
IsChannelUser = False
@@ -118,6 +121,7 @@ Namespace API.YouTube.Base
Optional ByVal Token As Threading.CancellationToken = Nothing, Optional ByVal Progress As IMyProgress = Nothing,
Optional ByVal DateAfter As Date? = Nothing, Optional ByVal DateBefore As Date? = Nothing,
Optional ByVal ChannelOption As YouTubeChannelTab? = Nothing, Optional ByVal UrlAsIs As Boolean = False) As IYouTubeMediaContainer
URL = URL.StringTrim
If URL.IsEmptyString Then Throw New ArgumentNullException("URL", "URL cannot be null")
If Not MyYouTubeSettings.YTDLP.Value.Exists Then Throw New IO.FileNotFoundException("Path to 'yt-dlp.exe' not set or program not found at destination", MyYouTubeSettings.YTDLP.Value.ToString)
Dim urlOrig$ = URL
@@ -162,7 +166,7 @@ Namespace API.YouTube.Base
If result Then
container.Parse(Nothing, _CachePathDefault, isMusic, Token, Progress)
If Not container.HasError Then container.URL = URL : container.IsShorts = isShorts : Return container
If Not container.HasError Then container.URL = URL.ToMusicUrl(isMusic) : container.IsShorts = isShorts : Return container
End If
container.Dispose()
End If

View File

@@ -249,9 +249,18 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program description"),
Description("Add some additional info to the program info if you need")>
Friend ReadOnly Property ProgramDescription As XMLValue(Of String)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"),
<Browsable(True), GridVisible, XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"),
Description("Remove specific characters from a file name")>
Friend ReadOnly Property FileRemoveCharacters As XMLValue(Of String)
Public ReadOnly Property FileRemoveCharacters As XMLValue(Of String)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, FileDateMode.None), Category("Defaults"), DisplayName("Add date to file name"),
Description("Add the video upload date before/after the file name")>
Public ReadOnly Property FileAddDateToFileName As XMLValue(Of FileDateMode)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Add date to title: video form"),
Description("Add video upload date before video title (visual only) in the video form")>
Public ReadOnly Property FileAddDateToFileName_VideoForm As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Add date to title: video list"),
Description("Add video upload date before video title (visual only) in the video list")>
Public ReadOnly Property FileAddDateToFileName_VideoList As XMLValue(Of Boolean)
#End Region
#Region "Defaults ChannelsDownload"
<Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"),
@@ -373,6 +382,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, -1), Category("Defaults Video"), DisplayName("Highlight FPS (lower)"),
Description("Highlight frame rates lower than this value." & vbCr & "Default: -1" & vbCr & "-1 to disable")>
Public ReadOnly Property DefaultVideoHighlightFPS_L As XMLValue(Of Integer)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}), Category("Defaults Video"), DisplayName("Add extracted MP3 to playlist"),
Description("If you also extract MP3 when download the video, add the extracted MP3 to the playlist. Default: false.")>
Public ReadOnly Property VideoPlaylist_AddExtractedMP3 As XMLValue(Of Boolean)
#End Region
#Region "Defaults Audio"
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"),

View File

@@ -0,0 +1,23 @@
' 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.YouTube.Controls
Public Class ButtonRC : Inherits Button
Private Const WM_CONTEXTMENU As Integer = 123 '&H7B
Private Const WM_CANCELMODE As Integer = 31 '&H1F
Private Const WM_INITMENUPOPUP As Integer = 279 '&H117
Private Const SMTO_NOTIMEOUTIFNOTHUNG As Integer = 8
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_CONTEXTMENU Or m.Msg = WM_CANCELMODE Or m.Msg = WM_INITMENUPOPUP Or m.Msg = SMTO_NOTIMEOUTIFNOTHUNG Then
m.Result = IntPtr.Zero
Else
MyBase.WndProc(m)
End If
End Sub
End Class
End Namespace

View File

@@ -65,11 +65,11 @@ Namespace API.YouTube.Controls
Me.LBL_TIME = New System.Windows.Forms.Label()
Me.LBL_URL = New System.Windows.Forms.LinkLabel()
Me.TXT_FILE = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_BROWSE = New System.Windows.Forms.Button()
Me.BTT_BROWSE = New SCrawler.API.YouTube.Controls.ButtonRC()
Me.BTT_DOWN = New System.Windows.Forms.Button()
Me.BTT_CANCEL = New System.Windows.Forms.Button()
Me.CMB_PLS = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_PLS_BROWSE = New System.Windows.Forms.Button()
Me.BTT_PLS_BROWSE = New SCrawler.API.YouTube.Controls.ButtonRC()
Me.OPT_VIDEO = New System.Windows.Forms.RadioButton()
Me.OPT_AUDIO = New System.Windows.Forms.RadioButton()
Me.LBL_AUDIO_CODEC = New System.Windows.Forms.Label()
@@ -912,13 +912,13 @@ Namespace API.YouTube.Controls
Private WithEvents TXT_SUBS_ADDIT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_EXTRA_AUDIO_FORMATS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_FILE As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_BROWSE As Button
Private WithEvents BTT_BROWSE As SCrawler.API.YouTube.Controls.ButtonRC
Private WithEvents BTT_DOWN As Button
Private WithEvents BTT_CANCEL As Button
Private WithEvents TP_HEADER_INFO_2 As TableLayoutPanel
Private WithEvents TXT_FPS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CMB_PLS As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_PLS_BROWSE As Button
Private WithEvents BTT_PLS_BROWSE As SCrawler.API.YouTube.Controls.ButtonRC
Private WithEvents TXT_AUDIO_BITRATE As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -121,7 +121,7 @@ Namespace API.YouTube.Controls
img = ImageRenderer.GetImage(SFile.GetBytesFromNet(imgUrl, EDP.ReturnValue), EDP.ReturnValue)
If Not img Is Nothing Then ICON_VIDEO.Image = img : ICON_VIDEO.InitialImage = img
End If
LBL_TITLE.Text = .Title
LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoForm.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .Title}"
LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty)
TP_HEADER_INFO_2.ColumnStyles(1).Width = MeasureTextDefault(LBL_TIME.Text, LBL_TIME.Font).Width + PaddingE.GetOf({LBL_TIME}).Horizontal
TP_HEADER_INFO_2.Refresh()
@@ -610,7 +610,7 @@ Namespace API.YouTube.Controls
$"Video|{AvailableVideoFormats.Select(Function(vf) $"*.{vf.ToLower}").ListToString(";")}" &
$"|Audio|{AvailableAudioFormats.Select(Function(af) $"*.{af.ToLower}").ListToString(";")}"
f = SFile.SaveAs(f, "Select the destination of the video file",, ext, sPattern, EDP.ReturnValue)
f.Extension = ext
If Not f.IsEmptyString Then f.Extension = ext
End If
#Enable Warning
f = CleanFileName(f)

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Runtime.CompilerServices
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions
@@ -56,6 +57,11 @@ Namespace API.YouTube
Friend ReadOnly TitleHtmlConverter As Func(Of String, String) = Function(Input) Input.StringRemoveWinForbiddenSymbols().StringTrim()
Friend ReadOnly ProgressProvider As IMyProgressNumberProvider = MyProgressNumberProvider.Percentage
Public ReadOnly TrueUrlRegEx As RParams = RParams.DM(Base.YouTubeFunctions.TrueUrlPattern, 0, EDP.ReturnValue)
Friend ReadOnly MusicUrlApply As RParams = RParams.DMS("https://([w\.]*)youtube.com.+", 1, RegexReturn.Replace, EDP.ReturnValue,
CType(Function(input$) "music.", Func(Of String, String)), String.Empty)
<Extension> Friend Function ToMusicUrl(ByVal URL As String, ByVal IsMusic As Boolean) As String
Try : Return If(IsMusic And Not URL.IsEmptyString, CStr(RegexReplace(URL, MusicUrlApply)).IfNullOrEmpty(URL), URL) : Catch : Return URL : End Try
End Function
Friend Function CleanFileName(ByVal f As SFile) As SFile
If Not f.IsEmptyString And Not f.Name.IsEmptyString Then
Dim ff As SFile = f

View File

@@ -133,18 +133,25 @@ Namespace DownloadObjects.STDownloader
ICON_SITE.Image = .SiteIcon
LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty)
LBL_TITLE.Text = .ToString(True)
LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoList.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .ToString(True)}"
Dim h%, b%
If .Self.GetType Is GetType(YouTubeMediaContainerBase) OrElse (Not .Self.GetType.BaseType Is Nothing AndAlso .Self.GetType.BaseType Is GetType(YouTubeMediaContainerBase)) Then
With DirectCast(.Self, YouTubeMediaContainerBase) : h = .HeightBase : b = .BitrateBase : End With
Else
h = .Height
b = .Bitrate
End If
If Not .SiteKey = YouTubeSiteKey And .ContentType = Plugin.UserMediaTypes.Picture Then
LBL_INFO.Text = .File.Extension.StringToUpper
ElseIf Not .IsMusic And Not (.MediaType = Plugin.UserMediaTypes.Audio Or .MediaType = Plugin.UserMediaTypes.AudioPre) Then
If .Height > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Height}p"
If h > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{h}p"
Else
LBL_INFO.Text = .File.Extension.StringToUpper
End If
Else
If .Bitrate > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Bitrate}k"
If b > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{b}k"
Else
LBL_INFO.Text = .File.Extension.StringToUpper
End If
@@ -221,7 +228,7 @@ Namespace DownloadObjects.STDownloader
t = 0
End If
LBL_TITLE.Text = MyContainer.ToString(True)
LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoList.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .ToString(True)}"
If Not .SiteKey = YouTubeSiteKey Then BTT_VIEW_SETTINGS.Visible = False

View File

@@ -57,6 +57,12 @@ Namespace DownloadObjects.STDownloader
End If
MyNotificator = New YTNotificator(Me)
MyDownloaderSettings = MyYouTubeSettings
ProgramLogInitialize()
With ProgramLog
AddHandler .TextAdded, AddressOf ProgramLog_TextAdded
AddHandler .TextCleared, AddressOf ProgramLog_TextCleared
End With
UpdateLogButton()
End If
With MyView : .Import() : .SetFormSize() : End With
@@ -157,7 +163,7 @@ Namespace DownloadObjects.STDownloader
If PerformClick Then cnt.PerformClick()
If Not DisableDownload And MyDownloaderSettings.DownloadAutomatically Then AddToDownload(cnt, True)
End With
End Sub, EDP.None)
End Sub, EDP.SendToLog)
End Sub
#Region "Controls rendering"
Private Overloads Sub OffsetControls()
@@ -247,7 +253,7 @@ Namespace DownloadObjects.STDownloader
Dim useCookiesParse As Boolean? = Nothing
If useCookies Then useCookiesParse = True
Dim standardizeUrls As Boolean = MyYouTubeSettings.StandardizeURLs
Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input)
Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input.StringTrim)
Dim c As IYouTubeMediaContainer = Nothing
Dim url$ = String.Empty
@@ -449,12 +455,26 @@ Namespace DownloadObjects.STDownloader
End Try
End Sub
#End Region
#Region "LOG"
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub
Friend Sub UpdateLogButton()
If AppMode Then MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP)
Private Sub UpdateLogButton()
If AppMode Then
Try : MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP) : Catch : End Try
End If
End Sub
Private _LogUpdateButtonSuspended As Boolean = False
Private Sub ProgramLog_TextAdded(ByVal Sender As Object, ByVal e As EventArgs)
If Not _LogUpdateButtonSuspended Then
_LogUpdateButtonSuspended = True
Try : ControlInvokeFast(TOOLBAR_TOP, BTT_LOG, AddressOf UpdateLogButton, EDP.None) : Catch : End Try
End If
End Sub
Private Sub ProgramLog_TextCleared(ByVal Sender As Object, ByVal e As EventArgs)
_LogUpdateButtonSuspended = False
End Sub
#End Region
Private Sub BTT_BUG_REPORT_Click(sender As Object, e As EventArgs) Handles BTT_BUG_REPORT.Click
Try
With MyYouTubeSettings

View File

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

View File

@@ -267,12 +267,11 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputAudioFormats As List(Of String)
Friend Sub PostProcessing_OutputAudioFormats_Reset()
PostProcessing_OutputAudioFormats.Clear()
PostProcessing_OutputAudioFormats.ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit)
If PostProcessing_OutputAudioFormats.Count > 0 Then
PostProcessing_OutputAudioFormats.Sort()
PostProcessing_OutputAudioFormats.RemoveAll(Function(s) s = -1)
End If
With PostProcessing_OutputAudioFormats
.Clear()
.ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit)
If .Count > 0 Then .Sort()
End With
End Sub
<XMLEC("OutputAudioBitrate")> Protected _OutputAudioBitrate As Integer = -1
Friend Property OutputAudioBitrate As Integer
@@ -322,21 +321,19 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputSubtitlesFormats As List(Of String)
Friend Sub PostProcessing_OutputSubtitlesFormats_Reset()
PostProcessing_OutputSubtitlesFormats.Clear()
PostProcessing_OutputSubtitlesFormats.ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit)
If PostProcessing_OutputSubtitlesFormats.Count > 0 Then
PostProcessing_OutputSubtitlesFormats.Sort()
PostProcessing_OutputSubtitlesFormats.RemoveAll(Function(s) s = -1)
End If
With PostProcessing_OutputSubtitlesFormats
.Clear()
.ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit)
If .Count > 0 Then .Sort()
End With
End Sub
Friend Sub SubtitlesSelectedIndexesReset()
SubtitlesSelectedIndexes.Clear()
Dim subs As List(Of Subtitles) = Subtitles
SubtitlesSelectedIndexes.ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s)))
If SubtitlesSelectedIndexes.Count > 0 Then
SubtitlesSelectedIndexes.Sort()
SubtitlesSelectedIndexes.RemoveAll(Function(s) s = -1)
End If
With SubtitlesSelectedIndexes
.Clear()
Dim subs As List(Of Subtitles) = Subtitles
.ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s)))
If .Count > 0 Then .Sort() : .RemoveAll(Function(s) s = -1)
End With
End Sub
Private Sub SetElementsSubtitles(ByVal Source As YouTubeMediaContainerBase)
If Not Source Is Nothing And HasElements Then
@@ -442,6 +439,19 @@ Namespace API.YouTube.Objects
End Get
End Property
<XMLEC> Public Property Height As Integer Implements IYouTubeMediaContainer.Height
Friend ReadOnly Property HeightBase As Integer
Get
If Height > 0 Then
Return Height
ElseIf SelectedVideoIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedVideo.Height
ElseIf SelectedAudioIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedAudio.Height
Else
Return 0
End If
End Get
End Property
Protected _Bitrate As Integer = 0
<XMLEC> Public Overridable Property Bitrate As Integer Implements IYouTubeMediaContainer.Bitrate
Get
@@ -459,6 +469,20 @@ Namespace API.YouTube.Objects
Me._Bitrate = _Bitrate
End Set
End Property
Friend ReadOnly Property BitrateBase As Integer
Get
If Bitrate > 0 Then
Return Bitrate
ElseIf OutputAudioBitrate > 0 Then
Return OutputAudioBitrate
ElseIf HasElements Then
Try : Return Elements.Average(Function(e) DirectCast(e, YouTubeMediaContainerBase).BitrateBase) : Catch : End Try
ElseIf SelectedAudioIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedAudio.Bitrate
End If
Return 0
End Get
End Property
<XMLEC> Public Property DateCreated As Date = Now Implements IYouTubeMediaContainer.DateCreated
<XMLEC> Public Property DateAdded As Date Implements IYouTubeMediaContainer.DateAdded
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
@@ -656,6 +680,15 @@ Namespace API.YouTube.Objects
End If
End Set
End Property
Friend Sub FileDateUpdate()
Dim n$ = _File.Name.StringTrim
Dim s$ = IIf(n.IsEmptyString, String.Empty, " ")
Select Case MyYouTubeSettings.FileAddDateToFileName.Value
Case FileDateMode.Before : n = $"[{DateAdded:yyyy-MM-dd}]{s}{n}"
Case FileDateMode.After : n = $"{n}{s}[{DateAdded:yyyy-MM-dd}]"
End Select
_File.Name = n
End Sub
Public Property FileSettings As SFile
Private Property IUserMedia_File As String Implements IUserMedia.File
Get
@@ -966,7 +999,7 @@ Namespace API.YouTube.Objects
.Visible = True
.Value = 0
.Maximum = DownloadGetElemCountSingle()
.Information = $"Download {ObjectType}"
.Information = "Downloading"
End With
End If
@@ -1111,7 +1144,7 @@ Namespace API.YouTube.Objects
.Value = 0
.Maximum = 100
.Provider = ProgressProvider
.Information = $"Download {MediaType}"
.Information = "Downloading"
End With
End If
.MainProcessName = MyYouTubeSettings.YTDLP.Name '"yt-dlp"
@@ -1161,7 +1194,7 @@ Namespace API.YouTube.Objects
End With
If PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies)
If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing"
If prExists Then Progress.InformationTemporary = "Downloading: post processing"
_ThumbnailFile = File
_ThumbnailFile.Name &= "_thumb"
_ThumbnailFile.Extension = "jpg"
@@ -1296,6 +1329,7 @@ Namespace API.YouTube.Objects
If format = mp3 And Not mp3ThumbEmbedded And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _
embedThumbTo.Invoke(f) : mp3ThumbEmbedded = True
If Not M3U8_PlaylistFiles.ListExists AndAlso f.Exists Then M3U8_Append(f)
If format = mp3 AndAlso f.Exists AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value Then M3U8_Append(f)
End If
Next
End If
@@ -1544,7 +1578,7 @@ Namespace API.YouTube.Objects
ID = .Value("id")
Title = TitleHtmlConverter.Invoke(.Value("title"))
Description = .Value("description")
URL = .Value("webpage_url")
URL = .Value("webpage_url").ToMusicUrl(IsMusic)
PlaylistID = .Value("playlist_id")
PlaylistCount = .Value("n_entries").IfNullOrEmpty(.Value("playlist_count")).FromXML(Of Integer)(0)
@@ -1582,6 +1616,7 @@ Namespace API.YouTube.Objects
If tValue.HasValue Then Duration = TimeSpan.FromSeconds(tValue.Value)
End If
DateAdded = AConvert(Of Date)(.Value("release_date").IfNullOrEmpty(.Value("upload_date")), DateAddedProvider, New Date)
If Not IsMusic Then FileDateUpdate()
ParseFormats(.Self)

View File

@@ -115,6 +115,9 @@
<ItemGroup>
<Compile Include="Attributes\GridVisibleAttribute.vb" />
<Compile Include="Base\TableControlsProcessor.vb" />
<Compile Include="Controls\ButtonRC.vb">
<SubType>Component</SubType>
</Compile>
<Compile Include="Controls\ChannelTabsChooserForm.Designer.vb">
<DependentUpon>ChannelTabsChooserForm.vb</DependentUpon>
</Compile>

View File

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

View File

@@ -54,9 +54,8 @@ Namespace API.Base
Dim aStr$ = String.Empty
If Count > 1 Then aStr = $" ({Number}/{Count})"
Try
If Host.Source.ReadyToDownload(PDownload.SavedPosts) Then
If Host.Available(PDownload.SavedPosts, Multiple Or Count > 1) Then
Host.DownloadStarted(PDownload.SavedPosts)
If Host.Available(PDownload.SavedPosts, Multiple Or Count > 1) Then
If Host.Source.ReadyToDownload(PDownload.SavedPosts) Then
If Count > 1 Then Progress.Information = $"{Host.Name} - {Host.AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}"
Using user As IUserData = Host.GetInstance(PDownload.SavedPosts, Nothing, False, False)
If Not user Is Nothing Then
@@ -83,11 +82,11 @@ Namespace API.Base
End Using
Else
_Unavailable += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is unavailable"
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready"
End If
Else
_NotReady += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready"
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is unavailable"
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
_ErrorCount += 1
@@ -96,9 +95,6 @@ Namespace API.Base
_ErrorCount += 1
Progress.InformationTemporary = $"{Host.Name}{aStr} downloading error"
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[API.Base.ProfileSaved.Download({Host.Key}{aStr})]")
Finally
Host.DownloadDone(PDownload.SavedPosts)
MainFrameObj.UpdateLogButton()
End Try
End Sub
End Class

View File

@@ -143,7 +143,7 @@ Namespace API.Base
Protected Const Name_UserID As String = "UserID"
Protected Const Name_Options As String = "Options"
Protected Const Name_Description As String = "Description"
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Protected Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Private Const Name_IsSubscription As String = UserInfo.Name_IsSubscription
Private Const Name_Temporary As String = "Temporary"
Private Const Name_Favorite As String = "Favorite"

View File

@@ -446,6 +446,15 @@ Namespace API.Instagram
Friend Overrides Sub EndInit()
Try : MyLastRequests.Add(LastDownloadDate.Value, LastRequestsCount.Value) : Catch : End Try
If Not CBool(HH_IG_WWW_CLAIM_USE.Value) Then Responser.Headers.Remove(Header_IG_WWW_CLAIM)
If CInt(SettingsVersion.Value) < 2 Then
SettingsVersion.Value = 2
HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value = 120
HH_IG_WWW_CLAIM_ALWAYS_ZERO.Value = False
HH_IG_WWW_CLAIM_RESET_EACH_SESSION.Value = True
HH_IG_WWW_CLAIM_RESET_EACH_TARGET.Value = True
HH_IG_WWW_CLAIM_USE.Value = True
HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value = True
End If
MyBase.EndInit()
End Sub
#End Region
@@ -480,8 +489,24 @@ Namespace API.Instagram
Private ____AvailableSilent As Boolean = True
Private ____AvailableChecked As Boolean = False
Private ____AvailableResult As Boolean = False
Private Sub ResetDownloadOptions()
If ActiveJobs < 1 Then
____DownloadStarted = False
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
ActiveSessionRequestsExists = False
_NextWNM = UserData.WNM.Notify
_NextTagged = True
SkipUntilNextSession = False
AvailableText = String.Empty
ActiveJobs = 0
End If
End Sub
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If MyBase.Available(What, Silent) Then
If MyBase.Available(What, Silent) And ActiveJobs < 2 Then
If CInt(DownDetectorValue.Value) >= 0 Then
If ____DownloadStarted Then
____AvailableRequested = True
@@ -551,10 +576,9 @@ Namespace API.Instagram
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
ResetDownloadOptions()
ActiveJobs += 1
If What = Download.Main Then ____DownloadStarted = True
If ActiveJobs = 1 Then ActiveSessionDate = Now
If ActiveJobs = 1 Then ____DownloadStarted = True : ActiveSessionDate = Now
If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso
(
(CBool(HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value) AndAlso MyLastRequestsDate.AddMinutes(HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value) < Now) Or
@@ -594,18 +618,8 @@ Namespace API.Instagram
End With
End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download)
_NextWNM = UserData.WNM.Notify
_NextTagged = True
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
ResetDownloadOptions()
End Sub
#End Region
#Region "Settings"

View File

@@ -11,5 +11,6 @@ Namespace API.OnlyFans
Friend Module Declarations
Friend ReadOnly DateProvider As New ADateTime("O")
Friend ReadOnly RegExPostID As RParams = RParams.DM("(?<=onlyfans\.com/)(\d+)", 0, EDP.ReturnValue)
Friend Property Rules As DynamicRulesEnv
End Module
End Namespace

View File

@@ -0,0 +1,6 @@
https://github.com/datawhores/onlyfans-dynamic-rules/blob/main/dynamicRules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/main/dynamicRules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/patch-1/dynamicRules.json
https://github.com/DATAHOARDERS/dynamic-rules/blob/main/onlyfans.json
https://github.com/DIGITALCRIMINAL/dynamic-rules/blob/main/onlyfans.json
https://github.com/deviint/onlyfans-dynamic-rules/blob/main/dynamicRules.json

View File

@@ -0,0 +1,9 @@
https://github.com/datawhores/onlyfans-dynamic-rules/blob/main/dynamicRules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/main/dynamicRules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/patch-1/dynamicRules.json
https://github.com/DATAHOARDERS/dynamic-rules/blob/main/onlyfans.json
https://github.com/DIGITALCRIMINAL/dynamic-rules/blob/main/onlyfans.json
https://github.com/deviint/onlyfans-dynamic-rules/blob/main/dynamicRules.json
https://github.com/SneakyOvis/onlyfans-dynamic-rules/blob/main/rules.json
https://github.com/Growik/onlyfans-dynamic-rules/blob/main/rules.json

View File

@@ -0,0 +1,744 @@
' 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.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports System.Text.RegularExpressions
Namespace API.OnlyFans
Friend Structure DynamicRulesValue : Implements IComparable(Of DynamicRulesValue), IEquatable(Of DynamicRulesValue), IEContainerProvider
#Region "XML names"
Private Const Name_UrlRepo As String = "UrlRepo"
Private Const Name_UrlRaw As String = "UrlRaw"
Private Const Name_UrlLatestCommit As String = "UrlLatestCommit"
Private Const Name_UpdatedAt As String = "UpdatedAt"
Private Const Name_Broken As String = "Broken"
Private Const Name_Exists As String = "Exists"
#End Region
#Region "Declarations"
Friend UrlRepo As String
Friend UrlRaw As String
Friend UrlLatestCommit As String
Friend UpdatedAt As Date
Friend Broken As Boolean
Friend Exists As Boolean
Friend ReadOnly Property Valid As Boolean
Get
Return Not UrlRepo.IsEmptyString And Not UrlRaw.IsEmptyString
End Get
End Property
#End Region
#Region "Initializers"
Friend Sub New(ByVal e As EContainer)
UrlRepo = e.Value(Name_UrlRepo)
UrlRaw = e.Value(Name_UrlRaw)
UrlLatestCommit = e.Value(Name_UrlLatestCommit)
UpdatedAt = e.Value(Name_UpdatedAt).ToDateDef(Now.AddYears(-10))
Broken = e.Value(Name_Broken).FromXML(Of Boolean)(False)
Exists = e.Value(Name_Exists).FromXML(Of Boolean)(True)
End Sub
Public Shared Widening Operator CType(ByVal e As EContainer) As DynamicRulesValue
Return New DynamicRulesValue(e)
End Operator
Public Shared Widening Operator CType(ByVal rule As DynamicRulesValue) As String
Return rule.ToString
End Operator
#End Region
#Region "Base functions"
Public Overrides Function GetHashCode() As Integer
Return ToString.GetHashCode
End Function
Public Overrides Function ToString() As String
Return UrlRaw
End Function
#End Region
#Region "IComparable Support"
Private Function CompareTo(ByVal Other As DynamicRulesValue) As Integer Implements IComparable(Of DynamicRulesValue).CompareTo
Return UpdatedAt.CompareTo(Other.UpdatedAt) * -1
End Function
#End Region
#Region "IEquatable Support"
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) Then
If TypeOf Obj Is String Then
Dim _obj$ = CStr(Obj).StringTrim.StringToLower
Return UrlRepo = _obj Or UrlRaw = _obj
Else
Return Equals(DirectCast(Obj, DynamicRulesValue))
End If
Else
Return False
End If
End Function
Friend Overloads Function Equals(ByVal Other As DynamicRulesValue) As Boolean Implements IEquatable(Of DynamicRulesValue).Equals
Return UrlRepo = Other.UrlRepo Or UrlRaw = Other.UrlRaw
End Function
#End Region
#Region "IEContainerProvider Support"
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer("Rule") From {
New EContainer(Name_UrlRepo, UrlRepo),
New EContainer(Name_UrlRaw, UrlRaw),
New EContainer(Name_UrlLatestCommit, UrlLatestCommit),
New EContainer(Name_UpdatedAt, UpdatedAt.ToStringDateDef),
New EContainer(Name_Broken, Broken.BoolToInteger),
New EContainer(Name_Exists, Exists.BoolToInteger)
}
End Function
#End Region
End Structure
Friend Class DynamicRulesEnv : Implements ICopier, IEnumerable(Of DynamicRulesValue), IMyEnumerator(Of DynamicRulesValue), IDisposable
Friend Enum Modes As Integer
List = 0
Personal = 1
End Enum
#Region "Constants"
Friend Const UpdateIntervalDefault As Integer = 1440 '60 * 24
Friend Const DynamicRulesConfigNodeName_URL As String = "DYNAMIC_GENERIC_URL"
Friend Const DynamicRulesConfigNodeName_RULES As String = "DYNAMIC_RULE"
Friend Const DynamicRulesConfig_Mode_NodeName As String = "dynamic-mode-default"
'Friend Const DynamicRulesConfig_Mode_NodeValue As String = "generic"
Friend Const DynamicRulesConfigNodeName_URL_CONST_NAME As String = "RULE_VALUE"
#End Region
#Region "XML names"
Private Const Name_LastUpdateTimeFile As String = "LastUpdateTimeFile"
Private Const Name_LastUpdateTimeRules As String = "LastUpdateTimeRules"
Private Const Name_ProtectFile As String = "ProtectFile"
Private Const Name_UpdateInterval As String = "UpdateInterval"
Private Const Name_Mode As String = "Mode"
Private Const Name_PersonalRule As String = "PersonalRule"
Private Const Name_RulesForceUpdateRequired As String = "RulesForceUpdateRequired"
Private Const Name_AddErrorsToLog As String = "AddErrorsToLog"
Private Const Name_ConfigLastDateUpdate As String = "ConfigLastDateUpdate"
Private Const Name_ConfigAutoUpdate As String = "ConfigAutoUpdate"
Private Const Name_RulesConfigManualMode As String = "RulesConfigManualMode"
Private Const Name_RulesUpdateConst As String = "RulesUpdateConst"
Private Const Name_RulesReplaceConfig As String = "RulesReplaceConfig"
#End Region
#Region "Declarations"
Private ReadOnly Rules As List(Of DynamicRulesValue)
Friend ReadOnly Property RulesConstants As Dictionary(Of String, String)
#Region "Regex patterns"
Private ReadOnly ReplacePattern_RepoToRaw As RParams
Private ReadOnly ReplacePattern_RawToRepo As RParams
Private ReadOnly ReplacePattern_JsonInfo As RParams
Private ReadOnly ConfigRulesExtract As RParams
#End Region
#Region "Dates"
Private LastUpdateTimeFile As Date = Now.AddYears(-1)
Private LastUpdateTimeRules As Date = Now.AddYears(-1)
#End Region
#Region "Files"
Friend ReadOnly OFScraperConfigPatternFile As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json"
Friend ReadOnly OFScraperConfigPatternFileConst As SFile = $"{SettingsFolderName}\OFScraperConfigPatternConstants.txt"
Friend ReadOnly Property AuthFile As New SFile($"{SettingsFolderName}\OnlyFans_Auth.json")
Private ReadOnly DynamicRulesFile As SFile
Private ReadOnly DynamicRulesXml As SFile
Private Shared ReadOnly Property DynamicRulesFileImpl As SFile
Get
Return $"{SettingsFolderName}\OnlyFansDynamicRules.txt"
End Get
End Property
Friend Shared Sub ValidateRulesFile()
Dim f As SFile = DynamicRulesFileImpl
If Not f.Exists Then TextSaver.SaveTextToFile(My.Resources.OFResources.DynamicRules, DynamicRulesFileImpl, True)
End Sub
Friend Property ProtectFile As Boolean = False
#End Region
Friend Property UpdateInterval As Integer = UpdateIntervalDefault
Friend Property Mode As Modes = Modes.List
Friend Property PersonalRule As String = String.Empty
Friend Property RulesForceUpdateRequired As Boolean = False
Friend Property RulesUpdateConst As Boolean = True
Friend Property RulesReplaceConfig As Boolean = True
Private ReadOnly Responser As New Responser With {.Accept = "application/json"}
Private ReadOnly RulesLinesComparer As New FComparer(Of String)(Function(x, y) x.StringToLower = y.StringToLower)
Private ReadOnly OFLOG As TextSaver
Private ReadOnly OFError As ErrorsDescriber
Friend Property AddErrorsToLog As Boolean = True
Friend Property NeedToSave As Boolean = False
Private ReadOnly Property ConfigAddress As DynamicRulesValue
Private ReadOnly Property ConfigConstAddress As DynamicRulesValue
Private Property ConfigLastDateUpdate As Date = Now.AddYears(-1)
Friend Property ConfigAutoUpdate As Boolean = True
Friend Property RulesConfigManualMode As Boolean = True
#End Region
#Region "Current, Item, Count"
Private _CurrentRule As DynamicRulesValue
Private _CurrentContainer As EContainer
Private _CurrentContainerRulesText As String = String.Empty
Friend ReadOnly Property CurrentRule As DynamicRulesValue
Get
Return _CurrentRule
End Get
End Property
Friend ReadOnly Property CurrentContainer As EContainer
Get
Return _CurrentContainer
End Get
End Property
Friend ReadOnly Property CurrentContainerRulesText As String
Get
If _CurrentContainerRulesText.IsEmptyString AndAlso AuthFile.Exists Then _
_CurrentContainerRulesText = AuthFile.GetText(OFError).StringTrim
Return _CurrentContainerRulesText
End Get
End Property
Friend ReadOnly Property Exists As Boolean
Get
Return CurrentContainer.ListExists
End Get
End Property
Default Friend ReadOnly Property Item(ByVal Index As Integer) As DynamicRulesValue Implements IMyEnumerator(Of DynamicRulesValue).MyEnumeratorObject
Get
Return Rules(Index)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements IMyEnumerator(Of DynamicRulesValue).MyEnumeratorCount
Get
Return Rules.Count
End Get
End Property
#End Region
#Region "Initializer"
Friend Sub New()
Rules = New List(Of DynamicRulesValue)
DynamicRulesFile = DynamicRulesFileImpl
DynamicRulesXml = DynamicRulesFile
DynamicRulesXml.Extension = "xml"
ReplacePattern_RepoToRaw = New RParams("(.*github.com/([^/]+)/([^/]+)/blob/(.+))", Nothing, 0,
RegexReturn.ReplaceChangeListMatch, EDP.ReturnValue) With {
.PatternReplacement = "https://raw.githubusercontent.com/{2}/{3}/{4}"}
ReplacePattern_JsonInfo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_JsonInfo.PatternReplacement = "https://github.com/{2}/{3}/latest-commit/{4}"
ReplacePattern_RawToRepo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_RawToRepo.Pattern = "(.*raw.githubusercontent.com/([^/]+)/([^/]+)/([^/]+)/(.+))"
ReplacePattern_RawToRepo.PatternReplacement = "https://github.com/{2}/{3}/blob/{4}/{5}"
ConfigRulesExtract = RParams.DMS("DYNAMIC_RULE"":(\{.+?\}[\r\n]+)", 1, RegexOptions.Singleline, EDP.ReturnValue)
OFLOG = New TextSaver($"LOGs\OF_{Now:yyyyMMdd_HHmmss}.txt") With {.LogMode = True, .AutoSave = True, .AutoClear = True}
AddHandler OFLOG.TextSaved, AddressOf OFLOG_TextSaved
OFError = New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue) With {.DeclaredMessage = New MMessage With {.Loggers = {OFLOG}, .Exists = True}}
Responser.DeclaredError = OFError
Responser.ProcessExceptionDecision =
Function(ByVal Status As IResponserStatus, ByVal NullArg As Object, ByVal CurrentError As ErrorsDescriber) As ErrorsDescriber
If Status.StatusCode = Net.HttpStatusCode.NotFound Then
CurrentError.SendToLogOnlyMessage = True
Dim m As MMessage = CurrentError.DeclaredMessage.Clone
m.Text = $"Nothing found at URL: {Responser.LatestUrlString}"
CurrentError.DeclaredMessage = m
Status.ErrorException = New ErrorsDescriberException(m.Text,,, Status.ErrorException) With {.ReplaceMainMessage = True}
End If
Return CurrentError
End Function
ConfigAddress = ParseURL("https://github.com/AAndyProgram/SCrawler/blob/main/SCrawler/API/OnlyFans/OFScraperConfigPattern.json")
ConfigConstAddress = ParseURL("https://github.com/AAndyProgram/SCrawler/blob/main/SCrawler/API/OnlyFans/OFScraperConfigPatternConstants.txt")
RulesConstants = New Dictionary(Of String, String)
End Sub
#End Region
#Region "Log handlers"
Private _OFLOG_ProcessNotify As Boolean = True
Private Sub OFLOG_TextSaved(sender As Object, e As EventArgs)
If _OFLOG_ProcessNotify And AddErrorsToLog Then _OFLOG_ProcessNotify = False : MyMainLOG = $"The OnlyFans log contains errors: {OFLOG.File}"
End Sub
#End Region
#Region "ParseURL"
Private Const SiteGitHub As String = "github.com"
Private Const SiteGitHubRaw As String = "raw.githubusercontent.com"
Friend Function ParseURL(ByVal URL As String) As DynamicRulesValue
URL = URL.StringTrim
If Not URL.IsEmptyString Then
Dim r As New DynamicRulesValue
Dim rGet As Func(Of String, RParams, String) = Function(__url, pattern) DirectCast(RegexReplace(__url, pattern), IEnumerable(Of String)).FirstOrDefault
If URL.ToLower.Contains(SiteGitHubRaw) Then
r.UrlRaw = URL
r.UrlRepo = rGet(URL, ReplacePattern_RawToRepo)
ElseIf URL.ToLower.Contains(SiteGitHub) Then
r.UrlRepo = URL
r.UrlRaw = rGet(URL, ReplacePattern_RepoToRaw)
End If
If r.Valid Then
r.UpdatedAt = Now.AddYears(-1)
r.UrlLatestCommit = rGet(r.UrlRepo, ReplacePattern_JsonInfo)
r.Exists = True
Return r
End If
End If
Return Nothing
End Function
#End Region
#Region "GetFormat"
Private Shared ReadOnly Property ConfigNodes As String()
Get
Return {"advanced_options", "DYNAMIC_RULE"}
End Get
End Property
Private Const FormatMidPart As String = ":{0}:{1:x}:"
Private ReadOnly FormatExtract As RParams = RParams.DM("(\S+)\s*:\s*\{\s*\d?\s*\}\s*:\s*\{\s*\d?\s*:\s*x\s*\}\s*:\s*(\S+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
Private ReadOnly ContainerStrConv As New CustomProvider(Function(input) If(ACheck(Of Integer)(input), input, $"""{input}"""))
Private ReadOnly ContainerConv As New CustomProvider(Function(ByVal e As Object) As Object
With DirectCast(e, EContainer)
Dim value$ = String.Empty
If .ListExists Then
value = .Select(Function(ee) ee(0).Value).ListToStringE(",", ContainerStrConv, False, String.Empty, EDP.ReturnValue)
If Not value.IsEmptyString Then value = $"[{value}]"
Else
value = AConvert(Of String)(.Value, ContainerStrConv, String.Empty, EDP.SendToLog, EDP.ReturnValue)
End If
If Not value.IsEmptyString Then
value = $"""{ .Name}"": {value}"
Else
value = $"""{ .Name}"": """""
End If
Return value
End With
End Function)
Friend Shared Function GetFormat(ByVal j As EContainer, Optional ByVal Check As Boolean = False,
Optional ByRef CheckResult As Boolean = False,
Optional ByVal TryConfig As Boolean = False, Optional ByRef IsConfig As Boolean = False) As String
Dim pattern$ = String.Empty
With If(TryConfig, j(ConfigNodes), j)
If .ListExists Then
If Not .Value("format").IsEmptyString Then
pattern = .Value("format").Replace("{}", "{0}").Replace("{:x}", "{1:x}")
ElseIf Not .Value("prefix").IsEmptyString And Not .Value("suffix").IsEmptyString Then
pattern = .Value("prefix") & FormatMidPart & .Value("suffix")
ElseIf Not .Value("start").IsEmptyString And Not .Value("end").IsEmptyString Then
pattern = .Value("start") & FormatMidPart & .Value("end")
End If
Dim result As Boolean = Not pattern.IsEmptyString And .Item("checksum_indexes").ListExists And
Not .Value("static_param").IsEmptyString And Not .Value("checksum_constant").IsEmptyString
If Check Then CheckResult = result
If Not result And Not TryConfig Then Return GetFormat(j, Check, CheckResult, True, IsConfig)
End If
End With
Return pattern
End Function
Private Function ConvertAuthText() As String
Dim result$ = String.Empty
With CurrentContainer
If .ListExists Then
Dim f$ = GetFormat(.Self)
If Not f.IsEmptyString Then
Dim l As List(Of String) = RegexReplace(f, FormatExtract)
If l.ListExists(3) Then
Dim s$ = l(1), e$ = l(2)
.Value("format") = s & FormatMidPart & e
.Value("prefix") = s
.Value("suffix") = e
.Value("start") = s
.Value("end") = e
Dim t$ = .ListToStringE(",", ContainerConv, False)
If Not t.IsEmptyString Then t = "{" & t & "}"
Return t
End If
End If
End If
End With
Return String.Empty
End Function
#End Region
#Region "Load, Save"
Private Function GetTextLines(ByVal Input As String) As List(Of String)
If Not Input.IsEmptyString Then
Return ListAddList(Nothing, Input.StringTrim.Split(vbCrLf), LAP.NotContainsOnly, EDP.ReturnValue,
CType(Function(inp$) inp.StringTrim, Func(Of Object, Object)))
Else
Return New List(Of String)
End If
End Function
Private Sub ParseConsts(ByVal Source As String)
If Not Source.IsEmptyString Then
Dim l As List(Of String) = GetTextLines(Source)
Dim v$()
If l.ListExists Then
RulesConstants.Clear()
For Each value$ In l
If Not value.IsEmptyString Then
v = value.Split("=")
If v.ListExists(2) Then RulesConstants.Add(v(0), v(1))
End If
Next
End If
End If
End Sub
Private Const RulesNode As String = "Rules"
Private _InitialValuesLoaded As Boolean = False
Private Sub LoadInitialValues()
If Not _InitialValuesLoaded Then
_InitialValuesLoaded = True
If Not OFScraperConfigPatternFile.Exists Then
Dim t$ = Text.Encoding.UTF8.GetString(My.Resources.OFResources.OFScraperConfigPattern)
TextSaver.SaveTextToFile(t, OFScraperConfigPatternFile, True)
End If
If Not OFScraperConfigPatternFileConst.Exists Then _
TextSaver.SaveTextToFile(My.Resources.OFResources.OFScraperConfigPatternConstants, OFScraperConfigPatternFileConst, True)
If OFScraperConfigPatternFileConst.Exists Then ParseConsts(OFScraperConfigPatternFileConst.GetText(OFError))
If DynamicRulesXml.Exists Then
Rules.Clear()
Using x As New XmlFile(DynamicRulesXml, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData(OFError)
Dim dNull As Date = Now.AddYears(-1)
LastUpdateTimeFile = x.Value(Name_LastUpdateTimeFile).ToDateDef(dNull)
LastUpdateTimeRules = x.Value(Name_LastUpdateTimeRules).ToDateDef(dNull)
ProtectFile = x.Value(Name_ProtectFile).FromXML(Of Boolean)(False)
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.List)
UpdateInterval = x.Value(Name_UpdateInterval).FromXML(Of Integer)(UpdateIntervalDefault)
PersonalRule = x.Value(Name_PersonalRule)
RulesForceUpdateRequired = x.Value(Name_RulesForceUpdateRequired).FromXML(Of Boolean)(False)
RulesUpdateConst = x.Value(Name_RulesUpdateConst).FromXML(Of Boolean)(True)
RulesReplaceConfig = x.Value(Name_RulesReplaceConfig).FromXML(Of Boolean)(True)
AddErrorsToLog = x.Value(Name_AddErrorsToLog).FromXML(Of Boolean)(False)
ConfigAutoUpdate = x.Value(Name_ConfigAutoUpdate).FromXML(Of Boolean)(True)
RulesConfigManualMode = x.Value(Name_RulesConfigManualMode).FromXML(Of Boolean)(True)
ConfigLastDateUpdate = x.Value(Name_ConfigLastDateUpdate).ToDateDef(Now.AddYears(-1))
If x.Contains(RulesNode) Then Rules.ListAddList(x({RulesNode}), LAP.IgnoreICopier, OFError)
End Using
End If
End If
End Sub
Friend Sub Save()
Using x As New XmlFile With {.AllowSameNames = True, .Name = "DynamicRules"}
x.Add(Name_LastUpdateTimeFile, LastUpdateTimeFile.ToStringDateDef)
x.Add(Name_LastUpdateTimeRules, LastUpdateTimeRules.ToStringDateDef)
x.Add(Name_ProtectFile, ProtectFile.BoolToInteger)
x.Add(Name_Mode, CInt(Mode))
x.Add(Name_UpdateInterval, UpdateInterval)
x.Add(Name_PersonalRule, PersonalRule)
x.Add(Name_RulesForceUpdateRequired, RulesForceUpdateRequired.BoolToInteger)
x.Add(Name_RulesUpdateConst, RulesUpdateConst.BoolToInteger)
x.Add(Name_RulesReplaceConfig, RulesReplaceConfig.BoolToInteger)
x.Add(Name_AddErrorsToLog, AddErrorsToLog.BoolToInteger)
x.Add(Name_ConfigAutoUpdate, ConfigAutoUpdate.BoolToInteger)
x.Add(Name_RulesConfigManualMode, RulesConfigManualMode.BoolToInteger)
x.Add(Name_ConfigLastDateUpdate, ConfigLastDateUpdate.ToStringDateDef)
If Count > 0 Then
Rules.Sort()
x.Add(New EContainer(RulesNode))
x.Last.AddRange(Rules)
End If
x.Save(DynamicRulesXml, OFError)
End Using
If Count > 0 Then
Using t As New TextSaver(DynamicRulesFile)
Rules.ForEach(Sub(r) If Not r.UrlRepo.IsEmptyString Then t.AppendLine(r.UrlRepo))
t.Save(OFError)
End Using
End If
End Sub
#End Region
#Region "Update"
Private _UpdateInProgress As Boolean = False
Private _ForcedUpdate As Boolean = False
Friend Function Update(ByVal Force As Boolean, Optional ByVal LoadListOnly As Boolean = False) As Boolean
Dim skip As Boolean = _UpdateInProgress
If skip And _ForcedUpdate Then Force = False
_ForcedUpdate = Force
While _UpdateInProgress : Threading.Thread.Sleep(200) : End While
If Not skip Or Force Then UpdateImpl(Force Or RulesForceUpdateRequired, LoadListOnly)
Return Exists
End Function
Private Sub UpdateImpl(ByVal Force As Boolean, Optional ByVal LoadListOnly As Boolean = False)
Try
If Not _UpdateInProgress Then
_UpdateInProgress = True
LoadInitialValues()
Dim r$
Dim process As Boolean = False, updated As Boolean = False
Dim forceSave As Boolean = RulesForceUpdateRequired Or Not DynamicRulesFile.Exists Or Not DynamicRulesXml.Exists
Dim textLocal As List(Of String)
Dim i%
Dim rule As DynamicRulesValue
Dim e As EContainer
Dim errDate As Date = Now.AddYears(-1)
Dim d As Date?
'2024-06-12T12:44:06.000-05:00
Dim dateProvider As New ADateTime("yyyy-MM-ddTHH:mm:ss.fff%K")
RulesForceUpdateRequired = False
If Not DynamicRulesFile.Exists Then process = True : ValidateRulesFile()
'update rules list
If Not LoadListOnly And (LastUpdateTimeFile.AddMinutes(UpdateInterval) < Now Or process Or Force) Then
LastUpdateTimeFile = Now
r = Responser.GetResponse("https://raw.githubusercontent.com/AAndyProgram/SCrawler/main/SCrawler/API/OnlyFans/DynamicRules.txt")
If Not r.IsEmptyString Then
Dim textWeb As List(Of String) = GetTextLines(r)
Dim fileText$
If textWeb.ListExists Then
Using t As New TextSaver(DynamicRulesFile)
If ProtectFile Then
fileText = DynamicRulesFile.GetText(OFError)
t.Append(fileText)
textLocal = GetTextLines(fileText)
If textLocal.ListExists Then _
textLocal.ForEach(Sub(tt) If Not tt.IsEmptyString AndAlso Not textWeb.Contains(tt, RulesLinesComparer) Then _
t.AppendLine(tt) : updated = True) : textLocal.Clear()
Else
t.Append(r)
updated = True
End If
t.Save(OFError)
End Using
textWeb.Clear()
End If
End If
End If
'update config and consts
If Not LoadListOnly AndAlso ConfigAutoUpdate AndAlso ConfigLastDateUpdate.AddMinutes(UpdateInterval) < Now Then
Dim __upConf As Boolean = False
Dim __dConf As Date = ConfigLastDateUpdate
Dim parseConfigFiles As Action(Of DynamicRulesValue, SFile, Boolean) =
Sub(ByVal __rule As DynamicRulesValue, ByVal __fileSave As SFile, ByVal isConstFile As Boolean)
r = Responser.GetResponse(__rule.UrlLatestCommit)
If Not r.IsEmptyString Then
e = JsonDocument.Parse(r, OFError)
If e.ListExists Then
d = AConvert(Of Date)(e.Value("date"), dateProvider, Nothing)
Dim dConf As Date = If(d, errDate)
If dConf > __dConf Then
__dConf = dConf
__upConf = True
updated = True
r = Responser.GetResponse(__rule.UrlRaw)
If Not r.IsEmptyString Then
TextSaver.SaveTextToFile(r, __fileSave, True, False, OFError)
If isConstFile Then ParseConsts(r)
End If
End If
e.Dispose()
End If
End If
End Sub
'Update consts
If RulesUpdateConst Then parseConfigFiles(ConfigConstAddress, OFScraperConfigPatternFileConst, True)
'Update config
parseConfigFiles(ConfigAddress, OFScraperConfigPatternFile, False)
If __upConf Then ConfigLastDateUpdate = Now
End If
'generate rules, update rules dates
If LastUpdateTimeRules.AddMinutes(UpdateInterval) < Now Or updated Or Force Or LoadListOnly Then
process = True
If Mode = Modes.Personal And Not PersonalRule.IsEmptyString Then
If Not LoadListOnly Then LastUpdateTimeRules = Now : updated = True
Else
If Not LoadListOnly Then LastUpdateTimeRules = Now : updated = True
textLocal = GetTextLines(DynamicRulesFile.GetText(OFError))
If textLocal.ListExists Then
For Each url$ In textLocal
url = url.StringTrim
If Not url.IsEmptyString Then
i = IndexOf(url)
If i >= 0 Then
rule = Rules(i)
Else
rule = ParseURL(url)
If rule.Valid Then
i = Add(rule, False, False)
Else
rule = Nothing
End If
End If
If Not LoadListOnly Then
If i >= 0 And rule.Valid And Not rule.UrlLatestCommit.IsEmptyString Then
r = Responser.GetResponse(rule.UrlLatestCommit)
If Not r.IsEmptyString Then
e = JsonDocument.Parse(r, OFError)
If e.ListExists Then
d = AConvert(Of Date)(e.Value("date"), dateProvider, Nothing)
rule.UpdatedAt = If(d, errDate)
e.Dispose()
Else
rule.Broken = True
End If
Else
rule.Broken = True
End If
Rules(i) = rule
End If
End If
End If
Next
End If
End If
End If
If Count > 0 Then Rules.Sort()
'download and load the rule
If (LoadListOnly And AuthFile.Exists) Or (Not LoadListOnly And ((updated And Count > 0) Or Not AuthFile.Exists)) Then
_CurrentRule = Nothing
_CurrentContainer.DisposeIfReady
_CurrentContainer = Nothing
Dim processRule As Func(Of DynamicRulesValue, Boolean, DialogResult) =
Function(ByVal __rule As DynamicRulesValue, ByVal reparseAuth As Boolean) As DialogResult
Dim fromAuthFile As Boolean = (LoadListOnly Or reparseAuth) AndAlso AuthFile.Exists
If fromAuthFile Then
r = AuthFile.GetText(OFError)
Else
r = GetWebString(__rule.UrlRaw,, OFError)
End If
Dim j As EContainer = JsonDocument.Parse(r, OFError)
Dim checkResult As Boolean = False
Dim isConfig As Boolean = False
Dim textToSave As String = r
If j.ListExists AndAlso Not GetFormat(j, True, checkResult,, isConfig).IsEmptyString AndAlso checkResult Then
If isConfig Then textToSave = RegexReplace(r, ConfigRulesExtract)
If textToSave.IsEmptyString Then
Return DialogResult.Retry
Else
_CurrentRule = __rule
_CurrentContainer = If(isConfig, j(ConfigNodes), j)
textToSave = ConvertAuthText()
_CurrentContainerRulesText = textToSave
If (Not fromAuthFile Or Not textToSave.StringTrim = r.StringTrim) And Not textToSave.IsEmptyString Then
TextSaver.SaveTextToFile(textToSave, AuthFile, True, False, OFError)
If Not reparseAuth Then processRule(__rule, True)
End If
Return DialogResult.OK
End If
End If
Return DialogResult.No
End Function
If Mode = Modes.Personal And Not PersonalRule.IsEmptyString Then
processRule(New DynamicRulesValue With {.UrlRepo = PersonalRule, .UrlRaw = PersonalRule}, False)
Else
For Each rule In Rules
If rule.Valid And Not rule.Broken Then
Select Case processRule(rule, False)
Case DialogResult.Retry : Continue For
Case DialogResult.OK : Exit For
End Select
End If
Next
End If
End If
If updated Or forceSave Then Save()
_UpdateInProgress = False
End If
Catch ex As Exception
ErrorsDescriber.Execute(OFError, ex, "[OnlyFans.DynamicRulesEnv.UpdateImpl]")
_UpdateInProgress = False
End Try
End Sub
#End Region
#Region "Add, IndexOf"
Friend Function Add(ByVal Rule As DynamicRulesValue, Optional ByVal AutoSort As Boolean = True, Optional ByVal AutoSave As Boolean = False) As Integer
If Rule.Valid Then
Dim i% = IndexOf(Rule)
If i = -1 Then
Rules.Add(Rule)
i = Count - 1
If AutoSort Then Rules.Sort() : i = IndexOf(Rule)
If AutoSave Then Save()
End If
Return i
Else
Return -1
End If
End Function
Friend Function RemoveAt(ByVal Index As Integer) As Boolean
If Index.ValueBetween(0, Count - 1) Then
Rules.RemoveAt(Index)
Return True
Else
Return False
End If
End Function
Friend Function IndexOf(ByVal URL As String) As Integer
If Count > 0 Then
URL = URL.StringToLower.Trim
Return Rules.FindIndex(Function(r) r.UrlRepo.StringToLower = URL Or r.UrlRaw.StringToLower = URL Or r.UrlLatestCommit.StringToLower = URL)
Else
Return -1
End If
End Function
#End Region
#Region "ICopier Support"
Friend Overloads Function Copy() As Object Implements ICopier.Copy
Return (New DynamicRulesEnv).Copy(Me)
End Function
Friend Overloads Function Copy(ByVal Source As Object) As Object Implements ICopier.Copy
Return Copy(Source, False)
End Function
Friend Overloads Function Copy(ByVal Source As Object, ByVal UpdateForceProperty As Boolean) As Object
If Not Source Is Nothing Then
With DirectCast(Source, DynamicRulesEnv)
If Not RulesForceUpdateRequired And UpdateForceProperty Then _
RulesForceUpdateRequired = Not Rules.ListEquals(.Rules) Or Not Mode = .Mode Or
(.Mode = Modes.Personal And Not PersonalRule = .PersonalRule)
ProtectFile = .ProtectFile
Mode = .Mode
UpdateInterval = .UpdateInterval
PersonalRule = .PersonalRule
If Not RulesForceUpdateRequired Then RulesForceUpdateRequired = .RulesForceUpdateRequired
RulesUpdateConst = .RulesUpdateConst
RulesReplaceConfig = .RulesReplaceConfig
AddErrorsToLog = .AddErrorsToLog
ConfigAutoUpdate = .ConfigAutoUpdate
RulesConfigManualMode = .RulesConfigManualMode
Rules.Clear()
If .Count > 0 Then Rules.AddRange(.Rules)
End With
Return Me
Else
Return Nothing
End If
End Function
#End Region
#Region "IEnumerable Support"
Private Function GetEnumerator() As IEnumerator(Of DynamicRulesValue) Implements IEnumerable(Of DynamicRulesValue).GetEnumerator
Return New MyEnumerator(Of DynamicRulesValue)(Me)
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
Rules.Clear()
_CurrentContainer.DisposeIfReady
Responser.DisposeIfReady
End If
_CurrentContainer = Nothing
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 Namespace

View File

@@ -64,6 +64,20 @@ Namespace My.Resources
End Set
End Property
'''<summary>
''' Looks up a localized string similar to https://github.com/datawhores/onlyfans-dynamic-rules/blob/main/dynamicRules.json
'''https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/main/dynamicRules.json
'''https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/patch-1/dynamicRules.json
'''https://github.com/DATAHOARDERS/dynamic-rules/blob/main/onlyfans.json
'''https://github.com/DIGITALCRIMINAL/dynamic-rules/blob/main/onlyfans.json
'''https://github.com/deviint/onlyfans-dynamic-rules/blob/main/dynamicRules.json.
'''</summary>
Friend Shared ReadOnly Property DynamicRules() As String
Get
Return ResourceManager.GetString("DynamicRules", resourceCulture)
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Byte[].
'''</summary>
@@ -73,5 +87,15 @@ Namespace My.Resources
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' Looks up a localized string similar to dynamic-mode-default=generic
'''RULE_VALUE=DYNAMIC_GENERIC_URL.
'''</summary>
Friend Shared ReadOnly Property OFScraperConfigPatternConstants() As String
Get
Return ResourceManager.GetString("OFScraperConfigPatternConstants", resourceCulture)
End Get
End Property
End Class
End Namespace

View File

@@ -118,7 +118,13 @@
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
<data name="DynamicRules" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>DynamicRules.txt;System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089;utf-8</value>
</data>
<data name="OFScraperConfigPattern" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>OFScraperConfigPattern.json;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="OFScraperConfigPatternConstants" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>OFScraperConfigPatternConstants.txt;System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089;utf-8</value>
</data>
</root>

View File

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

View File

@@ -0,0 +1,2 @@
dynamic-mode-default=generic
RULE_VALUE=DYNAMIC_GENERIC_URL

View File

@@ -0,0 +1,361 @@
' 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.OnlyFans
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class OnlyFansAdvancedSettingsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(OnlyFansAdvancedSettingsForm))
Dim ActionButton8 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton9 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_RULES_LIST As System.Windows.Forms.TableLayoutPanel
Dim TP_RULES_LIST_LEFT As System.Windows.Forms.TableLayoutPanel
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.TXT_UP_INTERVAL = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_PERSONAL_RULE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CONTAINER_LIST = New System.Windows.Forms.ToolStripContainer()
Me.LIST_RULES = New System.Windows.Forms.ListBox()
Me.OPT_RULES_LIST = New System.Windows.Forms.RadioButton()
Me.CH_PROTECTED = New System.Windows.Forms.CheckBox()
Me.CH_FORCE_UPDATE = New System.Windows.Forms.CheckBox()
Me.CH_LOG_ERR = New System.Windows.Forms.CheckBox()
Me.CH_RULES_REPLACE_CONFIG = New System.Windows.Forms.CheckBox()
Me.CH_UPDATE_CONF = New System.Windows.Forms.CheckBox()
Me.CH_UPDATE_RULES_CONST = New System.Windows.Forms.CheckBox()
Me.CH_CONFIG_MANUAL_MODE = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_RULES_LIST = New System.Windows.Forms.TableLayoutPanel()
TP_RULES_LIST_LEFT = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_UP_INTERVAL, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_PERSONAL_RULE, System.ComponentModel.ISupportInitialize).BeginInit()
TP_RULES_LIST.SuspendLayout()
Me.CONTAINER_LIST.ContentPanel.SuspendLayout()
Me.CONTAINER_LIST.SuspendLayout()
TP_RULES_LIST_LEFT.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(464, 341)
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(464, 341)
CONTAINER_MAIN.TabIndex = 1
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.Controls.Add(Me.TXT_UP_INTERVAL, 0, 5)
TP_MAIN.Controls.Add(Me.TXT_PERSONAL_RULE, 0, 6)
TP_MAIN.Controls.Add(TP_RULES_LIST, 0, 7)
TP_MAIN.Controls.Add(Me.CH_LOG_ERR, 0, 0)
TP_MAIN.Controls.Add(Me.CH_RULES_REPLACE_CONFIG, 0, 1)
TP_MAIN.Controls.Add(Me.CH_UPDATE_CONF, 0, 4)
TP_MAIN.Controls.Add(Me.CH_UPDATE_RULES_CONST, 0, 2)
TP_MAIN.Controls.Add(Me.CH_CONFIG_MANUAL_MODE, 0, 3)
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 = 8
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.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.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(464, 341)
TP_MAIN.TabIndex = 0
'
'TXT_UP_INTERVAL
'
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Name = "Refresh"
ActionButton7.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton8.BackgroundImage = CType(resources.GetObject("ActionButton8.BackgroundImage"), System.Drawing.Image)
ActionButton8.Name = "Clear"
ActionButton8.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_UP_INTERVAL.Buttons.Add(ActionButton7)
Me.TXT_UP_INTERVAL.Buttons.Add(ActionButton8)
Me.TXT_UP_INTERVAL.CaptionText = "Dynamic rules update"
Me.TXT_UP_INTERVAL.CaptionToolTipEnabled = True
Me.TXT_UP_INTERVAL.CaptionToolTipText = "'Dynamic rules' update interval (minutes). Default: 1440"
Me.TXT_UP_INTERVAL.CaptionWidth = 120.0R
Me.TXT_UP_INTERVAL.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_UP_INTERVAL.Location = New System.Drawing.Point(4, 134)
Me.TXT_UP_INTERVAL.Name = "TXT_UP_INTERVAL"
Me.TXT_UP_INTERVAL.Size = New System.Drawing.Size(456, 22)
Me.TXT_UP_INTERVAL.TabIndex = 5
'
'TXT_PERSONAL_RULE
'
Me.TXT_PERSONAL_RULE.AutoShowClearButton = True
ActionButton9.BackgroundImage = CType(resources.GetObject("ActionButton9.BackgroundImage"), System.Drawing.Image)
ActionButton9.Enabled = False
ActionButton9.Name = "Clear"
ActionButton9.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton9.Visible = False
Me.TXT_PERSONAL_RULE.Buttons.Add(ActionButton9)
Me.TXT_PERSONAL_RULE.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.RadioButton
Me.TXT_PERSONAL_RULE.CaptionText = "Dynamic rules URL"
Me.TXT_PERSONAL_RULE.CaptionToolTipEnabled = True
Me.TXT_PERSONAL_RULE.CaptionToolTipText = "Overwrite 'Dynamic rules' with this URL." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Change this value only if you know what" &
" you are doing."
Me.TXT_PERSONAL_RULE.CaptionWidth = 120.0R
Me.TXT_PERSONAL_RULE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_PERSONAL_RULE.LeaveDefaultButtons = True
Me.TXT_PERSONAL_RULE.Location = New System.Drawing.Point(4, 163)
Me.TXT_PERSONAL_RULE.Name = "TXT_PERSONAL_RULE"
Me.TXT_PERSONAL_RULE.Size = New System.Drawing.Size(456, 22)
Me.TXT_PERSONAL_RULE.TabIndex = 6
'
'TP_RULES_LIST
'
TP_RULES_LIST.ColumnCount = 2
TP_RULES_LIST.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 120.0!))
TP_RULES_LIST.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST.Controls.Add(Me.CONTAINER_LIST, 1, 0)
TP_RULES_LIST.Controls.Add(TP_RULES_LIST_LEFT, 0, 0)
TP_RULES_LIST.Dock = System.Windows.Forms.DockStyle.Fill
TP_RULES_LIST.Location = New System.Drawing.Point(4, 192)
TP_RULES_LIST.Name = "TP_RULES_LIST"
TP_RULES_LIST.RowCount = 1
TP_RULES_LIST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST.Size = New System.Drawing.Size(456, 145)
TP_RULES_LIST.TabIndex = 7
'
'CONTAINER_LIST
'
Me.CONTAINER_LIST.BottomToolStripPanelVisible = False
'
'CONTAINER_LIST.ContentPanel
'
Me.CONTAINER_LIST.ContentPanel.Controls.Add(Me.LIST_RULES)
Me.CONTAINER_LIST.ContentPanel.Size = New System.Drawing.Size(330, 114)
Me.CONTAINER_LIST.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_LIST.LeftToolStripPanelVisible = False
Me.CONTAINER_LIST.Location = New System.Drawing.Point(123, 3)
Me.CONTAINER_LIST.Name = "CONTAINER_LIST"
Me.CONTAINER_LIST.RightToolStripPanelVisible = False
Me.CONTAINER_LIST.Size = New System.Drawing.Size(330, 139)
Me.CONTAINER_LIST.TabIndex = 1
'
'LIST_RULES
'
Me.LIST_RULES.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_RULES.FormattingEnabled = True
Me.LIST_RULES.Location = New System.Drawing.Point(0, 0)
Me.LIST_RULES.Name = "LIST_RULES"
Me.LIST_RULES.Size = New System.Drawing.Size(330, 114)
Me.LIST_RULES.TabIndex = 0
'
'TP_RULES_LIST_LEFT
'
TP_RULES_LIST_LEFT.ColumnCount = 1
TP_RULES_LIST_LEFT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST_LEFT.Controls.Add(Me.OPT_RULES_LIST, 0, 0)
TP_RULES_LIST_LEFT.Controls.Add(Me.CH_PROTECTED, 0, 1)
TP_RULES_LIST_LEFT.Controls.Add(Me.CH_FORCE_UPDATE, 0, 2)
TP_RULES_LIST_LEFT.Dock = System.Windows.Forms.DockStyle.Fill
TP_RULES_LIST_LEFT.Location = New System.Drawing.Point(0, 0)
TP_RULES_LIST_LEFT.Margin = New System.Windows.Forms.Padding(0)
TP_RULES_LIST_LEFT.Name = "TP_RULES_LIST_LEFT"
TP_RULES_LIST_LEFT.RowCount = 4
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST_LEFT.Size = New System.Drawing.Size(120, 145)
TP_RULES_LIST_LEFT.TabIndex = 0
'
'OPT_RULES_LIST
'
Me.OPT_RULES_LIST.AutoSize = True
Me.OPT_RULES_LIST.CheckAlign = System.Drawing.ContentAlignment.MiddleRight
Me.OPT_RULES_LIST.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_RULES_LIST.Location = New System.Drawing.Point(3, 3)
Me.OPT_RULES_LIST.Margin = New System.Windows.Forms.Padding(3, 3, 0, 3)
Me.OPT_RULES_LIST.Name = "OPT_RULES_LIST"
Me.OPT_RULES_LIST.Size = New System.Drawing.Size(117, 19)
Me.OPT_RULES_LIST.TabIndex = 0
Me.OPT_RULES_LIST.TabStop = True
Me.OPT_RULES_LIST.Text = "Dynamic rules list"
Me.OPT_RULES_LIST.TextAlign = System.Drawing.ContentAlignment.MiddleRight
TT_MAIN.SetToolTip(Me.OPT_RULES_LIST, "List of dynamic rules sources." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "If selected, the most recently updated source wil" &
"l be selected.")
Me.OPT_RULES_LIST.UseVisualStyleBackColor = True
'
'CH_PROTECTED
'
Me.CH_PROTECTED.AutoSize = True
Me.CH_PROTECTED.CheckAlign = System.Drawing.ContentAlignment.MiddleRight
Me.CH_PROTECTED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_PROTECTED.Location = New System.Drawing.Point(3, 28)
Me.CH_PROTECTED.Margin = New System.Windows.Forms.Padding(3, 3, 0, 3)
Me.CH_PROTECTED.Name = "CH_PROTECTED"
Me.CH_PROTECTED.Size = New System.Drawing.Size(117, 19)
Me.CH_PROTECTED.TabIndex = 1
Me.CH_PROTECTED.Text = "Protected list"
Me.CH_PROTECTED.TextAlign = System.Drawing.ContentAlignment.MiddleRight
TT_MAIN.SetToolTip(Me.CH_PROTECTED, "If checked, the new source will be added, but the rules list will not be overwrit" &
"ten by the updated one.")
Me.CH_PROTECTED.UseVisualStyleBackColor = True
'
'CH_FORCE_UPDATE
'
Me.CH_FORCE_UPDATE.AutoSize = True
Me.CH_FORCE_UPDATE.CheckAlign = System.Drawing.ContentAlignment.MiddleRight
Me.CH_FORCE_UPDATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FORCE_UPDATE.Location = New System.Drawing.Point(3, 53)
Me.CH_FORCE_UPDATE.Margin = New System.Windows.Forms.Padding(3, 3, 0, 3)
Me.CH_FORCE_UPDATE.Name = "CH_FORCE_UPDATE"
Me.CH_FORCE_UPDATE.Size = New System.Drawing.Size(117, 19)
Me.CH_FORCE_UPDATE.TabIndex = 2
Me.CH_FORCE_UPDATE.Text = "Force update"
Me.CH_FORCE_UPDATE.TextAlign = System.Drawing.ContentAlignment.MiddleRight
TT_MAIN.SetToolTip(Me.CH_FORCE_UPDATE, "Check this if you want to force the rules to update.")
Me.CH_FORCE_UPDATE.UseVisualStyleBackColor = True
'
'CH_LOG_ERR
'
Me.CH_LOG_ERR.AutoSize = True
Me.CH_LOG_ERR.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_LOG_ERR.Location = New System.Drawing.Point(4, 4)
Me.CH_LOG_ERR.Name = "CH_LOG_ERR"
Me.CH_LOG_ERR.Size = New System.Drawing.Size(456, 19)
Me.CH_LOG_ERR.TabIndex = 0
Me.CH_LOG_ERR.Text = "Add dynamic rules errors to the log"
TT_MAIN.SetToolTip(Me.CH_LOG_ERR, "OnlyFans errors will be added to a separate log." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "A checked checkbox means that e" &
"rror notification will be added to the main log.")
Me.CH_LOG_ERR.UseVisualStyleBackColor = True
'
'CH_RULES_REPLACE_CONFIG
'
Me.CH_RULES_REPLACE_CONFIG.AutoSize = True
Me.CH_RULES_REPLACE_CONFIG.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_RULES_REPLACE_CONFIG.Location = New System.Drawing.Point(4, 30)
Me.CH_RULES_REPLACE_CONFIG.Name = "CH_RULES_REPLACE_CONFIG"
Me.CH_RULES_REPLACE_CONFIG.Size = New System.Drawing.Size(456, 19)
Me.CH_RULES_REPLACE_CONFIG.TabIndex = 1
Me.CH_RULES_REPLACE_CONFIG.Text = "Replace rules in OF-Scraper configuration file"
TT_MAIN.SetToolTip(Me.CH_RULES_REPLACE_CONFIG, "If checked, the dynamic rules (in the config) will be replaced with actual values" &
".")
Me.CH_RULES_REPLACE_CONFIG.UseVisualStyleBackColor = True
'
'CH_UPDATE_CONF
'
Me.CH_UPDATE_CONF.AutoSize = True
Me.CH_UPDATE_CONF.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_UPDATE_CONF.Location = New System.Drawing.Point(4, 108)
Me.CH_UPDATE_CONF.Name = "CH_UPDATE_CONF"
Me.CH_UPDATE_CONF.Size = New System.Drawing.Size(456, 19)
Me.CH_UPDATE_CONF.TabIndex = 4
Me.CH_UPDATE_CONF.Text = "Update configuration file during update"
TT_MAIN.SetToolTip(Me.CH_UPDATE_CONF, "Update the configuration pattern from the site during update.")
Me.CH_UPDATE_CONF.UseVisualStyleBackColor = True
'
'CH_UPDATE_RULES_CONST
'
Me.CH_UPDATE_RULES_CONST.AutoSize = True
Me.CH_UPDATE_RULES_CONST.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_UPDATE_RULES_CONST.Location = New System.Drawing.Point(4, 56)
Me.CH_UPDATE_RULES_CONST.Name = "CH_UPDATE_RULES_CONST"
Me.CH_UPDATE_RULES_CONST.Size = New System.Drawing.Size(456, 19)
Me.CH_UPDATE_RULES_CONST.TabIndex = 2
Me.CH_UPDATE_RULES_CONST.Text = "Update rules constants file during update"
TT_MAIN.SetToolTip(Me.CH_UPDATE_RULES_CONST, "Update rules constants from the site during update")
Me.CH_UPDATE_RULES_CONST.UseVisualStyleBackColor = True
'
'CH_CONFIG_MANUAL_MODE
'
Me.CH_CONFIG_MANUAL_MODE.AutoSize = True
Me.CH_CONFIG_MANUAL_MODE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_CONFIG_MANUAL_MODE.Location = New System.Drawing.Point(4, 82)
Me.CH_CONFIG_MANUAL_MODE.Name = "CH_CONFIG_MANUAL_MODE"
Me.CH_CONFIG_MANUAL_MODE.Size = New System.Drawing.Size(456, 19)
Me.CH_CONFIG_MANUAL_MODE.TabIndex = 3
Me.CH_CONFIG_MANUAL_MODE.Text = "Dynamic rules 'Manual' mode"
TT_MAIN.SetToolTip(Me.CH_CONFIG_MANUAL_MODE, "The rules will be added to the config as is, without using a link.")
Me.CH_CONFIG_MANUAL_MODE.UseVisualStyleBackColor = True
'
'OnlyFansAdvancedSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(464, 341)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = Global.SCrawler.My.Resources.SiteResources.OnlyFansIcon_32
Me.KeyPreview = True
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(480, 380)
Me.Name = "OnlyFansAdvancedSettingsForm"
Me.ShowInTaskbar = False
Me.Text = "Settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
CType(Me.TXT_UP_INTERVAL, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_PERSONAL_RULE, System.ComponentModel.ISupportInitialize).EndInit()
TP_RULES_LIST.ResumeLayout(False)
Me.CONTAINER_LIST.ContentPanel.ResumeLayout(False)
Me.CONTAINER_LIST.ResumeLayout(False)
Me.CONTAINER_LIST.PerformLayout()
TP_RULES_LIST_LEFT.ResumeLayout(False)
TP_RULES_LIST_LEFT.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents TXT_UP_INTERVAL As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_PERSONAL_RULE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CONTAINER_LIST As ToolStripContainer
Private WithEvents LIST_RULES As ListBox
Private WithEvents OPT_RULES_LIST As RadioButton
Private WithEvents CH_PROTECTED As CheckBox
Private WithEvents CH_FORCE_UPDATE As CheckBox
Private WithEvents CH_LOG_ERR As CheckBox
Private WithEvents CH_RULES_REPLACE_CONFIG As CheckBox
Private WithEvents CH_UPDATE_CONF As CheckBox
Private WithEvents CH_UPDATE_RULES_CONST As CheckBox
Private WithEvents CH_CONFIG_MANUAL_MODE As CheckBox
End Class
End Namespace

View File

@@ -0,0 +1,186 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TP_RULES_LIST.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_RULES_LIST_LEFT.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="TP_RULES_LIST_LEFT.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
</root>

View File

@@ -0,0 +1,165 @@
' 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 PersonalUtilities.Forms.Toolbars
Namespace API.OnlyFans
Friend Class OnlyFansAdvancedSettingsForm
#Region "Declarations"
Private WithEvents MyDefs As DefaultFormOptions
Friend Property CurrentRulesEnv As DynamicRulesEnv
Private ReadOnly Property CurrentRulesEnv_LIST As DynamicRulesEnv
#End Region
#Region "Initializer"
Friend Sub New(ByVal rules As DynamicRulesEnv)
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
CurrentRulesEnv = rules
CurrentRulesEnv_LIST = New DynamicRulesEnv
CurrentRulesEnv_LIST.Copy(rules, False)
End Sub
#End Region
#Region "Form handlers"
Private Sub OnlyFansAdvancedSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
.MyEditToolbar = New EditToolbar(Me,, CONTAINER_LIST.TopToolStripPanel) With {.Buttons = Nothing}
.MyEditToolbar.AddThisToolbar()
With CurrentRulesEnv
Select Case .Mode
Case DynamicRulesEnv.Modes.List : OPT_RULES_LIST.Checked = True
Case DynamicRulesEnv.Modes.Personal : TXT_PERSONAL_RULE.Checked = True
End Select
CH_LOG_ERR.Checked = .AddErrorsToLog
CH_RULES_REPLACE_CONFIG.Checked = .RulesReplaceConfig
CH_UPDATE_RULES_CONST.Checked = .RulesUpdateConst
CH_CONFIG_MANUAL_MODE.Checked = .RulesConfigManualMode
CH_UPDATE_CONF.Checked = .ConfigAutoUpdate
TXT_UP_INTERVAL.Text = .UpdateInterval
If Not .PersonalRule.IsEmptyString Then TXT_PERSONAL_RULE.Text = .PersonalRule
Refill()
CH_PROTECTED.Checked = .ProtectFile
CH_FORCE_UPDATE.Checked = .RulesForceUpdateRequired
End With
.MyFieldsCheckerE = New FieldsChecker
.MyFieldsCheckerE.AddControl(Of Integer)(TXT_UP_INTERVAL, TXT_UP_INTERVAL.CaptionText,,
New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0, EDP.ReturnValue) > 0, v, Nothing),
"The value of [{0}] field must be greater than 0"))
.MyFieldsCheckerE.EndLoaderOperations()
.EndLoaderOperations()
End With
End Sub
Private Sub OnlyFansAdvancedSettingsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
CurrentRulesEnv_LIST.Dispose()
End Sub
#End Region
#Region "Refill"
Private Sub Refill()
With CurrentRulesEnv_LIST
Dim ls% = _LatestSelected
LIST_RULES.Items.Clear()
If .Count > 0 Then LIST_RULES.Items.AddRange(.Select(Function(r) r.UrlRepo).Cast(Of Object).ToArray)
Dim lim% = LIST_RULES.Items.Count - 1
If (ls - 1).ValueBetween(0, lim) Then
ls -= 1
ElseIf (ls + 1).ValueBetween(0, lim) Then
ls += 1
End If
If ls.ValueBetween(0, lim) Then LIST_RULES.SelectedIndex = ls Else ls = -1
_LatestSelected = ls
End With
End Sub
#End Region
#Region "OK, Cancel"
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then
With CurrentRulesEnv
.Copy(CurrentRulesEnv_LIST, True)
.ProtectFile = CH_PROTECTED.Checked
.UpdateInterval = AConvert(Of Integer)(TXT_UP_INTERVAL.Text, DynamicRulesEnv.UpdateIntervalDefault)
.Mode = If(TXT_PERSONAL_RULE.Checked, DynamicRulesEnv.Modes.Personal, DynamicRulesEnv.Modes.List)
.PersonalRule = TXT_PERSONAL_RULE.Text
.RulesReplaceConfig = CH_RULES_REPLACE_CONFIG.Checked
.RulesUpdateConst = CH_UPDATE_RULES_CONST.Checked
.RulesConfigManualMode = CH_CONFIG_MANUAL_MODE.Checked
.ConfigAutoUpdate = CH_UPDATE_CONF.Checked
.AddErrorsToLog = CH_LOG_ERR.Checked
If CH_FORCE_UPDATE.Checked Then .RulesForceUpdateRequired = True
.NeedToSave = True
End With
MyDefs.CloseForm()
End If
End Sub
#End Region
#Region "Add, Delete"
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Const msgTitle$ = "Add a rule"
Dim i%
Dim rule As DynamicRulesValue
Dim r$ = InputBoxE("Enter a valid rules URL:", msgTitle)
If Not r.IsEmptyString Then
rule = Rules.ParseURL(r)
If rule.Valid Then
i = CurrentRulesEnv_LIST.IndexOf(r)
If i >= 0 Then
MsgBoxE({$"The rule you entered already exists:{vbCr}{rule.UrlRepo}", msgTitle}, vbCritical)
Else
CurrentRulesEnv_LIST.Add(rule, False, False)
Refill()
End If
Else
MsgBoxE({$"The rule you entered has an incompatible format:{vbCr}{r}", msgTitle}, vbCritical)
End If
End If
End Sub
Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
If _LatestSelected.ValueBetween(0, LIST_RULES.Items.Count - 1) Then
Dim r$ = LIST_RULES.Items(_LatestSelected)
If MsgBoxE({$"Are you sure you want to delete the following rule?{vbCr}{r}", "Delete a rule"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
If CurrentRulesEnv_LIST.RemoveAt(_LatestSelected) Then
LIST_RULES.Items.RemoveAt(_LatestSelected)
Refill()
Else
MsgBoxE({$"The following rule cannot be deleted:{vbCr}{r}", "Delete a rule"}, vbCritical)
End If
End If
End If
End Sub
#End Region
#Region "Options"
Private Sub TXT_UP_INTERVAL_ActionOnButtonClick(ByVal Sender As Object, ByVal e As ActionButtonEventArgs) Handles TXT_UP_INTERVAL.ActionOnButtonClick
If e.DefaultButton = ActionButton.DefaultButtons.Refresh Then TXT_UP_INTERVAL.Text = DynamicRulesEnv.UpdateIntervalDefault
End Sub
Private Sub TXT_PERSONAL_RULE_ActionOnCheckedChange(ByVal Sender As Object, ByVal e As EventArgs, ByVal Checked As Boolean) Handles TXT_PERSONAL_RULE.ActionOnCheckedChange
Mode_CheckedChanged()
End Sub
Private Sub OPT_RULES_LIST_CheckedChanged(sender As Object, e As EventArgs)
Mode_CheckedChanged()
End Sub
Private Sub Mode_CheckedChanged()
Dim e As Boolean = TXT_PERSONAL_RULE.Checked
TXT_PERSONAL_RULE.Enabled(False) = e
CONTAINER_LIST.Enabled = Not e
CH_PROTECTED.Enabled = Not e
CH_FORCE_UPDATE.Enabled = Not e
End Sub
#End Region
#Region "List handlers"
Private _LatestSelected As Integer = -1
Private Sub LIST_RULES_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_RULES.SelectedIndexChanged
_LatestSelected = LIST_RULES.SelectedIndex
End Sub
#End Region
End Class
End Namespace

View File

@@ -9,13 +9,12 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.OnlyFans
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SpecialForm(True), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Categories"
@@ -74,30 +73,6 @@ Namespace API.OnlyFans
Return String.Empty
End Function
#End Region
#Region "Rules"
<PXML("LastDateUpdated")> Private ReadOnly Property LastDateUpdated_XML As PropertyValue
Friend Property LastDateUpdated As Date
Get
Return LastDateUpdated_XML.Value
End Get
Set(ByVal d As Date)
LastDateUpdated_XML.Value = d
End Set
End Property
<PropertyOption(ControlText:="Use old authorization rules",
ControlToolTip:="Use old dynamic rules (from 'DATAHOARDERS') or new ones (from 'DIGITALCRIMINALS')." & vbCr &
"Change this value only if you know what you are doing.", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property UseOldAuthRules As PropertyValue
<PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440",
LeftOffset:=110, IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue
<Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider
<PropertyOption(ControlText:="Dynamic rules",
ControlToolTip:="Overwrite 'Dynamic rules' with this URL" & vbCr &
"Change this value only if you know what you are doing.", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property DynamicRules As PropertyValue
#End Region
#Region "OFScraper"
<PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'", Category:=CAT_OFS)>
@@ -133,12 +108,28 @@ Namespace API.OnlyFans
End If
End Get
End Property
<PClonable, PXML("keydb_api")> Private ReadOnly Property Keydb_Api_XML As PropertyValue
<PropertyOption(ControlText:="keydb_api", Category:=CAT_OFS)>
Friend ReadOnly Property Keydb_Api As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).Keydb_Api_XML
Else
Return Keydb_Api_XML
End If
End Get
End Property
#End Region
#End Region
#Region "Initializer"
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)
If Rules Is Nothing Then
Rules = New DynamicRulesEnv
Rules.Update(False, True)
End If
_AllowUserAgentUpdate = False
With Responser
@@ -171,13 +162,6 @@ Namespace API.OnlyFans
DownloadHighlights = New PropertyValue(True)
DownloadChatMedia = New PropertyValue(True)
LastDateUpdated_XML = New PropertyValue(Now.AddYears(-1), GetType(Date))
'URGENT: OF [UseOldAuthRules = True]
UseOldAuthRules = New PropertyValue(True)
DynamicRulesUpdateInterval = New PropertyValue(60 * 24)
DynamicRulesUpdateIntervalProvider = New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0) > 0, v, Nothing),
"The value of [{0}] field must be greater than 0")
DynamicRules = New PropertyValue(String.Empty, GetType(String))
OFScraperPath_XML = New PropertyValue(String.Empty, GetType(String))
If ACheck(OFScraperPath_XML.Value) Then
Dim f As SFile = OFScraperPath_XML.Value
@@ -192,6 +176,7 @@ Namespace API.OnlyFans
End If
OFScraperMP4decrypt_XML = New PropertyValue(String.Empty, GetType(String))
KeyModeDefault_XML = New PropertyValue(KeyModeDefault_Default)
Keydb_Api_XML = New PropertyValue(String.Empty, GetType(String))
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "onlyfans.com/"), 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}"
@@ -204,10 +189,28 @@ Namespace API.OnlyFans
End Function
#End Region
#Region "Update"
Friend Overrides Sub BeginUpdate()
_TempSettingsEnv.DisposeIfReady
_TempSettingsEnv = Nothing
MyBase.BeginUpdate()
End Sub
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then Responser.Cookies.Changed = False
If _SiteEditorFormOpened Then
Responser.Cookies.Changed = False
If If(_TempSettingsEnv?.NeedToSave, False) Then Rules.Copy(_TempSettingsEnv, True) : Rules.Save()
End If
MyBase.Update()
End Sub
Friend Overrides Sub EndUpdate()
_TempSettingsEnv.DisposeIfReady
_TempSettingsEnv = Nothing
MyBase.EndUpdate()
End Sub
Private _TempSettingsEnv As DynamicRulesEnv = Nothing
Friend Overrides Sub OpenSettingsForm()
If _TempSettingsEnv Is Nothing Then _TempSettingsEnv = New DynamicRulesEnv : _TempSettingsEnv.Copy(Rules, False)
Using f As New OnlyFansAdvancedSettingsForm(_TempSettingsEnv) : f.ShowDialog() : End Using
End Sub
#End Region
#Region "Download"
Friend Overrides Function BaseAuthExists() As Boolean

View File

@@ -91,6 +91,7 @@ Namespace API.OnlyFans
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
_DownloadingException_AuthFileUpdate = False
If Not MySettings.SessionAborted Then
ValidateOFScraper()
_AbsMediaIndex = 0
@@ -537,36 +538,16 @@ Namespace API.OnlyFans
End Sub
#End Region
#Region "Auth"
Private ReadOnly Property AuthFile As SFile
Get
Dim f As SFile = MySettings.Responser.File
f.Name &= "_Auth"
f.Extension = "json"
Return f
End Get
End Property
Private Function UpdateSignature(ByVal Path As String, Optional ByVal ForceUpdateAuth As Boolean = False,
Optional ByVal Round As Integer = 0) As Boolean
Private Function UpdateSignature(ByVal Path As String) As Boolean
Try
If UpdateAuthFile(ForceUpdateAuth) Then
Const nullMsg$ = "The auth parameter is null"
Dim j As EContainer
Try
j = JsonDocument.Parse(AuthFile.GetText)
Catch jex As Exception
If Round = 0 Then
AuthFile.Delete()
UpdateAuthFile(True)
Return UpdateSignature(Path, ForceUpdateAuth, Round + 1)
Else
MySettings.SessionAborted = True
Return False
End If
End Try
If Not Rules.Update(False) Then Rules.Update(True)
If Rules.Exists Then
Const nullMsg$ = "The auth parameter(s) is null"
Dim j As EContainer = Rules.CurrentContainer
If Not j Is Nothing Then
Dim pattern$ = j.Value("format")
Dim pattern$ = DynamicRulesEnv.GetFormat(j)
If pattern.IsEmptyString Then Throw New ArgumentNullException("format", nullMsg)
pattern = pattern.Replace("{}", "{0}").Replace("{:x}", "{1:x}")
Dim li%() = j("checksum_indexes").Select(Function(e) CInt(e(0).Value)).ToArray
@@ -590,38 +571,16 @@ Namespace API.OnlyFans
Responser.Headers.Add(HeaderSign, sign)
Responser.Headers.Add(HeaderTime, t)
j.Dispose()
Return True
End If
Else
MySettings.SessionAborted = True
End If
Return False
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateSignature", False)
End Try
End Function
Private Function UpdateAuthFile(ByVal Force As Boolean) As Boolean
Const urlOld$ = "https://raw.githubusercontent.com/DATAHOARDERS/dynamic-rules/main/onlyfans.json"
Const urlNew$ = "https://raw.githubusercontent.com/DIGITALCRIMINALS/dynamic-rules/main/onlyfans.json"
Try
If MySettings.LastDateUpdated.AddMinutes(CInt(MySettings.DynamicRulesUpdateInterval.Value)) < Now Or Not AuthFile.Exists Or Force Then
Dim r$ = GetWebString(If(ACheck(Of String)(MySettings.DynamicRules.Value),
CStr(MySettings.DynamicRules.Value),
IIf(MySettings.UseOldAuthRules.Value, urlOld, urlNew)),, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
If Not j.Value("format").IsEmptyString And j("checksum_indexes").ListExists And
Not j.Value("static_param").IsEmptyString And Not j.Value("checksum_constant").IsEmptyString Then _
TextSaver.SaveTextToFile(r, AuthFile, True, False, EDP.ThrowException) : MySettings.LastDateUpdated = Now
End If
End Using
End If
End If
Return AuthFile.Exists
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateAuthFile", False)
End Try
End Function
Private Function GetHashSha1(ByVal Input As String) As String
Dim s As New Security.Cryptography.SHA1CryptoServiceProvider
Dim inputBytes() As Byte = System.Text.Encoding.UTF8.GetBytes(Input)
@@ -653,37 +612,51 @@ Namespace API.OnlyFans
Private Function OFS_CreateConfig() As SFile
Try
Const confMainPattern$ = "{0}"": ""([^""]*)"""
Const confMainPatternRulesManual$ = "DYNAMIC_RULE"": (""[^""]*"")"
If OFSCache Is Nothing Then OFSCache = If(IsSingleObjectDownload, Settings.Cache.NewInstance, CreateCache())
Dim currentCache As CacheKeeper = OFSCache.NewInstance
currentCache.Validate()
Dim cacheRoot As SFile = currentCache.NewPath
cacheRoot.Exists(SFO.Path, True, EDP.ThrowException)
Dim f As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json"
Dim f As SFile = Rules.OFScraperConfigPatternFile
Dim configText$
If Not f.Exists Then
configText = Text.Encoding.UTF8.GetString(My.Resources.OFResources.OFScraperConfigPattern)
TextSaver.SaveTextToFile(configText, f, True)
End If
If f.Exists Then
Dim replaceValue$ = String.Empty
Dim rp As RParams = RParams.DMS(String.Empty, 1, RegexReturn.Replace, RegexOptions.IgnoreCase,
CType(Function(input) replaceValue, Func(Of String, String)), String.Empty, EDP.ReturnValue)
Dim ff As SFile
configText = f.GetText
Dim updateConf As Action(Of String, String) = Sub(ByVal patternValue As String, ByVal __replaceValue As String)
rp.Pattern = String.Format(confMainPattern, patternValue)
rp.Nothing = configText
replaceValue = __replaceValue
configText = RegexReplace(configText, rp)
End Sub
Dim updateConf As Action(Of String, String, Boolean) =
Sub(ByVal patternValue As String, ByVal __replaceValue As String, ByVal __isRules As Boolean)
rp.Pattern = String.Format(IIf(__isRules, confMainPatternRulesManual, confMainPattern), patternValue)
rp.Nothing = configText
replaceValue = __replaceValue
configText = RegexReplace(configText, rp)
End Sub
If Not configText.IsEmptyString Then
updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"))
updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"), False)
If ACheck(MySettings.OFScraperMP4decrypt.Value) Then
ff = CStr(MySettings.OFScraperMP4decrypt.Value)
If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"))
If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"), False)
End If
If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"), False)
updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default), False)
updateConf("keydb_api", CStr(MySettings.Keydb_Api.Value), False)
If Rules.RulesReplaceConfig Then
If Rules.RulesConfigManualMode Then
updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, "manual", False)
configText = configText.Replace(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, DynamicRulesEnv.DynamicRulesConfigNodeName_RULES)
updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_RULES, Rules.CurrentContainerRulesText, True)
Else
Dim confUrlNode$ = If(Rules.RulesConstants.ContainsKey(DynamicRulesEnv.DynamicRulesConfigNodeName_URL_CONST_NAME),
Rules.RulesConstants(DynamicRulesEnv.DynamicRulesConfigNodeName_URL_CONST_NAME),
DynamicRulesEnv.DynamicRulesConfigNodeName_URL)
updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, Rules.CurrentRule.UrlRaw, False)
configText = configText.Replace(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, confUrlNode)
If Rules.RulesConstants.ContainsKey(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName) Then _
updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, Rules.RulesConstants(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName), False)
End If
End If
If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"))
updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default))
f = currentCache
f.Name = "config"
f.Extension = "json"
@@ -777,7 +750,7 @@ Namespace API.OnlyFans
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then '400
If Not _DownloadingException_AuthFileUpdate AndAlso UpdateAuthFile(True) Then
If Not _DownloadingException_AuthFileUpdate AndAlso Rules.Update(True) Then
_DownloadingException_AuthFileUpdate = True
Return 2
Else

View File

@@ -914,19 +914,24 @@ Namespace API.Reddit
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey, RedGifsAccount)
If RedGifsHost Is Nothing Then RedGifsHost = Settings(RedGifs.RedGifsSiteKey).Default
RedGifsResponser = RedGifsHost.Responser.Copy
Dim respNoHeaders As Responser = Responser.Copy
Dim m As UserMedia, m2 As UserMedia
Dim r$
Dim r$, url$
Dim j As EContainer
Dim lastCount%, li%
Dim rv As New ErrorsDescriber(EDP.ReturnValue)
respNoHeaders.Headers.Clear()
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
ProgressPre.Perform()
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
url = $"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json"
r = Responser.GetResponse(url,, rv)
If r.IsEmptyString Then r = respNoHeaders.GetResponse(url,, rv)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, EDP.ReturnValue)
j = JsonDocument.Parse(r, rv)
If Not j Is Nothing Then
If j.Count > 0 Then
lastCount = _TempMediaList.Count

View File

@@ -101,7 +101,7 @@ Namespace API.Twitter
ConcurrentDownloads = New PropertyValue(1)
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "/(twitter|x).com/"), 2)
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, $"/(twitter|x).com({CommunitiesUser}|)/"), 3)
UrlPatternUser = "https://x.com/{0}"
ImageVideoContains = "twitter"
CheckNetscapeCookiesOnEndInit = True
@@ -110,8 +110,9 @@ Namespace API.Twitter
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Const SinglePostPattern As String = "https://x.com/i/web/status/{0}"
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://x.com/{User.Name}/status/{Media.Post.ID}"
Return String.Format(SinglePostPattern, Media.Post.ID)
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists
@@ -151,5 +152,18 @@ Namespace API.Twitter
End If
MyBase.Update()
End Sub
Friend Const CommunitiesUser As String = "/i/communities"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If Not e.UserName.IsEmptyString Then
If UserURL.Contains(CommunitiesUser) Then e.Options = CommunitiesUser : e.UserName &= "@c"
Return e
Else
Return Nothing
End If
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return DirectCast(User, UserData).GetUserUrl
End Function
End Class
End Namespace

View File

@@ -26,8 +26,24 @@ Namespace API.Twitter
Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_IsCommunity As String = "IsCommunity"
#End Region
#Region "Declarations"
Private Const Label_Community As String = "Community"
Private _NameTrue As String = String.Empty
Friend Property NameTrue As String
Get
Return _NameTrue.IfNullOrEmpty(Name)
End Get
Set(ByVal NewName As String)
_NameTrue = NewName
End Set
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {Label_Community}
End Get
End Property
Friend Enum DownloadModels As Integer
Undefined = 0
Media = 1
@@ -42,6 +58,7 @@ Namespace API.Twitter
Friend Property GifsDownload As Boolean = True
Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty
Friend Property IsCommunity As Boolean = False
Private ReadOnly LikesPosts As List(Of String)
Private ReadOnly _DataNames As List(Of String)
Private ReadOnly Property MySettings As SiteSettings
@@ -57,6 +74,9 @@ Namespace API.Twitter
Private Function RenameGdlFile(ByVal Input As SFile, ByVal i As Integer) As SFile
Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(FileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function
Friend Function GetUserUrl() As String
Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}"
End Function
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
@@ -121,7 +141,20 @@ Namespace API.Twitter
RemoveExistingDuplicates = .Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False)
IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False)
_NameTrue = .Value(Name_TrueName)
Else
If Name.Contains("@") And Not IsCommunity Then
IsCommunity = True
_NameTrue = Name.Split("@")(0)
ID = _NameTrue
ParseUserMediaOnly = False
Labels.ListAddValue(Label_Community, LNC)
Labels.Sort()
.Add(Name_UserID, ID)
.Add(Name_LabelsName, LabelsString)
.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
End If
.Add(Name_FirstDownloadComplete, FirstDownloadComplete.BoolToInteger)
.Add(Name_DownloadModelForceApply, DownloadModelForceApply.BoolToInteger)
.Add(Name_DownloadModel, CInt(DownloadModel))
@@ -132,6 +165,8 @@ Namespace API.Twitter
.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
.Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger)
.Add(Name_IsCommunity, IsCommunity.BoolToInteger)
.Add(Name_TrueName, _NameTrue)
End If
End With
End Sub
@@ -188,14 +223,15 @@ Namespace API.Twitter
Dim newTwitterNodes() As Object = {0, "content", "items"}
Dim p As Predicate(Of EContainer)
Dim pIndx%
Dim indxChanged As Boolean = False
Dim isOneNode As Boolean, isPins As Boolean, ExistsDetected As Boolean, userInfoParsed As Boolean = False
Dim j As EContainer, rootNode As EContainer, optionalNode As EContainer, workingNode As EContainer, tmpNode As EContainer, nn As EContainer = Nothing
Dim __parseContainer As Func(Of EContainer, Boolean) =
Function(ByVal ee As EContainer) As Boolean
nn = Nothing
If dirIndx > 1 Then nn = ee
If Not nn.ListExists Then
If dirIndx > 1 Or IsCommunity Then nn = ee
If Not nn.ListExists Or IsCommunity Then
For Each node In nodes
nn = ee(node)
If nn.ListExists Then Exit For
@@ -269,10 +305,22 @@ Namespace API.Twitter
For i = 0 To timelineFiles.Count - 1
j = JsonDocument.Parse(timelineFiles(i).GetText)
If Not j Is Nothing Then
If i = 0 Then
If i = 0 And Not indxChanged Then
If Not userInfoParsed Then
userInfoParsed = True
Dim resValue$ = j.Value({"data", "user", "result"}, "__typename").StringTrim.StringToLower
Dim resValue$ = j.Value({"data", IIf(IsCommunity, "communityResults", "user"), "result"}, "__typename").StringTrim.StringToLower
Dim icon$
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim __imgFile As SFile = UrlFile(img, True)
If Not __imgFile.Name.IsEmptyString Then
If __imgFile.Extension.IsEmptyString Then __imgFile.Extension = "jpg"
__imgFile.Path = MyFile.CutPath.Path
If Not __imgFile.Exists Then GetWebFile(img, __imgFile, EDP.None)
If __imgFile.Exists Then IconBannerDownloaded = True
End If
End If
End Sub
If resValue.IsEmptyString Then
UserExists = False
j.Dispose()
@@ -281,6 +329,29 @@ Namespace API.Twitter
UserSuspended = True
j.Dispose()
Exit Sub
ElseIf IsCommunity Then
With j({"data", "communityResults", "result", "community_media_timeline", "timeline", "instructions"})
If .ListExists Then
With .Find(entriesNode, True)
If .ListExists Then
With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"})
If .ListExists Then
If ID = .Value("id_str") Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
icon = .Value({"custom_banner_media", "media_info"}, "original_img_url").
IfNullOrEmpty(.Value({"default_banner_media", "media_info"}, "original_img_url"))
If Not icon.IsEmptyString And DownloadIconBanner Then __getImage.Invoke(icon)
End If
End If
End With
End If
End With
End If
End With
i = -1
indxChanged = True
Else
With j({"data", "user", "result"})
If .ListExists Then
@@ -290,21 +361,11 @@ Namespace API.Twitter
End If
With .Item({"legacy"})
If .ListExists Then
If .Value("screen_name").StringToLower = Name.ToLower Then
If .Value("screen_name").StringToLower = NameTrue.ToLower Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim __imgFile As SFile = UrlFile(img, True)
If Not __imgFile.Name.IsEmptyString Then
If __imgFile.Extension.IsEmptyString Then __imgFile.Extension = "jpg"
__imgFile.Path = MyFile.CutPath.Path
If Not __imgFile.Exists Then GetWebFile(img, __imgFile, EDP.None)
If __imgFile.Exists Then IconBannerDownloaded = True
End If
End If
End Sub
Dim icon$ = .Value("profile_image_url_https")
icon = .Value("profile_image_url_https")
If Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
If DownloadIconBanner Then
__getImage.Invoke(.Value("profile_banner_url"))
@@ -316,34 +377,55 @@ Namespace API.Twitter
End If
End With
End If
ElseIf IsCommunity Then
i = -1
indxChanged = True
End If
Else
For pIndx = 0 To IIf(dirIndx < 2 Or dirIndx = 3, 1, 0)
optionalNode = Nothing
Select Case dirIndx
Case 0, 1, 3
rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"})
If rootNode.ListExists Then
If dirIndx = 3 Then
p = entriesNode
isPins = False
rootNode = Nothing
If IsCommunity Then
With j({"data", "communityResults", "result", "community_media_timeline", "timeline", "instructions"})
If .ListExists Then
If i = 0 Then
rootNode = .Find(entriesNode, True)
Else
p = If(pIndx = 0, pinNode, timelineNode)
isPins = pIndx = 0
rootNode = .Find(moduleItemsPredicate, True)
End If
optionalNode = rootNode
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
rootNode = j({"globalObjects", "tweets"})
optionalNode = rootNode
End Select
End With
Else
Select Case dirIndx
Case 0, 1, 3
rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"})
If rootNode.ListExists Then
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, dirIndx = 3)
If dirIndx <> 3 And rootNode.ListExists Then rootNode = rootNode.Find(entriesNode, dirIndx = 3)
End If
Case Else
isPins = False
rootNode = j({"globalObjects", "tweets"})
optionalNode = rootNode
End Select
End If
If rootNode.ListExists Then
With rootNode
isOneNode = dirIndx < 2 AndAlso .Name = entry
If IsCommunity Then
isOneNode = pIndx = 0
Else
isOneNode = dirIndx < 2 AndAlso .Name = entry
End If
ProgressPre.ChangeMax(If(isOneNode, 1, .Count))
If isOneNode Then
ProgressPre.Perform()
@@ -372,7 +454,6 @@ Namespace API.Twitter
End If
Next
'TODO: Twitter: is this line needed?
If ExistsDetected And i = 1 Then Exit For Else ExistsDetected = False
End If
j.Dispose()
@@ -660,6 +741,7 @@ Namespace API.Twitter
Dim dir As SFile
Dim dm As List(Of DownloadModels) = EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing
Dim process As Boolean
Dim urlPrePattern$ = $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/"
Using tgdl As New TwitterGDL(Nothing, Token, MySettings.AbortOnLimit.Value) With {
.TempPostsList = _TempPostsList,
@@ -670,7 +752,7 @@ Namespace API.Twitter
}
tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = False
For i As Byte = 0 To 3
For i As Byte = 0 To IIf(IsCommunity, 0, 3)
dir = rootDir.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException)
outList.Add(dir)
@@ -678,10 +760,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://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 0 : command &= $"{urlPrePattern}{NameTrue}/media" : process = dm.Contains(DownloadModels.Media) Or IsCommunity
Case 1 : command &= $"{urlPrePattern}{NameTrue}" : process = dm.Contains(DownloadModels.Profile)
Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{NameTrue}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search) And Not IsCommunity
Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : process = dm.Contains(DownloadModels.Likes)
Case Else : process = False
End Select
'#If DEBUG Then
@@ -735,7 +817,6 @@ Namespace API.Twitter
#Region "ReparseMissing"
Private _ReparseLikes As Boolean = False
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const SinglePostPattern$ = "https://x.com/{0}/status/{1}"
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Dim cache As CacheKeeper = Nothing
@@ -752,14 +833,7 @@ Namespace API.Twitter
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
cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache())
If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count
ProgressPre.ChangeMax(lim)
For i = 0 To lim - 1
@@ -773,7 +847,7 @@ Namespace API.Twitter
ElseIf _ReparseLikes Then
URL = LikesPosts(i)
Else
URL = String.Format(SinglePostPattern, Name, m.Post.ID)
URL = String.Format(SiteSettings.SinglePostPattern, m.Post.ID)
End If
f = GetDataFromGalleryDL(URL, cache, False, Token)
If Not f.IsEmptyString Then

View File

@@ -58,7 +58,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Change 'ActiveDownloadingProgress' size")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Downloader_Reconfigured()

View File

@@ -16,6 +16,7 @@ Imports PersonalUtilities.Tools.Notifications
Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider, IComparable(Of AutoDownloader)
Friend Event PauseChanged(ByVal Value As PauseModes)
Friend Event PlanChanged As Scheduler.PlanChangedEventHandler
Friend Enum Modes As Integer
None = 0
Specified = 3
@@ -199,6 +200,52 @@ Namespace DownloadObjects
Private Const Name_ShowSimpleNotification As String = "ShowSimpleNotification"
#End Region
#Region "Declarations"
Private _LVIState As Integer = 0
Friend Function LVIStateChanged() As Boolean
Dim ____LVIState%
Dim result As Boolean
If Downloading Then
____LVIState = 1
ElseIf DownloadReady(True, True) Or ForceStartRequested Then
____LVIState = 2
ElseIf Not Working And Not IsManual Then
____LVIState = 3
ElseIf IsPaused Then
____LVIState = 4
ElseIf Settings.AutomationBrushUndownloadedPlansMinutes.Value > 0 AndAlso
LastDownloadDate.AddMinutes(Settings.AutomationBrushUndownloadedPlansMinutes.Value) < Now Then
____LVIState = 5
Else
____LVIState = 0
End If
result = Not _LVIState = ____LVIState
_LVIState = ____LVIState
Return result
End Function
Friend ReadOnly Property LVI As ListViewItem
Get
Dim l As New ListViewItem(ToString)
If Downloading Then
l.BackColor = MyColor.OkBack
l.ForeColor = MyColor.OkFore
ElseIf DownloadReady(True, True) Or ForceStartRequested Then
l.BackColor = MyColor.EditBack
l.ForeColor = MyColor.EditFore
ElseIf Not Working And Not IsManual Then
l.BackColor = MyColor.DeleteBack
l.ForeColor = MyColor.DeleteFore
ElseIf Working And IsPaused And Not IsManual Then
l.BackColor = MyColor.UpdateBack
l.ForeColor = MyColor.UpdateFore
ElseIf Settings.AutomationBrushUndownloadedPlansMinutes.Value > 0 AndAlso
LastDownloadDate.AddMinutes(Settings.AutomationBrushUndownloadedPlansMinutes.Value) < Now Then
l.BackColor = Color.FromArgb(224, 224, 224)
l.ForeColor = Color.FromArgb(64, 64, 64)
End If
LVIStateChanged()
Return l
End Get
End Property
Friend Property Source As Scheduler
Private _Mode As Modes = Modes.None
Friend Property Mode As Modes
@@ -267,11 +314,15 @@ Namespace DownloadObjects
End Property
Private Function GetWorkingState() As String
Dim OutStr$
If Working Then
If StartupDelay > 0 And _StartTime.AddMinutes(StartupDelay) > Now Then
OutStr = $"delayed until {_StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)}"
If Working And Not IsManual Then
If _Downloading Then
OutStr = "downloading"
ElseIf _ForceStartRequested Then
OutStr = "force start pending"
ElseIf _StopRequested Then
OutStr = "stopping"
ElseIf StartupDelay > 0 And _StartTime.AddMinutes(StartupDelay) > Now Then
OutStr = $"delayed ({StartupDelay}) until {_StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)}"
Else
OutStr = "working"
End If
@@ -282,14 +333,26 @@ Namespace DownloadObjects
Case Else : OutStr &= $", paused ([{Pause}] until {AConvert(Of String)(_PauseValue, ADateTime.Formats.BaseDateTime, "?")})"
End Select
End If
ElseIf IsManual Then
If _Downloading Then
OutStr = "downloading"
ElseIf _ForceStartRequested Then
OutStr = "force start pending"
Else
OutStr = String.Empty
End If
Else
OutStr = "stopped"
End If
Return OutStr
End Function
Private Function GetWorkingState_Manual() As String
Dim OutStr$ = GetWorkingState()
If Not OutStr.IsEmptyString Then Return $" ({OutStr})" Else Return String.Empty
End Function
Public Overrides Function ToString() As String
If IsManual Then
Return $"{Name} (manual): last download date: {GetLastDateString()}"
Return $"{Name} (manual{GetWorkingState_Manual()}): last download date: {GetLastDateString()}"
Else
Return $"{Name} ({GetWorkingState()}): last download date: {GetLastDateString()}; next run: {GetNextDateString()}"
End If
@@ -316,9 +379,7 @@ Namespace DownloadObjects
Friend Sub New(ByVal x As EContainer)
Me.New
Initialization = True
Dim m% = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
If m = 1 Or m = 2 Then m = Modes.Specified
Mode = m
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Import(x)
If Name.IsEmptyString Then Name = "Default"
Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly)
@@ -395,10 +456,10 @@ Namespace DownloadObjects
End Function
#End Region
#Region "Execution"
Private AThread As Thread
Private _Working As Boolean = False
Friend ReadOnly Property Working As Boolean
Get
Return If(AThread?.IsAlive, False)
Return _Working
End Get
End Property
Private _StartTime As Date = Now
@@ -406,11 +467,8 @@ Namespace DownloadObjects
If Not IsManual Or Force Then
If Init Then _StartTime = Now
_IsNewPlan = False
If Not Working And Not Mode = Modes.None Then
AThread = New Thread(New ThreadStart(AddressOf Checker))
AThread.SetApartmentState(ApartmentState.MTA)
AThread.Start()
End If
If Not Working And Not Mode = Modes.None Then _Working = True
RaiseEvent PlanChanged(Me)
End If
End Sub
Private _StopRequested As Boolean = False
@@ -434,6 +492,7 @@ Namespace DownloadObjects
Case Else : _PauseValue = Nothing
End Select
RaiseEvent PauseChanged(p)
RaiseEvent PlanChanged(Me)
End Set
End Property
Private ReadOnly Property IsPaused As Boolean
@@ -457,7 +516,10 @@ Namespace DownloadObjects
End Get
End Property
Friend Sub [Stop]()
If Working Then _StopRequested = True
If Working Then
If Downloading Then _StopRequested = True Else _Working = False
RaiseEvent PlanChanged(Me)
End If
End Sub
Friend Overloads Sub Skip()
If LastDownloadDate.AddMinutes(Timer) <= Now Then
@@ -465,65 +527,59 @@ Namespace DownloadObjects
Else
_LastDownloadDateSkip = LastDownloadDate.AddMinutes(Timer)
End If
RaiseEvent PlanChanged(Me)
End Sub
Friend Overloads Sub Skip(ByVal Minutes As Integer)
_LastDownloadDateSkip = If(_LastDownloadDateSkip, Now).AddMinutes(Minutes)
RaiseEvent PlanChanged(Me)
End Sub
Friend Overloads Sub Skip(ByVal ToDate As Date)
_LastDownloadDateSkip = ToDate
RaiseEvent PlanChanged(Me)
End Sub
Friend Sub SkipReset()
_LastDownloadDateSkip = Nothing
RaiseEvent PlanChanged(Me)
End Sub
Friend Sub ForceStart()
_ForceStartRequested = True
If IsManual Then Start(False, True)
RaiseEvent PlanChanged(Me)
End Sub
Private _ForceStartRequested As Boolean = False
Private _SpecialDelayUse As Boolean = False
Private _SpecialDelayTime As Date? = Nothing
Private Sub Checker()
Try
Dim _StartDownload As Boolean
While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None
If ((IsManual And _ForceStartRequested) Or (NextExecutionDate < Now And Not IsPaused) Or _ForceStartRequested) And
Not _StopRequested And Not Mode = Modes.None Then
If Downloader.Working Then
_SpecialDelayUse = True
Else
If _SpecialDelayUse And Not _SpecialDelayTime.HasValue Then _SpecialDelayTime = Now.AddSeconds(10)
If Not _SpecialDelayUse OrElse (_SpecialDelayTime.HasValue AndAlso _SpecialDelayTime.Value < Now) Then
_SpecialDelayUse = False
_SpecialDelayTime = Nothing
_StartDownload = False
If Settings.Automation.Count = 1 Or _ForceStartRequested Or Index = -1 Then
_StartDownload = True
Else
_StartDownload = NextExecutionDate.AddMilliseconds(1000 * (Index + 1)).Ticks <= Now.Ticks
End If
If _StartDownload Then
Download()
If IsManual Then Exit While
End If
End If
End If
Friend ReadOnly Property ForceStartRequested As Boolean
Get
Return _ForceStartRequested
End Get
End Property
Friend ReadOnly Property DownloadReady(Optional ByVal IgnorePause As Boolean = False, Optional ByVal IgnoreDownloaderWorking As Boolean = False) As Boolean
Get
If _StopRequested Then _Working = False
Return (Working Or IsManual) And ((IsManual And _ForceStartRequested) Or (Not IsManual And NextExecutionDate < Now And (Not IsPaused Or IgnorePause)) Or _ForceStartRequested) And
Not _StopRequested And Not Mode = Modes.None And (Not Downloader.Working Or IgnoreDownloaderWorking)
End Get
End Property
Friend ReadOnly Property NextDate As Date?
Get
If Not _StopRequested And Not Mode = Modes.None Then
If IsManual Or _ForceStartRequested Then
Return Now.AddYears(-10)
ElseIf Not IsPaused And Not IsManual And Working Then
Return NextExecutionDate
End If
Thread.Sleep(500)
End While
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[AutoDownloader.Checker]")
Finally
_StopRequested = False
End Try
End Sub
End If
Return Nothing
End Get
End Property
Private _Downloading As Boolean = False
Friend ReadOnly Property Downloading As Boolean
Get
Return _Downloading
End Get
End Property
Private Sub Download()
Friend Sub Download()
_Downloading = True
RaiseEvent PlanChanged(Me)
Dim Keys As New List(Of String)
Try
Dim users As New List(Of IUserData)
@@ -589,7 +645,7 @@ Namespace DownloadObjects
While .Working Or .Count > 0 : notify.Invoke() : Thread.Sleep(200) : End While
.AutoDownloaderWorking = False
notify.Invoke
If simple And DownloadedUsersCount + DownloadedSubscriptionsCount > 0 Then
If simple And (DownloadedUsersCount + DownloadedSubscriptionsCount) > 0 Then
Dim msg$ = String.Empty
If DownloadedUsersCount > 0 Then msg = $"{DownloadedUsersCount} user(s) "
If DownloadedSubscriptionsCount > 0 Then msg &= $"{IIf(DownloadedUsersCount > 0, "and ", String.Empty)}{DownloadedSubscriptionsCount} subscription(s) "
@@ -607,6 +663,8 @@ Namespace DownloadObjects
_Downloading = False
_ForceStartRequested = False
_LastDownloadDateSkip = Nothing
If _StopRequested Then _Working = False
RaiseEvent PlanChanged(Me)
End Try
End Sub
Private Sub ShowNotification(ByVal u As IUserData)

View File

@@ -14,15 +14,19 @@ Imports PauseModes = SCrawler.DownloadObjects.AutoDownloader.PauseModes
Namespace DownloadObjects
Friend Class Scheduler : Implements IEnumerable(Of AutoDownloader), IMyEnumerator(Of AutoDownloader), IDisposable
Friend Const Name_Plan As String = "Plan"
Friend Delegate Sub PlanChangedEventHandler(ByVal Plan As AutoDownloader)
Friend Event PauseChanged As AutoDownloader.PauseChangedEventHandler
Private Sub OnPauseChanged(ByVal Value As PauseModes)
RaiseEvent PauseChanged(Pause)
End Sub
Friend Event PlanChanged As PlanChangedEventHandler
Private Sub OnPlanChanged(ByVal Plan As AutoDownloader)
Try : RaiseEvent PlanChanged(Plan) : Catch : End Try
End Sub
Private ReadOnly Plans As List(Of AutoDownloader)
Friend Const FileNameDefault As String = "AutoDownload"
Friend ReadOnly FileDefault As SFile = $"{SettingsFolderName}\{FileNameDefault}.xml"
Friend File As SFile = Nothing
Private ReadOnly PlanWorking As Predicate(Of AutoDownloader) = Function(Plan) Plan.Working
Private ReadOnly PlanDownloading As Predicate(Of AutoDownloader) = Function(Plan) Plan.Downloading
Private ReadOnly PlansWaiter As Action(Of Predicate(Of AutoDownloader)) = Sub(ByVal Predicate As Predicate(Of AutoDownloader))
While Plans.Exists(Predicate) : Thread.Sleep(200) : End While
@@ -69,6 +73,7 @@ Namespace DownloadObjects
Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me
AddHandler Plan.PauseChanged, AddressOf OnPauseChanged
AddHandler Plan.PlanChanged, AddressOf OnPlanChanged
Plans.Add(Plan)
Plans.ListReindex
Update()
@@ -77,9 +82,9 @@ Namespace DownloadObjects
If Index.ValueBetween(0, Count - 1) Then
With Plans(Index)
.Stop()
If .Working Then
If .Downloading Then
Await Task.Run(Sub()
While .Working : Thread.Sleep(510) : End While
While .Downloading : Thread.Sleep(510) : End While
End Sub)
End If
.Dispose()
@@ -103,10 +108,10 @@ Namespace DownloadObjects
End Try
End Sub
Friend Function Reset(ByVal f As SFile, ByVal IsInit As Boolean) As Boolean
If Plans.Count > 0 Then
If Not Plans.Exists(PlanWorking) Then
If Count > 0 Then
If Not Plans.Exists(PlanDownloading) Then
Pause = PauseModes.Unlimited
If Plans.Exists(PlanWorking) Then
If Plans.Exists(PlanDownloading) Then
MsgBoxE({$"Some plans are already being worked.{vbCr}Wait for the plans to complete their work and try again.",
"Change scheduler"}, vbCritical)
Pause = PauseModes.Unlimited
@@ -114,6 +119,7 @@ Namespace DownloadObjects
End If
End If
[Stop]()
While Working : Thread.Sleep(200) : End While
If _UpdateRequired Then Update()
Plans.ListClearDispose(,, EDP.LogMessageValue)
End If
@@ -127,11 +133,12 @@ Namespace DownloadObjects
Plans.Add(New AutoDownloader(x))
End If
End Using
If Plans.Count > 0 Then Plans.ForEach(Sub(ByVal p As AutoDownloader)
p.Source = Me
If Not IsInit Then p.Pause = PauseModes.Unlimited
AddHandler p.PauseChanged, AddressOf OnPauseChanged
End Sub) : Plans.ListReindex
If Count > 0 Then Plans.ForEach(Sub(ByVal p As AutoDownloader)
p.Source = Me
If Not IsInit Then p.Pause = PauseModes.Unlimited
AddHandler p.PauseChanged, AddressOf OnPauseChanged
AddHandler p.PlanChanged, AddressOf OnPlanChanged
End Sub) : Plans.ListReindex
End If
Return True
End Function
@@ -163,38 +170,94 @@ Namespace DownloadObjects
End Sub
#End Region
#Region "Execution"
Private AThread As Thread = Nothing
Private _StopRequested As Boolean = False
Friend ReadOnly Property Working As Boolean
Get
Return If(AThread?.IsAlive, False)
End Get
End Property
Friend Async Function Start(ByVal Init As Boolean) As Task
Try
_StopRequested = False
Await Task.Run(Sub()
Dim r% = 0
Do
r += 1
Try
If Count > 0 Then
If Plans.Exists(PlanDownloading) Then PlansWaiter(PlanDownloading)
For Each Plan In Plans
Plan.Start(Init)
PlansWaiter(PlanDownloading)
Thread.Sleep(1000)
Next
End If
If Count > 0 Then PlansWaiter(PlanDownloading) : Plans.ForEach(Sub(p) p.Start(Init))
Exit Do
Catch io_ex As InvalidOperationException 'Collection was modified; enumeration operation may not execute
End Try
Loop While r < 10
End Sub)
If Not Working Then
AThread = New Thread(New ThreadStart(AddressOf Checker))
AThread.SetApartmentState(ApartmentState.MTA)
AThread.Start()
End If
Catch ex As Exception
If Init Then
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Start automation")
MainFrameObj.UpdateLogButton()
Else
Throw ex
End If
End Try
End Function
Friend Sub [Stop]()
If Working Then _StopRequested = True
If Count > 0 Then Plans.ForEach(Sub(p) p.Stop())
End Sub
Private Sub Checker()
Do
Try
If Count = 0 Or _StopRequested Then Exit Sub
PlansWaiter.Invoke(PlanDownloading)
Dim i% = Checker_GetNextPlanIndex()
If i >= 0 Then Checker_DownloadPlan(i)
Thread.Sleep(500)
Catch dex As ArgumentOutOfRangeException When disposedValue Or _StopRequested
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[Scheduler.Checker]")
End Try
Loop While Not _StopRequested
_StopRequested = False
End Sub
Private Sub Checker_DownloadPlan(ByVal PlanIndex As Integer)
While Downloader.Working : Thread.Sleep(200) : End While
With Plans(PlanIndex)
If .Downloading Then
PlansWaiter.Invoke(PlanDownloading)
ElseIf .DownloadReady Then
.Download()
End If
End With
End Sub
Private Function Checker_GetNextPlanIndex() As Integer
Try
Dim result% = -1
Dim l As New List(Of KeyValuePair(Of Integer, Date))
Dim d As Date?
If Count > 0 Then
For i% = 0 To Count - 1
With Plans(i)
If .DownloadReady Then
d = .NextDate
If d.HasValue Then l.Add(New KeyValuePair(Of Integer, Date)(i, d.Value))
End If
End With
Next
End If
If l.Count > 0 Then
Dim md As Date = l.Min(Function(p) p.Value)
result = l.Find(Function(p) p.Value = md).Key
l.Clear()
End If
Return result
Catch
Return -1
End Try
End Function
Friend Property Pause(Optional ByVal LimitDate As Date? = Nothing) As PauseModes
Get
If Count > 0 Then Return Plans.FirstOrDefault(Function(p) p.Pause >= PauseModes.Disabled).Pause Else Return PauseModes.Disabled
@@ -218,7 +281,8 @@ Namespace DownloadObjects
If Not disposedValue Then
If disposing Then
[Stop]()
If Plans.Exists(PlanWorking) Then Task.WaitAll(Task.Run(Sub() PlansWaiter(PlanWorking)))
If Plans.Exists(PlanDownloading) Then Task.WaitAll(Task.Run(Sub() PlansWaiter(PlanDownloading)))
While Working : Thread.Sleep(200) : End While
If _UpdateRequired Then Update()
Plans.ListClearDispose
End If

View File

@@ -23,7 +23,8 @@ Namespace DownloadObjects
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Me.LIST_PLANS = New System.Windows.Forms.ListBox()
Me.LIST_PLANS = New System.Windows.Forms.ListView()
Me.COL_MAIN = CType(New System.Windows.Forms.ColumnHeader(), System.Windows.Forms.ColumnHeader)
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
@@ -47,12 +48,25 @@ Namespace DownloadObjects
'
'LIST_PLANS
'
Me.LIST_PLANS.Alignment = System.Windows.Forms.ListViewAlignment.Left
Me.LIST_PLANS.Columns.AddRange(New System.Windows.Forms.ColumnHeader() {Me.COL_MAIN})
Me.LIST_PLANS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_PLANS.FormattingEnabled = True
Me.LIST_PLANS.FullRowSelect = True
Me.LIST_PLANS.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
Me.LIST_PLANS.HideSelection = False
Me.LIST_PLANS.Location = New System.Drawing.Point(0, 0)
Me.LIST_PLANS.MultiSelect = False
Me.LIST_PLANS.Name = "LIST_PLANS"
Me.LIST_PLANS.ShowGroups = False
Me.LIST_PLANS.Size = New System.Drawing.Size(414, 316)
Me.LIST_PLANS.TabIndex = 0
Me.LIST_PLANS.UseCompatibleStateImageBehavior = False
Me.LIST_PLANS.View = System.Windows.Forms.View.Details
'
'COL_MAIN
'
Me.COL_MAIN.Text = "Task"
Me.COL_MAIN.Width = 410
'
'SchedulerEditorForm
'
@@ -63,7 +77,6 @@ Namespace DownloadObjects
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(430, 380)
Me.Name = "SchedulerEditorForm"
Me.ShowIcon = True
Me.ShowInTaskbar = False
Me.Text = "Scheduler"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
@@ -72,6 +85,7 @@ Namespace DownloadObjects
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_PLANS As ListBox
Private WithEvents LIST_PLANS As ListView
Private WithEvents COL_MAIN As ColumnHeader
End Class
End Namespace

View File

@@ -6,6 +6,8 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Forms.Controls.Base
@@ -131,6 +133,16 @@ Namespace DownloadObjects
SetTitle()
.EndLoaderOperations(False)
End With
SchedulerCheckerThread = New Thread(New ThreadStart(AddressOf SchedulerChecker))
SchedulerCheckerThread.SetApartmentState(ApartmentState.MTA)
SchedulerCheckerThread.Start()
Try : AddHandler Settings.Automation.PlanChanged, AddressOf Scheduler_PauseChanged : Catch : End Try
End Sub
Private _CloseRequested As Boolean = False
Private Sub SchedulerEditorForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
_CloseRequested = True
While If(SchedulerCheckerThread?.IsAlive, False) : Thread.Sleep(200) : End While
Try : RemoveHandler Settings.Automation.PlanChanged, AddressOf Scheduler_PauseChanged : Catch : End Try
End Sub
Private Sub SchedulerEditorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.Escape Then
@@ -143,21 +155,48 @@ Namespace DownloadObjects
Private Sub SchedulerEditorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
PauseArr.Dispose()
End Sub
Private Sub SchedulerEditorForm_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
Try : ControlInvokeFast(LIST_PLANS, Sub()
COL_MAIN.Width = -2
LIST_PLANS.Refresh()
End Sub, EDP.None) : Catch : End Try
End Sub
#End Region
Private Property ListSelectedIndex As Integer
Get
Return If(LIST_PLANS.SelectedIndices.Count > 0, LIST_PLANS.SelectedIndices(0), -1)
End Get
Set(ByVal indx As Integer)
Try : ControlInvokeFast(LIST_PLANS, Sub()
With LIST_PLANS
.SelectedItems.Clear()
.Items(indx).Selected = True
.FocusedItem = .Items(indx)
.Refresh()
.EnsureVisible(indx)
End With
End Sub, EDP.None) : Catch : End Try
End Set
End Property
Private _RefillInProgress As Boolean = False
Private Sub Refill() Handles MyDefs.ButtonUpdateClick
Try
If Not _RefillInProgress Then
_RefillInProgress = True
LIST_PLANS.Items.Clear()
If Settings.Automation.Count > 0 Then
LIST_PLANS.Items.AddRange(Settings.Automation.Select(Function(a) a.ToString()).Cast(Of Object).ToArray)
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then LIST_PLANS.SelectedIndex = _LatestSelected
Else
_LatestSelected = -1
ControlInvokeFast(LIST_PLANS,
Sub()
If Not _RefillInProgress Then
_RefillInProgress = True
With LIST_PLANS.Items
.Clear()
If Settings.Automation.Count > 0 Then
.AddRange(Settings.Automation.Select(Function(a) a.LVI).ToArray)
If _LatestSelected.ValueBetween(0, .Count - 1) Then ListSelectedIndex = _LatestSelected
Else
_LatestSelected = -1
End If
End With
_RefillInProgress = False
End If
_RefillInProgress = False
End If
End Sub)
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.SchedulerEditorForm.Refill]")
End Try
@@ -196,7 +235,7 @@ Namespace DownloadObjects
Private Sub Edit() Handles MyDefs.ButtonEditClick
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
Using f As New AutoDownloaderEditorForm(Settings.Automation(_LatestSelected)) : f.ShowDialog() : End Using
Refill()
LIST_PLANS_Refresh(_LatestSelected)
Else
MsgBoxE("You have not selected a plan to edit.", vbExclamation)
End If
@@ -224,14 +263,59 @@ Namespace DownloadObjects
#End Region
#Region "List handlers"
Private _LatestSelected As Integer = -1
Private _LatestSelectedChangeEnabled As Boolean = True
Private Sub LIST_PLANS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_PLANS.SelectedIndexChanged
_LatestSelected = LIST_PLANS.SelectedIndex
PauseArr.PlanIndex = _LatestSelected
PauseArr.UpdatePauseButtons(False)
If _LatestSelectedChangeEnabled Then
_LatestSelected = ListSelectedIndex
PauseArr.PlanIndex = _LatestSelected
PauseArr.UpdatePauseButtons(False)
End If
End Sub
Private Sub LIST_PLANS_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_PLANS.MouseDoubleClick
Edit()
End Sub
Private Sub LIST_PLANS_Refresh(Optional ByVal PlanIndex As Integer = -1)
_LatestSelectedChangeEnabled = False
Try
ControlInvokeFast(LIST_PLANS,
Sub()
Dim indx% = If(PlanIndex >= 0, PlanIndex, ListSelectedIndex)
If indx = -1 And PlanIndex = -1 Then indx = _LatestSelected
If indx.ValueBetween(0, Settings.Automation.Count - 1) Then _
LIST_PLANS.Items(indx) = Settings.Automation(indx).LVI
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then ListSelectedIndex = _LatestSelected
End Sub, EDP.None)
Catch
Finally
_LatestSelectedChangeEnabled = True
End Try
End Sub
Private Sub Scheduler_PauseChanged(ByVal Plan As AutoDownloader)
LIST_PLANS_Refresh(Plan.Index)
End Sub
Private SchedulerCheckerThread As Thread
Private Sub SchedulerChecker()
Try
While Not _CloseRequested
Try
With Settings.Automation
If .Count > 0 Then
For i% = 0 To .Count - 1
If .Item(i).LVIStateChanged Then LIST_PLANS_Refresh(i)
If _CloseRequested Then Exit Sub
Thread.Sleep(200)
Next
Else
If _CloseRequested Then Exit Sub
Thread.Sleep(200)
End If
End With
Catch
End Try
End While
Catch
End Try
End Sub
#End Region
#Region "Settings, Start, Skip, Pause"
Private Function GetSchedulerFiles() As List(Of SFile)
@@ -372,13 +456,13 @@ Namespace DownloadObjects
Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
With Settings.Automation(_LatestSelected) : .Start(.IsNewPlan) : End With
Refill()
LIST_PLANS_Refresh(_LatestSelected)
End If
End Sub
Private Sub BTT_START_FORCE_Click(sender As Object, e As EventArgs) Handles BTT_START_FORCE.Click
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
With Settings.Automation(_LatestSelected)
If .Working Or .IsManual Then .ForceStart() : Refill()
If .Working Or .IsManual Then .ForceStart() : LIST_PLANS_Refresh(_LatestSelected)
End With
End If
End Sub
@@ -388,10 +472,10 @@ Namespace DownloadObjects
Select Case mode
Case String.Empty
Settings.Automation(_LatestSelected).Skip()
Refill()
LIST_PLANS_Refresh(_LatestSelected)
Case "m"
Dim mins% = AConvert(Of Integer)(InputBoxE("Enter a number of minutes you want to delay:", Sender.Text, 60), -1)
If mins > 0 Then Settings.Automation(_LatestSelected).Skip(mins) : Refill()
If mins > 0 Then Settings.Automation(_LatestSelected).Skip(mins) : LIST_PLANS_Refresh(_LatestSelected)
Case "d"
Dim d As Date? = Nothing
Using f As New DateTimeSelectionForm(DateTimeSelectionForm.Modes.Date +
@@ -402,16 +486,13 @@ Namespace DownloadObjects
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then d = f.MyDateStart
End Using
If d.HasValue Then Settings.Automation(_LatestSelected).Skip(d.Value) : Refill()
If d.HasValue Then Settings.Automation(_LatestSelected).Skip(d.Value) : LIST_PLANS_Refresh(_LatestSelected)
Case "r"
Settings.Automation(_LatestSelected).SkipReset()
Refill()
LIST_PLANS_Refresh(_LatestSelected)
End Select
End If
End Sub
Private Sub PauseArr_Updating() Handles PauseArr.Updating
Refill()
End Sub
#End Region
#Region "Move"
Private Sub BTT_MOVE_UP_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_MOVE_UP.Click, BTT_MOVE_DOWN.Click

View File

@@ -35,6 +35,7 @@ Namespace DownloadObjects
Dim MENU_LOAD_SEP_7 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_0 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_8 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_9 As System.Windows.Forms.ToolStripSeparator
Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
@@ -44,6 +45,8 @@ Namespace DownloadObjects
Me.BTT_LOAD_SESSION_CHOOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_COPY_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MOVE_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_COPY_SPEC_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MOVE_SPEC_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_FAV = New System.Windows.Forms.ToolStripMenuItem()
@@ -57,19 +60,22 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_DATE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CURR_SESSION_SET = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_SESSIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_RESET_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_FEEDS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CHECK_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CHECK_NONE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_SAVE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_LOAD = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_DOWN_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
Me.BTT_VIEW_SAVE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_LOAD = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CURR_SESSION_SET_LAST = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
@@ -82,6 +88,7 @@ Namespace DownloadObjects
MENU_LOAD_SEP_7 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_0 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_8 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_9 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout()
'
@@ -157,6 +164,16 @@ Namespace DownloadObjects
MENU_LOAD_SEP_0.Name = "MENU_LOAD_SEP_0"
MENU_LOAD_SEP_0.Size = New System.Drawing.Size(349, 6)
'
'MENU_LOAD_SEP_8
'
MENU_LOAD_SEP_8.Name = "MENU_LOAD_SEP_8"
MENU_LOAD_SEP_8.Size = New System.Drawing.Size(349, 6)
'
'MENU_LOAD_SEP_9
'
MENU_LOAD_SEP_9.Name = "MENU_LOAD_SEP_9"
MENU_LOAD_SEP_9.Size = New System.Drawing.Size(349, 6)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
@@ -170,7 +187,7 @@ Namespace DownloadObjects
'
Me.MENU_LOAD_SESSION.AutoToolTip = False
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_0, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_4, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE, MENU_LOAD_SEP_5, Me.BTT_MERGE_SESSIONS, Me.BTT_CLEAR_DAILY, MENU_LOAD_SEP_6, Me.BTT_MERGE_FEEDS, MENU_LOAD_SEP_7, Me.BTT_CHECK_ALL, Me.BTT_CHECK_NONE, MENU_LOAD_SEP_8, Me.BTT_VIEW_SAVE, Me.BTT_VIEW_LOAD})
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_0, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, MENU_LOAD_SEP_1, Me.BTT_COPY_SPEC_TO, Me.BTT_MOVE_SPEC_TO, MENU_LOAD_SEP_2, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_4, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_5, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE, MENU_LOAD_SEP_6, Me.BTT_CURR_SESSION_SET, Me.BTT_CURR_SESSION_SET_LAST, Me.BTT_MERGE_SESSIONS, Me.BTT_CLEAR_DAILY, Me.BTT_RESET_DAILY, MENU_LOAD_SEP_7, Me.BTT_MERGE_FEEDS, MENU_LOAD_SEP_8, Me.BTT_CHECK_ALL, Me.BTT_CHECK_NONE, MENU_LOAD_SEP_9, Me.BTT_VIEW_SAVE, Me.BTT_VIEW_LOAD})
Me.MENU_LOAD_SESSION.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION"
@@ -212,6 +229,24 @@ Namespace DownloadObjects
Me.BTT_MOVE_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_MOVE_TO.Text = "Move checked to..."
'
'BTT_COPY_SPEC_TO
'
Me.BTT_COPY_SPEC_TO.AutoToolTip = True
Me.BTT_COPY_SPEC_TO.Image = Global.SCrawler.My.Resources.Resources.PastePic_32
Me.BTT_COPY_SPEC_TO.Name = "BTT_COPY_SPEC_TO"
Me.BTT_COPY_SPEC_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_COPY_SPEC_TO.Text = "Copy feed/session files to..."
Me.BTT_COPY_SPEC_TO.ToolTipText = "Copy all the files of the loaded feed/session to..."
'
'BTT_MOVE_SPEC_TO
'
Me.BTT_MOVE_SPEC_TO.AutoToolTip = True
Me.BTT_MOVE_SPEC_TO.Image = Global.SCrawler.My.Resources.Resources.CutPic_48
Me.BTT_MOVE_SPEC_TO.Name = "BTT_MOVE_SPEC_TO"
Me.BTT_MOVE_SPEC_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_MOVE_SPEC_TO.Text = "Move feed/session files to..."
Me.BTT_MOVE_SPEC_TO.ToolTipText = "Move all the files of the loaded feed/session to..."
'
'BTT_LOAD_FAV
'
Me.BTT_LOAD_FAV.Image = Global.SCrawler.My.Resources.Resources.HeartPic_32
@@ -303,6 +338,15 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_DAILY_DATE.Size = New System.Drawing.Size(352, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)"
'
'BTT_CURR_SESSION_SET
'
Me.BTT_CURR_SESSION_SET.AutoToolTip = True
Me.BTT_CURR_SESSION_SET.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_CURR_SESSION_SET.Name = "BTT_CURR_SESSION_SET"
Me.BTT_CURR_SESSION_SET.Size = New System.Drawing.Size(352, 22)
Me.BTT_CURR_SESSION_SET.Text = "Set current session..."
Me.BTT_CURR_SESSION_SET.ToolTipText = "Select one of the download sessions and set it as the current session"
'
'BTT_MERGE_SESSIONS
'
Me.BTT_MERGE_SESSIONS.AutoToolTip = True
@@ -322,6 +366,15 @@ Namespace DownloadObjects
Me.BTT_CLEAR_DAILY.Text = "Clear session"
Me.BTT_CLEAR_DAILY.ToolTipText = "Clear current session"
'
'BTT_RESET_DAILY
'
Me.BTT_RESET_DAILY.AutoToolTip = True
Me.BTT_RESET_DAILY.Image = Global.SCrawler.My.Resources.Resources.RefreshPic_24
Me.BTT_RESET_DAILY.Name = "BTT_RESET_DAILY"
Me.BTT_RESET_DAILY.Size = New System.Drawing.Size(352, 22)
Me.BTT_RESET_DAILY.Text = "Reset current session"
Me.BTT_RESET_DAILY.ToolTipText = "A new file will be created for the current session"
'
'BTT_MERGE_FEEDS
'
Me.BTT_MERGE_FEEDS.AutoToolTip = True
@@ -343,6 +396,20 @@ Namespace DownloadObjects
Me.BTT_CHECK_NONE.Size = New System.Drawing.Size(352, 22)
Me.BTT_CHECK_NONE.Text = "Select none"
'
'BTT_VIEW_SAVE
'
Me.BTT_VIEW_SAVE.Name = "BTT_VIEW_SAVE"
Me.BTT_VIEW_SAVE.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_SAVE.Text = "Save current view"
'
'BTT_VIEW_LOAD
'
Me.BTT_VIEW_LOAD.AutoToolTip = True
Me.BTT_VIEW_LOAD.Name = "BTT_VIEW_LOAD"
Me.BTT_VIEW_LOAD.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_LOAD.Text = "Load view (from saved)"
Me.BTT_VIEW_LOAD.ToolTipText = "Load one of your previously saved views"
'
'SEP_0
'
Me.SEP_0.Name = "SEP_0"
@@ -409,24 +476,12 @@ Namespace DownloadObjects
Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1
'
'MENU_LOAD_SEP_8
'BTT_CURR_SESSION_SET_LAST
'
MENU_LOAD_SEP_8.Name = "MENU_LOAD_SEP_8"
MENU_LOAD_SEP_8.Size = New System.Drawing.Size(349, 6)
'
'BTT_VIEW_SAVE
'
Me.BTT_VIEW_SAVE.Name = "BTT_VIEW_SAVE"
Me.BTT_VIEW_SAVE.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_SAVE.Text = "Save current view"
'
'BTT_VIEW_LOAD
'
Me.BTT_VIEW_LOAD.AutoToolTip = True
Me.BTT_VIEW_LOAD.Name = "BTT_VIEW_LOAD"
Me.BTT_VIEW_LOAD.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_LOAD.Text = "Load view (from saved)"
Me.BTT_VIEW_LOAD.ToolTipText = "Load one of your previously saved views"
Me.BTT_CURR_SESSION_SET_LAST.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_CURR_SESSION_SET_LAST.Name = "BTT_CURR_SESSION_SET_LAST"
Me.BTT_CURR_SESSION_SET_LAST.Size = New System.Drawing.Size(352, 22)
Me.BTT_CURR_SESSION_SET_LAST.Text = "Set last download session as current session"
'
'DownloadFeedForm
'
@@ -483,5 +538,10 @@ Namespace DownloadObjects
Private WithEvents BTT_MOVE_TO As ToolStripMenuItem
Private WithEvents BTT_VIEW_SAVE As ToolStripMenuItem
Private WithEvents BTT_VIEW_LOAD As ToolStripMenuItem
Private WithEvents BTT_CURR_SESSION_SET As ToolStripMenuItem
Private WithEvents BTT_COPY_SPEC_TO As ToolStripMenuItem
Private WithEvents BTT_MOVE_SPEC_TO As ToolStripMenuItem
Private WithEvents BTT_RESET_DAILY As ToolStripMenuItem
Private WithEvents BTT_CURR_SESSION_SET_LAST As ToolStripMenuItem
End Class
End Namespace

View File

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

View File

@@ -276,7 +276,6 @@ Namespace DownloadObjects
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Feed removed")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
@@ -440,7 +439,9 @@ Namespace DownloadObjects
End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False,
Optional ByRef ResultFilesList As List(Of SFile) = Nothing,
Optional ByVal SelectedMode As FeedModes = -1)
Optional ByVal SelectedMode As FeedModes = -1,
Optional ByVal GetSessionFile As Boolean = False,
Optional ByRef SessionFile As SFile = Nothing)
Try
LoadedSessionName = String.Empty
Downloader.ClearSessions()
@@ -475,6 +476,12 @@ Namespace DownloadObjects
If fList.ListExists Then
If GetFilesOnly Then
ResultFilesList.AddRange(fList)
ElseIf GetSessionFile Then
If fList.Count > 1 Then
MsgBoxE({"You must select one session file", "Get session file"}, vbExclamation)
Else
SessionFile = fList(0)
End If
Else
DataList.Clear()
If SelectedMode >= 0 Then
@@ -508,17 +515,21 @@ Namespace DownloadObjects
f = Downloader.FilesSessionActual(False)
End If
If f.Exists Then
If SelectedMode >= 0 Then
If SelectedMode = FeedModes.Saved Then LoadedSessionName = f.Name
FeedChangeMode(SelectedMode)
If GetSessionFile Then
If Not Downloader.FilesSessionActual(False) = f Then SessionFile = f
Else
If SelectedMode >= 0 Then
If SelectedMode = FeedModes.Saved Then LoadedSessionName = f.Name
FeedChangeMode(SelectedMode)
End If
DataList.Clear()
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then DataList.ListAddList(x, lcr)
x.Dispose()
CleanDataList()
RefillList(False, False)
End If
DataList.Clear()
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then DataList.ListAddList(x, lcr)
x.Dispose()
CleanDataList()
RefillList(False, False)
End If
Else
m.Text = "Saved sessions not found"
@@ -533,14 +544,20 @@ Namespace DownloadObjects
Private Sub BTT_COPY_MOVE_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_TO.Click, BTT_MOVE_TO.Click
MoveCopyFiles(True, sender, Nothing, Nothing)
End Sub
Private Function MoveCopyFiles(ByVal IsInternal As Boolean, ByVal Sender As Object, ByVal MCTOptions As FeedMoveCopyTo, ByVal FeedMediaData As FeedMedia) As Boolean
Private Sub BTT_COPY_MOVE_SPEC_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_SPEC_TO.Click, BTT_MOVE_SPEC_TO.Click
MoveCopyFiles(True, sender, Nothing, Nothing, False)
End Sub
Private Function MoveCopyFiles(ByVal IsInternal As Boolean, ByVal Sender As Object, ByVal MCTOptions As FeedMoveCopyTo,
ByVal FeedMediaData As FeedMedia, Optional ByVal GetChecked As Boolean = True) As Boolean
Const MsgTitle$ = "Copy/Move checked files"
Try
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso Sender Is BTT_COPY_TO
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso (Sender Is BTT_COPY_TO OrElse Sender Is BTT_COPY_SPEC_TO)
Dim moveOptions As FeedMoveCopyTo = Nothing
Dim ff As SFile = Nothing, df As SFile
Dim data As IEnumerable(Of UserMediaD) = Nothing
Dim dd As UserMediaD
Dim __user As UserInfo
Dim __isSavedPosts As Boolean
Dim data_files As IEnumerable(Of SFile) = Nothing
Dim new_files As New List(Of SFile)
Dim mm As UserMediaD
@@ -559,7 +576,12 @@ Namespace DownloadObjects
Dim result As Boolean = False
If FeedMediaData Is Nothing Then
data = GetCheckedMedia()
If GetChecked Then
data = GetCheckedMedia()
ElseIf DataList.Count > 0 Then
data = DataList.Where(Function(__dd) Not If(__dd.User?.IsSubscription, __dd.UserInfo.IsSubscription) AndAlso __dd.Data.File.Exists)
End If
With data
If .ListExists Then data_files = .Select(Function(m) m.Data.File)
End With
@@ -580,7 +602,6 @@ Namespace DownloadObjects
With moveOptions
If Not .Destination.IsEmptyString And .ReplaceUserProfile And .ReplaceUserProfile_CreateIfNull And .ReplaceUserProfile_Profile Is Nothing Then
Dim existingPathInstances As IEnumerable(Of String) = Nothing
Dim __user As UserInfo
Dim __host As Plugin.Hosts.SettingsHost = Settings(API.PathPlugin.PluginKey).Default
Dim __userName$ = .Destination.Segments.LastOrDefault
If Settings.UsersList.Count > 0 Then _
@@ -652,9 +673,12 @@ Namespace DownloadObjects
indx = Downloader.Files.FindIndex(finder)
If indx >= 0 Then
mm = Downloader.Files(indx)
__user = mm.UserInfo
mm_data = mm.Data
mm_data.File = df
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date)
__isSavedPosts = mm.IsSavedPosts And moveOptions.ReplaceUserProfile_Profile Is Nothing
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date) With {.IsSavedPosts = __isSavedPosts}
If __isSavedPosts Then mm.UserInfo = __user
Downloader.Files(indx) = mm
downloaderFilesUpdated = True
End If
@@ -680,9 +704,12 @@ Namespace DownloadObjects
indx = sessionData.FindIndex(finder)
If indx >= 0 Then
mm = sessionData(indx)
__user = mm.UserInfo
mm_data = mm.Data
mm_data.File = df
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date)
__isSavedPosts = mm.IsSavedPosts And moveOptions.ReplaceUserProfile_Profile Is Nothing
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date) With {.IsSavedPosts = __isSavedPosts}
If __isSavedPosts Then mm.UserInfo = __user
sessionData(indx) = mm
sesFilesReplaced = True
If DataList.Count > 0 Then
@@ -861,7 +888,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by list)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub BTT_FEED_DELETE_DAILY_DATE_Click(sender As Object, e As EventArgs) Handles BTT_FEED_DELETE_DAILY_DATE.Click
@@ -899,20 +925,23 @@ Namespace DownloadObjects
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by date)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region
#Region "Clear session"
Private Sub BTT_CLEAR_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DAILY.Click
If MsgBoxE({"Are you sure you want to clear this session data?", "Clear session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.Files.Clear()
ClearTable()
RefillList()
End If
#Region "Sessions set, merge, clear"
Private Sub BTT_CURR_SESSION_SET_Click(sender As Object, e As EventArgs) Handles BTT_CURR_SESSION_SET.Click, BTT_CURR_SESSION_SET_LAST.Click
Try
Dim f As SFile = Nothing
SessionChooser(sender Is BTT_CURR_SESSION_SET_LAST,,,, True, f)
If Not f.IsEmptyString AndAlso f.Exists Then
Downloader.FilesLoadLastSession(f)
FeedChangeMode(FeedModes.Current)
RefillList(True, False)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Replace current session")
End Try
End Sub
#End Region
#Region "Merge feeds"
Private Sub BTT_MERGE_SESSIONS_Click(sender As Object, e As EventArgs) Handles BTT_MERGE_SESSIONS.Click
Try
Const msgTitle$ = "Merge feeds"
@@ -973,6 +1002,23 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.MergeSessions]")
End Try
End Sub
Private Sub BTT_CLEAR_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DAILY.Click
If MsgBoxE({"Are you sure you want to clear this session data?", "Clear session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.Files.Clear()
ClearTable()
RefillList()
End If
End Sub
Private Sub BTT_RESET_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_RESET_DAILY.Click
If MsgBoxE({"Are you sure you want to reset the current session?" & vbCr &
"A new file will be created for the current session", "Reset current session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.ResetSession()
FeedChangeMode(FeedModes.Current)
RefillList(True, False)
End If
End Sub
#End Region
#Region "Merge feeds"
Private Sub BTT_MERGE_FEEDS_Click(sender As Object, e As EventArgs) Handles BTT_MERGE_FEEDS.Click
Try
Const msgTitle$ = "Merge feeds"

View File

@@ -221,8 +221,8 @@ Namespace DownloadObjects
Information = $"Type: {Media.Data.Type}"
Information.StringAppendLine($"File: {File.File}")
Information.StringAppendLine($"Address: {File}")
Information.StringAppendLine($"Downloaded: {Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)}")
If Media.Data.Post.Date.HasValue Then Information.StringAppendLine($"Posted: {Media.Data.Post.Date.Value.ToStringDate(ADateTime.Formats.BaseDateTime)}")
Information.StringAppendLine($"Downloaded: {Media.Date.ToStringDateDef}")
If Media.Data.Post.Date.HasValue Then Information.StringAppendLine($"Post date: {Media.Data.Post.Date.Value.ToStringDateDef}")
Dim infoType As UserMedia.Types = If(IsSubscription, UserMedia.Types.Picture, Media.Data.Type)
Dim h%
Dim s As Size
@@ -267,23 +267,27 @@ Namespace DownloadObjects
BTT_CONTEXT_OPEN_MEDIA.Text &= " video"
BTT_CONTEXT_DELETE.Text &= " video"
h = VideoHeight
AddHandler MyVideo.DoubleClick, AddressOf MyPicture_DoubleClick
Case Else : Throw New ArgumentNullException With {.HelpLink = 1}
End Select
Dim info$ = $"[{infoType}] - "
Dim info$ = If(Settings.FeedAddTypeToCaption.Value And Not IsSubscription, $"[{infoType}] - ", String.Empty)
If Not Media.User Is Nothing Then
With Media.User
Dim otherName$ = If(Media.IsSavedPosts, "Saved", Media.UserInfo.Name)
Dim site$ = If(Settings.FeedAddSiteToCaption.Value, $"{ .Site} - ", String.Empty)
UserKey = .Key
Information &= vbNewLine.StringDup(2)
If .IncludedInCollection Then Information.StringAppendLine($"User collection: { .CollectionName}")
Information.StringAppendLine($"User site: { .Site}")
Information.StringAppendLine($"User name: {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}")
Information.StringAppendLine($"User name: {CStr(IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)).IfNullOrEmpty(otherName)}")
If .IncludedInCollection Then info &= $"[{ .CollectionName}]: "
If Settings.FeedShowFriendlyNames Or Not DirectCast(.Self, UserDataBase).FeedIsUser Then
info &= $"{ .Site} - { .FriendlyName.IfNullOrEmpty(.Name)}"
info &= $"{site}{ .FriendlyName.IfNullOrEmpty(.Name).IfNullOrEmpty(otherName)}"
Else
info &= $"{ .Site} - {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}"
info &= $"{site}{CStr(IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)).IfNullOrEmpty(otherName)}"
End If
End With
End If

View File

@@ -139,7 +139,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecial.UpdateUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Friend Overloads Shared Function UpdateUsers(ByVal Item As UserMediaD, ByVal InitialUser As UserInfo, ByVal NewUser As UserInfo,
@@ -148,6 +147,7 @@ Namespace DownloadObjects
Dim user As IUserData
Dim path$ = InitialUser.File.CutPath.PathWithSeparator
Dim pathNew$ = NewUser.File.CutPath.PathWithSeparator
Dim isSaved As Boolean = Item.IsSavedPosts
If Item.UserInfo.Equals(InitialUser) Or Item.UserInfo.Equals(NewUser) Then
If Item.Data.File.PathWithSeparator.Contains(path) Then
data = Item.Data
@@ -157,8 +157,9 @@ Namespace DownloadObjects
Else
user = Item.User
End If
If isSaved Then isSaved = Item.UserInfo.Equals(DirectCast(user, UserDataBase).User)
If Not If(user?.IsSubscription, False) Then
Item = New UserMediaD(data, user, Item.Session, Item.Date)
Item = New UserMediaD(data, user, Item.Session, Item.Date) With {.IsSavedPosts = isSaved}
Result = True
Return Item
End If
@@ -175,8 +176,11 @@ Namespace DownloadObjects
If indx >= 0 Then
Dim m As UserMediaD = Items(indx)
Dim mm As UserMedia = m.Data
Dim user As UserInfo = m.UserInfo
Dim __isSavedPosts As Boolean = m.IsSavedPosts And MCTOptions.ReplaceUserProfile_Profile Is Nothing
mm.File = NewFile
m = New UserMediaD(mm, If(MCTOptions.ReplaceUserProfile_Profile, m.User), m.Session, m.Date)
m = New UserMediaD(mm, If(MCTOptions.ReplaceUserProfile_Profile, m.User), m.Session, m.Date) With {.IsSavedPosts = __isSavedPosts}
If __isSavedPosts Then m.UserInfo = user
Items(indx) = m
_FilesUpdated = True
End If

View File

@@ -111,7 +111,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecialCollection.Load]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Feeds_FeedDeleted(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
@@ -245,7 +244,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecialCollection.UpdateUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region

View File

@@ -176,5 +176,9 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"An error occurred while performing action [{ActionName}] on file [{MediaFile}]")
End Try
End Function
Private Sub MyVideo_DoubleClick(sender As Object, e As EventArgs) Handles MyVideo.DoubleClick
[Stop]()
OnDoubleClick(e)
End Sub
End Class
End Namespace

View File

@@ -93,7 +93,6 @@ Namespace DownloadObjects.STDownloader
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[STDownloader.DownloaderUrlForm.TXT_URL_ActionOnTextChanged]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub TXT_PATH_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_PATH.ActionOnButtonClick

View File

@@ -108,7 +108,6 @@ Namespace DownloadObjects.STDownloader
Catch ex As Exception
_UseAccountName = True
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[STDownloader.DownloaderUrlsArrForm.TXT_URLS_TextChanged]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
End Class

View File

@@ -226,9 +226,5 @@ Namespace DownloadObjects.STDownloader
RemoveControls(ControlNonYT, False)
End If
End Sub
Protected Overrides Sub MyJob_Finished(ByVal Sender As Object, ByVal e As EventArgs)
MainFrameObj.UpdateLogButton()
MyBase.MyJob_Finished(Sender, e)
End Sub
End Class
End Namespace

View File

@@ -39,7 +39,7 @@ Namespace DownloadObjects
#End Region
Friend ReadOnly User As IUserData
Friend ReadOnly Data As UserMedia
Friend ReadOnly UserInfo As UserInfo
Friend UserInfo As UserInfo
Friend ReadOnly [Date] As Date
Friend Session As Integer
Friend IsSavedPosts As Boolean
@@ -149,29 +149,35 @@ Namespace DownloadObjects
End Try
End Function
Private _FilesSessionChecked_Impl As Boolean = False
Friend Sub FilesLoadLastSession()
Friend Sub FilesLoadLastSession(Optional ByVal SelectedSessionFile As SFile = Nothing)
Try
If Not _FilesSessionChecked And Not _FilesSessionChecked_Impl And _FilesSessionActual.IsEmptyString Then
If Not SelectedSessionFile.IsEmptyString Or (Not _FilesSessionChecked And Not _FilesSessionChecked_Impl And _FilesSessionActual.IsEmptyString) Then
_FilesSessionChecked = True
_FilesSessionChecked_Impl = True
Dim settingValue% = Settings.FeedCurrentTryLoadLastSession
If settingValue >= 0 Then
Dim ssfExists As Boolean = Not SelectedSessionFile.IsEmptyString AndAlso SelectedSessionFile.Exists
If settingValue >= 0 Or ssfExists Then
Dim startTime As Date = Process.GetCurrentProcess.StartTime
Dim files As List(Of SFile) = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
If files.ListExists Then files.RemoveAll(Settings.Feeds.FeedSpecialRemover)
If files.ListExists Then
Dim nd$ = Now.ToString("yyyyMMdd")
files.RemoveAll(Function(f) Not f.Name.StartsWith(nd))
Dim files As List(Of SFile)
If ssfExists Then
files = New List(Of SFile) From {SelectedSessionFile}
Else
files = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
If files.ListExists Then files.RemoveAll(Settings.Feeds.FeedSpecialRemover)
If files.ListExists Then
Dim nd$ = Now.ToString("yyyyMMdd")
files.RemoveAll(Function(f) Not f.Name.StartsWith(nd))
End If
End If
If files.ListExists Then
files.Sort()
Dim lastDate As Date = AConvert(Of Date)(files.Last.Name, SessionDateTimeProvider)
If lastDate.Date = startTime.Date Then
If ssfExists Or lastDate.Date = startTime.Date Then
Dim __files As New List(Of UserMediaD)
Using x As New XmlFile(files.Last, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then __files.ListAddList(x, LAP.IgnoreICopier)
If __files.Count > 0 AndAlso (settingValue = 0 OrElse
If __files.Count > 0 AndAlso (settingValue = 0 OrElse ssfExists OrElse
(startTime - {lastDate, __files.Max(Function(f) f.Date)}.Max).TotalMinutes <= settingValue) Then
_Session = __files.Max(Function(f) f.Session)
Me.Files.AddRange(__files)
@@ -228,7 +234,6 @@ Namespace DownloadObjects
Catch ex As Exception
_FilesUpdating = False
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[TDownloader.FilesUpdatePendingUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Friend Sub ClearSessions()
@@ -252,6 +257,13 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.ClearSessions]")
End Try
End Sub
Friend Sub ResetSession()
Files.Clear()
_FilesSessionActual = Nothing
_FilesSessionChecked = True
_Session = 0
_SessionSavedPosts = -1
End Sub
#End Region
Friend ReadOnly Property Downloaded As List(Of IUserData)
Private ReadOnly NProv As IFormatProvider
@@ -536,10 +548,8 @@ Namespace DownloadObjects
If Pool.Count > 0 Then Pool.ForEach(Sub(p) If Not p.Progress Is Nothing Then p.Progress.Maximum = 0)
ExecuteCommand(Settings.DownloadsCompleteCommand)
UpdateJobsLabel()
If MissingPostsDetected And Settings.AddMissingToLog Then
MyMainLOG = "Some posts didn't download. You can see them in the 'Missing posts' form."
MainFrameObj.UpdateLogButton()
End If
If MissingPostsDetected And Settings.AddMissingToLog Then _
MyMainLOG = "Some posts didn't download. You can see them in the 'Missing posts' form."
Files.Sort()
FilesChanged = Not fBefore = Files.Count
RaiseEvent Downloading(False)
@@ -612,6 +622,7 @@ Namespace DownloadObjects
Dim limitIndex%
Dim limits As New List(Of HostLimit)
Dim Keys As New List(Of String)
Dim KeysSkipped As New List(Of String)
Dim h As Boolean = False
Dim host As SettingsHost = Nothing
Dim hostAvailable As Boolean
@@ -638,6 +649,8 @@ Namespace DownloadObjects
limit = limit.Next
limits(limitIndex) = limit
If limit.Value >= limit.Limit Then Exit For
Else
KeysSkipped.Add(_Item.Key)
End If
End If
End If
@@ -655,24 +668,27 @@ Namespace DownloadObjects
For Each k$ In Keys
i = _Job.Items.FindIndex(Function(ii) ii.Key = k)
If i >= 0 Then
With _Job.Items(i)
If DirectCast(.Self, UserDataBase).ContentMissingExists Then MissingPostsDetected = True
RaiseEvent UserDownloadStateChanged(.Self, False)
host = _Job.UserHost(.Self)
host.AfterDownload(.Self, Download.Main)
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
If Not Downloaded.Contains(.Self) Then Downloaded.Add(Settings.GetUser(.Self))
With DirectCast(.Self, UserDataBase)
If .LatestData.Count > 0 And .IncludeInTheFeed Then Files.ListAddList(.LatestData.Select(Function(d) New UserMediaD(d, .Self, Session)), FilesLP)
End With
dcc = True
End If
End With
If KeysSkipped.Count = 0 OrElse Not KeysSkipped.Contains(k) Then
With _Job.Items(i)
If DirectCast(.Self, UserDataBase).ContentMissingExists Then MissingPostsDetected = True
RaiseEvent UserDownloadStateChanged(.Self, False)
host = _Job.UserHost(.Self)
host.AfterDownload(.Self, Download.Main)
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
If Not Downloaded.Contains(.Self) Then Downloaded.Add(Settings.GetUser(.Self))
With DirectCast(.Self, UserDataBase)
If .LatestData.Count > 0 And .IncludeInTheFeed Then Files.ListAddList(.LatestData.Select(Function(d) New UserMediaD(d, .Self, Session)), FilesLP)
End With
dcc = True
End If
End With
End If
_Job.Items.RemoveAt(i)
End If
Next
End If
Keys.Clear()
KeysSkipped.Clear()
_Job.Items.RemoveAll(Function(ii) ii.Disposed)
If dcc Then Downloaded.RemoveAll(Function(u) u Is Nothing)
If dcc And Downloaded.Count > 0 Then RaiseEvent DownloadCountChange()

View File

@@ -167,6 +167,7 @@ Namespace Editors
Me.TXT_DOWN_COMPLETE_SCRIPT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_UNAME_UP = New System.Windows.Forms.CheckBox()
Me.CH_UICON_UP = New System.Windows.Forms.CheckBox()
Me.TXT_AUTO_BRUSH_MIN = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FEED_ROWS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FEED_COLUMNS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_FEED_ENDLESS = New System.Windows.Forms.CheckBox()
@@ -178,6 +179,7 @@ Namespace Editors
Me.CH_FEED_SHOW_SPEC_MEDIAITEM = New System.Windows.Forms.CheckBox()
Me.NUM_FEED_STORE_SESSION_DATA = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.NUM_FEED_SES_CURR_LOAD_LAST = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_FEED_ADD_SITE = New System.Windows.Forms.CheckBox()
Me.TXT_YTDLP = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FFMPEG = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_CURL = New PersonalUtilities.Forms.Controls.TextBoxExtended()
@@ -203,6 +205,7 @@ Namespace Editors
Me.TAB_MAIN = New System.Windows.Forms.TabControl()
Me.TAB_ENVIR = New System.Windows.Forms.TabPage()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
Me.CH_FEED_ADD_TYPE = New System.Windows.Forms.CheckBox()
TP_BASIS = New System.Windows.Forms.TableLayoutPanel()
TP_IMAGES = New System.Windows.Forms.TableLayoutPanel()
TP_FILE_NAME = New System.Windows.Forms.TableLayoutPanel()
@@ -269,6 +272,7 @@ Namespace Editors
CType(Me.TXT_SCRIPT, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_DOWN_COMPLETE_SCRIPT, System.ComponentModel.ISupportInitialize).BeginInit()
TP_MISSING_DATA.SuspendLayout()
CType(Me.TXT_AUTO_BRUSH_MIN, System.ComponentModel.ISupportInitialize).BeginInit()
TAB_FEED.SuspendLayout()
TP_FEED.SuspendLayout()
TP_FEED_IMG_COUNT.SuspendLayout()
@@ -947,10 +951,10 @@ Namespace Editors
'
Me.CH_FEED_OPEN_LAST_MODE.AutoSize = True
Me.CH_FEED_OPEN_LAST_MODE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_OPEN_LAST_MODE.Location = New System.Drawing.Point(4, 195)
Me.CH_FEED_OPEN_LAST_MODE.Location = New System.Drawing.Point(4, 247)
Me.CH_FEED_OPEN_LAST_MODE.Name = "CH_FEED_OPEN_LAST_MODE"
Me.CH_FEED_OPEN_LAST_MODE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_OPEN_LAST_MODE.TabIndex = 7
Me.CH_FEED_OPEN_LAST_MODE.TabIndex = 9
Me.CH_FEED_OPEN_LAST_MODE.Text = "Open last mode (users or subscriptions)"
TT_MAIN.SetToolTip(Me.CH_FEED_OPEN_LAST_MODE, "If disabled, the user mode will be used when initializing the feed.")
Me.CH_FEED_OPEN_LAST_MODE.UseVisualStyleBackColor = True
@@ -1060,10 +1064,10 @@ Namespace Editors
'
Me.CH_FEED_UP_FILE_LOC_MOVE.AutoSize = True
Me.CH_FEED_UP_FILE_LOC_MOVE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_UP_FILE_LOC_MOVE.Location = New System.Drawing.Point(4, 273)
Me.CH_FEED_UP_FILE_LOC_MOVE.Location = New System.Drawing.Point(4, 325)
Me.CH_FEED_UP_FILE_LOC_MOVE.Name = "CH_FEED_UP_FILE_LOC_MOVE"
Me.CH_FEED_UP_FILE_LOC_MOVE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_UP_FILE_LOC_MOVE.TabIndex = 10
Me.CH_FEED_UP_FILE_LOC_MOVE.TabIndex = 12
Me.CH_FEED_UP_FILE_LOC_MOVE.Text = "Update file location when moved"
TT_MAIN.SetToolTip(Me.CH_FEED_UP_FILE_LOC_MOVE, "The file location will be updated in the session data and in the feeds data")
Me.CH_FEED_UP_FILE_LOC_MOVE.UseVisualStyleBackColor = True
@@ -1488,10 +1492,11 @@ Namespace Editors
TP_DOWNLOADING.Controls.Add(Me.CH_UNAME_UP, 0, 1)
TP_DOWNLOADING.Controls.Add(Me.CH_UICON_UP, 0, 2)
TP_DOWNLOADING.Controls.Add(Me.CH_USE_DEF_ACC, 0, 9)
TP_DOWNLOADING.Controls.Add(Me.TXT_AUTO_BRUSH_MIN, 0, 10)
TP_DOWNLOADING.Dock = System.Windows.Forms.DockStyle.Fill
TP_DOWNLOADING.Location = New System.Drawing.Point(0, 0)
TP_DOWNLOADING.Name = "TP_DOWNLOADING"
TP_DOWNLOADING.RowCount = 11
TP_DOWNLOADING.RowCount = 12
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
@@ -1502,6 +1507,7 @@ Namespace Editors
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_DOWNLOADING.Size = New System.Drawing.Size(621, 399)
TP_DOWNLOADING.TabIndex = 1
@@ -1584,12 +1590,30 @@ Namespace Editors
Me.CH_UICON_UP.Text = "Update user icon and banner every time (where supported)"
Me.CH_UICON_UP.UseVisualStyleBackColor = True
'
'TXT_AUTO_BRUSH_MIN
'
Me.TXT_AUTO_BRUSH_MIN.CaptionText = "Highlight undownloaded plans (minutes)"
Me.TXT_AUTO_BRUSH_MIN.CaptionToolTipEnabled = True
Me.TXT_AUTO_BRUSH_MIN.CaptionToolTipText = "Highlight (in gray) the scheduler plans that have not been downloaded in 'x' minu" &
"tes." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "-1 to disable."
Me.TXT_AUTO_BRUSH_MIN.CaptionWidth = 200.0R
Me.TXT_AUTO_BRUSH_MIN.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.TXT_AUTO_BRUSH_MIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_AUTO_BRUSH_MIN.Location = New System.Drawing.Point(4, 280)
Me.TXT_AUTO_BRUSH_MIN.Name = "TXT_AUTO_BRUSH_MIN"
Me.TXT_AUTO_BRUSH_MIN.NumberMaximum = New Decimal(New Integer() {2147483646, 0, 0, 0})
Me.TXT_AUTO_BRUSH_MIN.NumberMinimum = New Decimal(New Integer() {1, 0, 0, -2147483648})
Me.TXT_AUTO_BRUSH_MIN.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
Me.TXT_AUTO_BRUSH_MIN.Size = New System.Drawing.Size(613, 22)
Me.TXT_AUTO_BRUSH_MIN.TabIndex = 10
Me.TXT_AUTO_BRUSH_MIN.Text = "-1"
'
'TAB_FEED
'
TAB_FEED.Controls.Add(TP_FEED)
TAB_FEED.Location = New System.Drawing.Point(4, 22)
TAB_FEED.Name = "TAB_FEED"
TAB_FEED.Size = New System.Drawing.Size(621, 399)
TAB_FEED.Size = New System.Drawing.Size(621, 374)
TAB_FEED.TabIndex = 7
TAB_FEED.Text = "Feed"
'
@@ -1601,32 +1625,35 @@ Namespace Editors
TP_FEED.Controls.Add(TP_FEED_IMG_COUNT, 0, 0)
TP_FEED.Controls.Add(Me.CH_FEED_ENDLESS, 0, 3)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_SESSION, 0, 4)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_DATE, 0, 5)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_DATE, 0, 7)
TP_FEED.Controls.Add(Me.TXT_FEED_CENTER_IMAGE, 0, 1)
TP_FEED.Controls.Add(Me.COLORS_FEED, 0, 2)
TP_FEED.Controls.Add(Me.CH_FEED_OPEN_LAST_MODE, 0, 7)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_FRIENDLY, 0, 8)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_SPEC_MEDIAITEM, 0, 9)
TP_FEED.Controls.Add(Me.CH_FEED_UP_FILE_LOC_MOVE, 0, 10)
TP_FEED.Controls.Add(TP_FEED_SES, 0, 6)
TP_FEED.Controls.Add(Me.CH_FEED_OPEN_LAST_MODE, 0, 9)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_FRIENDLY, 0, 10)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_SPEC_MEDIAITEM, 0, 11)
TP_FEED.Controls.Add(Me.CH_FEED_UP_FILE_LOC_MOVE, 0, 12)
TP_FEED.Controls.Add(TP_FEED_SES, 0, 8)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_SITE, 0, 5)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_TYPE, 0, 6)
TP_FEED.Dock = System.Windows.Forms.DockStyle.Fill
TP_FEED.Location = New System.Drawing.Point(0, 0)
TP_FEED.Name = "TP_FEED"
TP_FEED.RowCount = 12
TP_FEED.RowCount = 14
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_FEED.Size = New System.Drawing.Size(621, 399)
TP_FEED.Size = New System.Drawing.Size(621, 374)
TP_FEED.TabIndex = 0
'
'TP_FEED_IMG_COUNT
@@ -1704,10 +1731,10 @@ Namespace Editors
'
Me.CH_FEED_ADD_DATE.AutoSize = True
Me.CH_FEED_ADD_DATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_DATE.Location = New System.Drawing.Point(4, 140)
Me.CH_FEED_ADD_DATE.Location = New System.Drawing.Point(4, 192)
Me.CH_FEED_ADD_DATE.Name = "CH_FEED_ADD_DATE"
Me.CH_FEED_ADD_DATE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_ADD_DATE.TabIndex = 5
Me.CH_FEED_ADD_DATE.TabIndex = 7
Me.CH_FEED_ADD_DATE.Text = "Add the date to the post title"
Me.CH_FEED_ADD_DATE.UseVisualStyleBackColor = True
'
@@ -1747,10 +1774,10 @@ Namespace Editors
'
Me.CH_FEED_SHOW_FRIENDLY.AutoSize = True
Me.CH_FEED_SHOW_FRIENDLY.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_SHOW_FRIENDLY.Location = New System.Drawing.Point(4, 221)
Me.CH_FEED_SHOW_FRIENDLY.Location = New System.Drawing.Point(4, 273)
Me.CH_FEED_SHOW_FRIENDLY.Name = "CH_FEED_SHOW_FRIENDLY"
Me.CH_FEED_SHOW_FRIENDLY.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_SHOW_FRIENDLY.TabIndex = 8
Me.CH_FEED_SHOW_FRIENDLY.TabIndex = 10
Me.CH_FEED_SHOW_FRIENDLY.Text = "Show friendly names instead of usernames"
Me.CH_FEED_SHOW_FRIENDLY.UseVisualStyleBackColor = True
'
@@ -1758,10 +1785,10 @@ Namespace Editors
'
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.AutoSize = True
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Location = New System.Drawing.Point(4, 247)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Location = New System.Drawing.Point(4, 299)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Name = "CH_FEED_SHOW_SPEC_MEDIAITEM"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.TabIndex = 9
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.TabIndex = 11
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Text = "Show special feeds in media items"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.UseVisualStyleBackColor = True
'
@@ -1773,14 +1800,14 @@ Namespace Editors
TP_FEED_SES.Controls.Add(Me.NUM_FEED_STORE_SESSION_DATA, 0, 0)
TP_FEED_SES.Controls.Add(Me.NUM_FEED_SES_CURR_LOAD_LAST, 1, 0)
TP_FEED_SES.Dock = System.Windows.Forms.DockStyle.Fill
TP_FEED_SES.Location = New System.Drawing.Point(1, 163)
TP_FEED_SES.Location = New System.Drawing.Point(1, 215)
TP_FEED_SES.Margin = New System.Windows.Forms.Padding(0)
TP_FEED_SES.Name = "TP_FEED_SES"
TP_FEED_SES.RowCount = 1
TP_FEED_SES.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FEED_SES.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED_SES.Size = New System.Drawing.Size(619, 28)
TP_FEED_SES.TabIndex = 6
TP_FEED_SES.TabIndex = 8
'
'NUM_FEED_STORE_SESSION_DATA
'
@@ -1829,6 +1856,17 @@ Namespace Editors
Me.NUM_FEED_SES_CURR_LOAD_LAST.TabIndex = 1
Me.NUM_FEED_SES_CURR_LOAD_LAST.Text = "0"
'
'CH_FEED_ADD_SITE
'
Me.CH_FEED_ADD_SITE.AutoSize = True
Me.CH_FEED_ADD_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_SITE.Location = New System.Drawing.Point(4, 140)
Me.CH_FEED_ADD_SITE.Name = "CH_FEED_ADD_SITE"
Me.CH_FEED_ADD_SITE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_ADD_SITE.TabIndex = 5
Me.CH_FEED_ADD_SITE.Text = "Add the site name to the post title"
Me.CH_FEED_ADD_SITE.UseVisualStyleBackColor = True
'
'TAB_NOTIFY
'
TAB_NOTIFY.Controls.Add(TP_NOTIFY_MAIN)
@@ -2397,7 +2435,7 @@ Namespace Editors
Me.TAB_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TAB_MAIN.Name = "TAB_MAIN"
Me.TAB_MAIN.SelectedIndex = 0
Me.TAB_MAIN.Size = New System.Drawing.Size(629, 425)
Me.TAB_MAIN.Size = New System.Drawing.Size(629, 400)
Me.TAB_MAIN.TabIndex = 1
'
'TAB_ENVIR
@@ -2415,7 +2453,7 @@ Namespace Editors
'CONTAINER_MAIN.ContentPanel
'
Me.CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TAB_MAIN)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(629, 425)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(629, 400)
Me.CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_MAIN.LeftToolStripPanelVisible = False
Me.CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -2425,6 +2463,17 @@ Namespace Editors
Me.CONTAINER_MAIN.TabIndex = 0
Me.CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'CH_FEED_ADD_TYPE
'
Me.CH_FEED_ADD_TYPE.AutoSize = True
Me.CH_FEED_ADD_TYPE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_TYPE.Location = New System.Drawing.Point(4, 166)
Me.CH_FEED_ADD_TYPE.Name = "CH_FEED_ADD_TYPE"
Me.CH_FEED_ADD_TYPE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_ADD_TYPE.TabIndex = 6
Me.CH_FEED_ADD_TYPE.Text = "Add the file type to the post title"
Me.CH_FEED_ADD_TYPE.UseVisualStyleBackColor = True
'
'GlobalSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -2486,6 +2535,7 @@ Namespace Editors
CType(Me.TXT_DOWN_COMPLETE_SCRIPT, System.ComponentModel.ISupportInitialize).EndInit()
TP_MISSING_DATA.ResumeLayout(False)
TP_MISSING_DATA.PerformLayout()
CType(Me.TXT_AUTO_BRUSH_MIN, System.ComponentModel.ISupportInitialize).EndInit()
TAB_FEED.ResumeLayout(False)
TP_FEED.ResumeLayout(False)
TP_FEED.PerformLayout()
@@ -2636,5 +2686,8 @@ Namespace Editors
Private WithEvents CH_DOWN_ALL_NOTIFY As CheckBox
Private WithEvents CH_CHANNELS_USERS_READY_MARK As CheckBox
Private WithEvents NUM_FEED_SES_CURR_LOAD_LAST As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_AUTO_BRUSH_MIN As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_FEED_ADD_SITE As CheckBox
Private WithEvents CH_FEED_ADD_TYPE As CheckBox
End Class
End Namespace

View File

@@ -123,6 +123,7 @@ Namespace Editors
CH_ADD_MISSING_ERROS_TO_LOG.Checked = .AddMissingErrorsToLog
CH_DOWN_REPARSE_MISSING.Checked = .ReparseMissingInTheRoutine
CH_USE_DEF_ACC.Checked = .UseDefaultAccountIfMissing
TXT_AUTO_BRUSH_MIN.Value = .AutomationBrushUndownloadedPlansMinutes.Value
'Downloading: file names
CH_FILE_NAME_CHANGE.Checked = Not .FileReplaceNameByDate.Value = FileNameReplaceMode.None
OPT_FILE_NAME_REPLACE.Checked = .FileReplaceNameByDate.Value = FileNameReplaceMode.Replace
@@ -150,6 +151,8 @@ Namespace Editors
COLORS_FEED.ColorsSet(.FeedBackColor, .FeedForeColor, SystemColors.Window, SystemColors.WindowText)
CH_FEED_ENDLESS.Checked = .FeedEndless
CH_FEED_ADD_SESSION.Checked = .FeedAddSessionToCaption
CH_FEED_ADD_SITE.Checked = .FeedAddSiteToCaption
CH_FEED_ADD_TYPE.Checked = .FeedAddTypeToCaption
CH_FEED_ADD_DATE.Checked = .FeedAddDateToCaption
NUM_FEED_STORE_SESSION_DATA.Checked = .FeedStoreSessionsData
NUM_FEED_STORE_SESSION_DATA.Value = .FeedStoredSessionsNumber.Value
@@ -331,6 +334,7 @@ Namespace Editors
.AddMissingErrorsToLog.Value = CH_ADD_MISSING_ERROS_TO_LOG.Checked
.ReparseMissingInTheRoutine.Value = CH_DOWN_REPARSE_MISSING.Checked
.UseDefaultAccountIfMissing.Value = CH_USE_DEF_ACC.Checked
.AutomationBrushUndownloadedPlansMinutes.Value = TXT_AUTO_BRUSH_MIN.Value
'Downloading: file names
If CH_FILE_NAME_CHANGE.Checked Then
.FileReplaceNameByDate.Value = If(OPT_FILE_NAME_REPLACE.Checked, FileNameReplaceMode.Replace, FileNameReplaceMode.Add)
@@ -359,6 +363,8 @@ Namespace Editors
COLORS_FEED.ColorsGet(.FeedBackColor, .FeedForeColor)
.FeedEndless.Value = CH_FEED_ENDLESS.Checked
.FeedAddSessionToCaption.Value = CH_FEED_ADD_SESSION.Checked
.FeedAddSiteToCaption.Value = CH_FEED_ADD_SITE.Checked
.FeedAddTypeToCaption.Value = CH_FEED_ADD_TYPE.Checked
.FeedAddDateToCaption.Value = CH_FEED_ADD_DATE.Checked
.FeedStoreSessionsData.Value = NUM_FEED_STORE_SESSION_DATA.Checked
.FeedStoredSessionsNumber.Value = NUM_FEED_STORE_SESSION_DATA.Value

View File

@@ -313,7 +313,6 @@ Namespace Editors
BTT_START.Enabled = Not Working
BTT_CANCEL.Enabled = Working
End Sub, EDP.None)
If Not Working Then MainFrameObj.UpdateLogButton()
Catch
End Try
End Sub

View File

@@ -22,22 +22,10 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
Return NewLabels.Count > 0
End Get
End Property
'URGENT: remove these properties (2024.03)
<Obsolete> Friend ReadOnly Property Current As XMLValuesCollection(Of String)
<Obsolete> Friend ReadOnly Property Excluded As XMLValuesCollection(Of String)
<Obsolete> Friend ReadOnly Property ExcludedIgnore As XMLValue(Of Boolean)
Friend Sub New(ByRef x As XmlFile)
Friend Sub New()
LabelsList = New List(Of String)
NewLabels = New List(Of String)
If LabelsFile.Exists Then LabelsList.ListAddList(IO.File.ReadAllLines(LabelsFile), LAP.NotContainsOnly)
#Disable Warning BC40008
Current = New XMLValuesCollection(Of String)(IXMLValuesCollection.Modes.String, "LatestSelectedLabels",, x) With {.ListAddParameters = LAP.NotContainsOnly}
Excluded = New XMLValuesCollection(Of String)(IXMLValuesCollection.Modes.String, "LatestExcludedLabels",, x) With {.ListAddParameters = LAP.NotContainsOnly}
ExcludedIgnore = New XMLValue(Of Boolean)("LatestExcludedLabelsIgnore", False, x)
Dim lp As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier)
If Current.Count > 0 Then LabelsList.ListAddList(Current, lp)
If Excluded.Count > 0 Then LabelsList.ListAddList(Excluded, lp)
#Enable Warning
End Sub
Friend ReadOnly Property ToList As List(Of String)
Get
@@ -112,9 +100,7 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
#Disable Warning BC40008
If disposing Then Clear() : Current.Dispose() : Excluded.Dispose()
#Enable Warning
If disposing Then Clear()
disposedValue = True
End If
End Sub

View File

@@ -131,7 +131,6 @@ Public Class MainFrame
Await .Automation.Start(True)
End With
UpdatePauseButtonsVisibility()
MainFrameObj.UpdateLogButton()
End Sub
Private _CloseInvoked As Boolean = False
Private _IgnoreTrayOptions As Boolean = False
@@ -625,7 +624,6 @@ CloseResume:
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[MainFrame.ShowGroups]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region
@@ -652,7 +650,6 @@ CloseResume:
MainFrameObj.PauseButtons.UpdatePauseButtons()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Start automation")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub BTT_DOWN_AUTOMATION_PAUSE_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION_PAUSE.Click, BTT_TRAY_PAUSE_AUTOMATION.Click
@@ -2022,7 +2019,6 @@ ResumeDownloadingOperation:
End Sub
Private Sub Downloader_UpdateJobsCount(ByVal TotalCount As Integer)
ControlInvokeFast(Toolbar_BOTTOM, LBL_JOBS_COUNT, Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]"))
MainFrameObj.UpdateLogButton()
End Sub
Private Sub Downloader_Downloading(ByVal Value As Boolean)
Dim __isDownloading As Boolean = Value Or Downloader.Working(False)

View File

@@ -26,6 +26,7 @@ Friend Class MainFrameObjects : Implements INotificator
AddHandler .TextAdded, AddressOf ProgramLog_TextAdded
AddHandler .TextCleared, AddressOf ProgramLog_TextCleared
End With
UpdateLogButton()
End Sub
#Region "Users"
Friend Sub FocusUser(ByVal Key As String, Optional ByVal ActivateForm As Boolean = False)
@@ -66,17 +67,17 @@ Friend Class MainFrameObjects : Implements INotificator
ControlInvokeFast(MF.TRAY_CONTEXT, Sub() MF.BTT_TRAY_CLOSE_NO_SCRIPT.Visible =
Settings.ClosingCommand.Attribute And Not Settings.ClosingCommand.IsEmptyString)
End Sub
Friend Sub UpdateLogButton()
MyMainLOG_UpdateLogButton(MF.BTT_LOG, MF.Toolbar_TOP)
Private Sub UpdateLogButton()
Try : MyMainLOG_UpdateLogButton(MF.BTT_LOG, MF.Toolbar_TOP) : Catch : End Try
End Sub
Friend Function GetUserListProvider(ByVal WithCollections As Boolean) As IFormatProvider
Return MF.GetUserListProvider(WithCollections)
End Function
Friend Sub ShowLog()
MyMainLOG_ShowForm(Settings.Design,,,, Sub()
UpdateLogButton()
LogFormClosed()
End Sub)
Try : MyMainLOG_ShowForm(Settings.Design,,,, Sub()
UpdateLogButton()
LogFormClosed()
End Sub) : Catch : End Try
End Sub
#End Region
#Region "Notifications"

View File

@@ -77,6 +77,15 @@ Friend Module MainMod
''' <summary>Alt+F1</summary>
Friend ReadOnly ShowUsersButtonKey As New PersonalUtilities.Forms.ButtonKey(Keys.F1,, True)
Friend ReadOnly DateTimeDefaultProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
<Extension> Friend Function ToStringDateDef(ByVal _DateN As Date?) As String
Return If(_DateN.HasValue, AConvert(Of String)(_DateN, DateTimeDefaultProvider, String.Empty), String.Empty)
End Function
<Extension> Friend Function ToStringDateDef(ByVal _Date As Date) As String
Return ToStringDateDef(_DateN:=_Date)
End Function
<Extension> Friend Function ToDateDef(ByVal DateStr As String, Optional ByVal NothingArg As Object = Nothing) As Object
Return AConvert(Of Date)(DateStr, DateTimeDefaultProvider, NothingArg)
End Function
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

View File

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

View File

@@ -94,14 +94,14 @@ Namespace Plugin.Hosts
HostsUnavailableIndexes = New List(Of Integer)
Dim defInstance As ISiteSettings = CreateInstance()
HostsXml = New List(Of XmlFile) From {
GetNewXmlFile($"{SettingsFolderName}\{SiteSettingsBase.ResponserFilePrefix}{defInstance.Site}_Settings.xml", defInstance.Site, _XML)
GetNewXmlFile($"{SettingsFolderName}\{SiteSettingsBase.ResponserFilePrefix}{defInstance.Site}_Settings.xml")
}
Hosts = New List(Of SettingsHost) From {New SettingsHost(defInstance, True, HostsXml(0), GlobalPath, _Temp, _Imgs, _Vids)}
Dim hostFiles As List(Of SFile) = SFile.GetFiles(SettingsFolderName.CSFileP, $"{String.Format(FileNamePattern, Key, Name)}*.xml",, EDP.ReturnValue)
If hostFiles.ListExists Then
For Each f As SFile In hostFiles
HostsXml.Add(GetNewXmlFile(f, [Default].Name))
HostsXml.Add(GetNewXmlFile(f))
Hosts.Add(New SettingsHost(CreateInstance(HostsXml.Last.Value(SettingsHost.NameXML_AccountName)), False, HostsXml.Last,
GlobalPath, _Temp, _Imgs, _Vids))
Next
@@ -109,30 +109,10 @@ Namespace Plugin.Hosts
Hosts.ListReindex
Hosts.ForEach(Sub(h) SetHostHandlers(h))
End Sub
Private Function GetNewXmlFile(ByVal f As SFile, ByVal SiteName As String, Optional ByVal SourceXml As XmlFile = Nothing) As XmlFile
Private Function GetNewXmlFile(ByVal f As SFile) As XmlFile
Dim x As New XmlFile(f,, False) With {.AutoUpdateFile = True}
If Not f.Exists Then x.Name = "SiteSettings"
x.LoadData()
'URGENT: reorganization of settings: remove the following code
Dim n$() = {SettingsCLS.Name_Node_Sites, SiteName}
Dim processed As Boolean = False
With If(SourceXml, x)
If .Count > 0 AndAlso .Contains(n) Then
With .Item(n)
If .ListExists Then
For Each container As EContainer In .Self : x.Add(container.Name, container.Value) : Next
processed = True
End If
End With
If processed Then
.Remove(n)
If SourceXml Is Nothing Then .Remove(SettingsCLS.Name_Node_Sites)
x.Name = "SiteSettings"
x.UpdateData()
End If
End If
End With
'-----END REMOVE-----
Return x
End Function
#End Region
@@ -178,7 +158,7 @@ Namespace Plugin.Hosts
End Sub
Private Sub Hosts_OkClick(ByVal Obj As SettingsHost)
If Obj.Index = -1 Then
HostsXml.Add(GetNewXmlFile($"{SettingsFolderName}\{String.Format(FileNamePatternFull, Key, Name, Obj.AccountName)}.xml", Name))
HostsXml.Add(GetNewXmlFile($"{SettingsFolderName}\{String.Format(FileNamePatternFull, Key, Name, Obj.AccountName)}.xml"))
With Settings : Hosts.Add(Obj.Apply(HostsXml.Last, .GlobalPath,
.DefaultTemporary, .DefaultDownloadImages, .DefaultDownloadVideos)) : End With
HostsXml.Last.UpdateData()
@@ -202,7 +182,6 @@ Namespace Plugin.Hosts
Select Case Hosts_Deleted_MoveAcc(Obj)
Case -1 : ShowOperationCanceledMsg(ChngUACC_MsgTitle) : Exit Sub
Case 1
MainFrameObj.UpdateLogButton()
MsgBoxE({$"An error occurred while changing user accounts (see log for details).{vbCr}Operation canceled.", ChngUACC_MsgTitle}, vbCritical)
Exit Sub
End Select

View File

@@ -173,17 +173,17 @@
<Compile Include="API\Base\M3U8Base.vb" />
<Compile Include="API\Base\ProfileSaved.vb" />
<Compile Include="API\Base\SiteSettingsBase.vb" />
<Compile Include="API\Base\SplitCollectionUserInfo.vb" />
<Compile Include="API\Base\SplitCollectionUserInfoChangePathsForm.Designer.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfo.vb" />
<Compile Include="API\BaseObjects\SplitCollectionUserInfoChangePathsForm.Designer.vb">
<DependentUpon>SplitCollectionUserInfoChangePathsForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoChangePathsForm.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfoChangePathsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoPathForm.Designer.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfoPathForm.Designer.vb">
<DependentUpon>SplitCollectionUserInfoPathForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoPathForm.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfoPathForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Base\Structures.vb" />
@@ -208,11 +208,18 @@
<Compile Include="API\Mastodon\SiteSettings.vb" />
<Compile Include="API\Mastodon\UserData.vb" />
<Compile Include="API\OnlyFans\Declarations.vb" />
<Compile Include="API\OnlyFans\DynamicRulesEnv.vb" />
<Compile Include="API\OnlyFans\OFResources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>OFResources.resx</DependentUpon>
</Compile>
<Compile Include="API\OnlyFans\OnlyFansAdvancedSettingsForm.Designer.vb">
<DependentUpon>OnlyFansAdvancedSettingsForm.vb</DependentUpon>
</Compile>
<Compile Include="API\OnlyFans\OnlyFansAdvancedSettingsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\OnlyFans\SiteSettings.vb" />
<Compile Include="API\OnlyFans\UserData.vb" />
<Compile Include="API\OnlyFans\UserExchangeOptions.vb" />
@@ -531,10 +538,10 @@
<EmbeddedResource Include="API\BaseObjects\InternalSettingsForm.resx">
<DependentUpon>InternalSettingsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Base\SplitCollectionUserInfoChangePathsForm.resx">
<EmbeddedResource Include="API\BaseObjects\SplitCollectionUserInfoChangePathsForm.resx">
<DependentUpon>SplitCollectionUserInfoChangePathsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Base\SplitCollectionUserInfoPathForm.resx">
<EmbeddedResource Include="API\BaseObjects\SplitCollectionUserInfoPathForm.resx">
<DependentUpon>SplitCollectionUserInfoPathForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\OnlyFans\OFResources.resx">
@@ -542,6 +549,9 @@
<Generator>ResXFileCodeGenerator</Generator>
<LastGenOutput>OFResources.Designer.vb</LastGenOutput>
</EmbeddedResource>
<EmbeddedResource Include="API\OnlyFans\OnlyFansAdvancedSettingsForm.resx">
<DependentUpon>OnlyFansAdvancedSettingsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Reddit\RedditViewSettingsForm.resx">
<DependentUpon>RedditViewSettingsForm.vb</DependentUpon>
</EmbeddedResource>
@@ -784,6 +794,9 @@
<None Include="Content\Pictures\SitePictures\FacebookPic_37.png" />
</ItemGroup>
<ItemGroup>
<Content Include="API\OnlyFans\DynamicRules.txt" />
<Content Include="API\OnlyFans\DynamicRulesAll.txt" />
<Content Include="API\OnlyFans\OFScraperConfigPatternConstants.txt" />
<Content Include="Content\Pictures\CutPic_48.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />

View File

@@ -214,12 +214,6 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
SiteSettingsShowHiddenControls = MyXML.Value("SiteSettingsShowHiddenControls").FromXML(Of Boolean)(False)
Dim n() As String
Dim n_old() As String 'URGENT: remove this line
Dim rn As Boolean = Not MyXML.File.Exists
SettingsReoranized = New XMLValue(Of Boolean)("SettingsReoranized", rn, MyXML) 'URGENT: remove this line
SettingsReoranized2 = New XMLValue(Of Boolean)("SettingsReoranized2", rn, MyXML) 'URGENT: remove this line
Dim forceSaveXML As Boolean = Not SettingsReoranized 'URGENT: remove this line
Dim forceSaveXML2 As Boolean = Not SettingsReoranized OrElse Not SettingsReoranized2 'URGENT: remove this line
SettingsVersion = New XMLValue(Of Integer)("SettingsVersion", 0, MyXML)
@@ -251,7 +245,6 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
CollectionsPath = New XMLValue(Of String)("CollectionsPath", CollectionsFolderName, MyXML, n)
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
ImgurClientID = New XMLValue(Of String)("ImgurClientID", String.Empty, MyXML, {Name_Node_Sites})
'Basis: new version
@@ -294,13 +287,6 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
DownloadOpenInfo = New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenInfo", "OpenAgain", False, False, MyXML, n)
DownloadOpenProgress = New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenProgress", "OpenAgain", False, False, MyXML, n)
ClosingCommand = New XMLValueAttribute(Of String, Boolean)("ClosingCommand", "Use",,, MyXML, n)
'URGENT: remove these lines
If Not SettingsReoranized Then
With New XMLValueAttribute(Of String, Boolean)("ClosingCommand", "Use",,, MyXML)
ClosingCommand.Value = .Value
ClosingCommand.AttributeValue = .AttributeValue
End With
End If
AddHandler ClosingCommand.ValueChanged, Sub(s, ev) MainFrameObj?.ChangeCloseVisible()
DownloadAll_UseF6 = New XMLValue(Of Boolean)("DownloadAll_UseF6", True, MyXML, n)
DownloadAll_UseF6_Confirm = New XMLValue(Of Boolean)("DownloadAll_UseF6_Confirm", False, MyXML, n)
@@ -356,21 +342,17 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
DownloadsCompleteCommand = New XMLValueAttribute(Of String, Boolean)("DownloadsCompleteCommand", "Use",,, MyXML, n)
ReparseMissingInTheRoutine = New XMLValue(Of Boolean)("ReparseMissingInTheRoutine", False, MyXML, n)
UseDefaultAccountIfMissing = New XMLValue(Of Boolean)("UseDefaultAccountIfMissing", True, MyXML, n)
AutomationBrushUndownloadedPlansMinutes = New XMLValue(Of Integer)("AutomationBrushUndownloadedPlansMinutes", 10080, MyXML, n)
'Downloading: file naming
n_old = {"Users", "FileName"}
n = {"Downloading", "FileName"}
FileAddDateToFileName = New XMLValue(Of Boolean)("FileAddDateToFileName", False, MyXML, n)
If Not SettingsReoranized Then FileAddDateToFileName.Value = New XMLValue(Of Boolean)("FileAddDateToFileName", False, MyXML, n_old).Value 'URGENT: remove this line
AddHandler FileAddDateToFileName.ValueChanged, AddressOf ChangeDateProvider
FileAddTimeToFileName = New XMLValue(Of Boolean)("FileAddTimeToFileName", False, MyXML, n)
If Not SettingsReoranized Then FileAddTimeToFileName.Value = New XMLValue(Of Boolean)("FileAddTimeToFileName", False, MyXML, n_old).Value 'URGENT: remove this line
AddHandler FileAddTimeToFileName.ValueChanged, AddressOf ChangeDateProvider
FileDateTimePositionEnd = New XMLValue(Of Boolean)("FileDateTimePositionEnd", True, MyXML, n)
If Not SettingsReoranized Then FileDateTimePositionEnd.Value = New XMLValue(Of Boolean)("FileDateTimePositionEnd", True, MyXML, n_old).Value 'URGENT: remove this line
AddHandler FileDateTimePositionEnd.ValueChanged, AddressOf ChangeDateProvider
FileReplaceNameByDate = New XMLValue(Of Integer)("FileReplaceNameByDate", FileNameReplaceMode.None, MyXML, n)
If Not SettingsReoranized Then FileReplaceNameByDate.Value = New XMLValue(Of Integer)("FileReplaceNameByDate", FileNameReplaceMode.None, MyXML, n_old).Value 'URGENT: remove this line
'Downloading: script
n = {"Downloading", "Script"}
@@ -401,6 +383,8 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
FeedForeColor.SetExtended("FeedColorFore",, MyXML, n)
FeedEndless = New XMLValue(Of Boolean)("Endless", True, MyXML, n)
FeedAddSessionToCaption = New XMLValue(Of Boolean)("AddSessionToCaption", False, MyXML, n)
FeedAddSiteToCaption = New XMLValue(Of Boolean)("AddSiteToCaption", True, MyXML, n)
FeedAddTypeToCaption = New XMLValue(Of Boolean)("AddTypeToCaption", False, MyXML, n)
FeedAddDateToCaption = New XMLValue(Of Boolean)("AddDateToCaption", True, MyXML, n)
FeedStoreSessionsData = New XMLValue(Of Boolean)("StoreSessionsData", True, MyXML, n)
FeedStoredSessionsNumber = New XMLValue(Of Integer)("StoredSessionsNumber", 20, MyXML, n)
@@ -448,7 +432,6 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
LatestSavingPath = New XMLValue(Of SFile)("LatestSavingPath", Nothing, MyXML, n, New XMLToFilePathProvider)
LatestSelectedChannel = New XMLValue(Of String)("LatestSelectedChannel",, MyXML, n)
#End Region
ReorganizeSettingsFile()
#Region "Loading plugins"
Plugins.AddRange(PluginHost.GetMyHosts(MyXML, GlobalPath.Value, DefaultTemporary, DefaultDownloadImages, DefaultDownloadVideos))
Dim tmpPluginList As IEnumerable(Of PluginHost) = PluginHost.GetPluginsHosts(MyXML, GlobalPath.Value, DefaultTemporary,
@@ -472,7 +455,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
UpdatePluginsUserAgent(False)
#End Region
Labels = New LabelsKeeper(MyXML)
Labels = New LabelsKeeper
Groups = New Groups.DownloadGroupCollection
Labels.AddRange(Groups.GetGroupsLabels, False)
AdvancedFilter = New Groups.DownloadGroup(False) With {.IsViewFilter = True}
@@ -480,61 +463,8 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
AdvancedFilter.IsViewFilter = True
Labels.AddRange({AdvancedFilter}.GetGroupsLabels, False)
'URGENT: remove this code (2024.03)
#Region "To delete"
'delete this property:
ViewReorganized = New XMLValue(Of Boolean)("ViewReorganized", rn, MyXML)
If Not ViewReorganized.Value Then
ViewReorganized.Value = True
Dim oldShowMode% = MyXML.Value("ShowingMode").FromXML(Of Integer)(0)
Dim MainFrameUsersShowDefaults As Boolean = MyXML.Value("UsersShowDefaults").FromXML(Of Boolean)(True)
Dim MainFrameUsersShowSubscriptions As Boolean = MyXML.Value("UsersShowSubscriptions").FromXML(Of Boolean)(True)
ShowAllUsers.Value = oldShowMode = 0 And MainFrameUsersShowDefaults And MainFrameUsersShowSubscriptions
Dim ViewDateMode As New XMLValue(Of Integer)("ViewDateMode", ShowingDates.Off, MyXML)
Dim SelectedSites As New XMLValuesCollection(Of String)(IXMLValuesCollection.Modes.String, "SelectedSites",, MyXML, {Name_Node_Sites})
If Not ShowAllUsers Or SelectedSites.Count > 0 Or Not ViewDateMode.Value = ShowingDates.Off Then
ShowAllUsers.Value = False
With AdvancedFilter
.DownloadUsers = MainFrameUsersShowDefaults
.DownloadSubscriptions = MainFrameUsersShowSubscriptions
If SelectedSites.Count > 0 Then .Sites.AddRange(SelectedSites)
#Disable Warning BC40008
Select Case oldShowMode
Case 20 : .Regular = True : .Temporary = False : .Favorite = False
Case 50 : .Regular = False : .Temporary = True : .Favorite = False
Case 100 : .Regular = False : .Temporary = False : .Favorite = True
Case 500 : If Labels.Current.Count > 0 Then .Labels.Clear() : .Labels.AddRange(Labels.Current)
Case 1000 : .LabelsNo = True
Case 10000 : .UserExists = False : .UserDeleted = True : .UserSuspended = False
Case 12000 : .UserExists = False : .UserDeleted = False : .UserSuspended = True
End Select
If Labels.Excluded.Count > 0 Then .LabelsExcluded.AddRange(Labels.Excluded)
.LabelsExcludedIgnore = Labels.ExcludedIgnore
#Enable Warning
Dim _ViewDateFrom As New XMLValue(Of Date)
_ViewDateFrom.SetExtended("ViewDateFrom",, MyXML)
Dim _ViewDateTo As New XMLValue(Of Date)
_ViewDateTo.SetExtended("ViewDateTo",, MyXML)
If Not ViewDateMode.Value = ShowingDates.Off Then
.DateMode = ViewDateMode
If _ViewDateFrom.Exists Then .DateFrom = _ViewDateFrom.Value Else .DateFrom = Nothing
If _ViewDateTo.Exists Then .DateTo = _ViewDateTo.Value Else .DateTo = Nothing
End If
_ViewDateFrom.Dispose()
_ViewDateTo.Dispose()
.UpdateFile()
End With
End If
ViewDateMode.Dispose()
SelectedSites.Dispose()
End If
#End Region
If Not forceSaveXML And forceSaveXML2 Then SettingsReoranized2.Value = True
MyXML.EndUpdate()
If MyXML.ChangesDetected Or forceSaveXML Or forceSaveXML2 Then MyXML.Sort() : MyXML.UpdateData()
If MyXML.ChangesDetected Then MyXML.Sort() : MyXML.UpdateData()
If BlackListFile.Exists Then
BlackList.ListAddList(IO.File.ReadAllLines(BlackListFile), LAP.NotContainsOnly)
@@ -543,107 +473,6 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
_UpdatesSuspended = False
ChangeDateProvider(Nothing, Nothing)
End Sub
#End Region
'URGENT: remove 'Reorganize' code (2024.03)
#Region "Reorganize"
Private Property SettingsReoranized As XMLValue(Of Boolean)
Private Property SettingsReoranized2 As XMLValue(Of Boolean)
Private Sub ReorganizeSettingsFile()
If Not SettingsReoranized Then
SettingsReoranized.Value = True
Dim n$()
GlobalPath.Value = New XMLValue(Of SFile)("GlobalPath", "Data\".CSFileP, MyXML,, New XMLToFilePathProvider).Value
MaxLargeImageHeight.Value = New XMLValue(Of Integer)("MaxLargeImageHeight", 150, MyXML).Value
MaxSmallImageHeight.Value = New XMLValue(Of Integer)("MaxSmallImageHeight", 15, MyXML).Value
CollectionsPath.Value = New XMLValue(Of String)("CollectionsPath", CollectionsFolderName, MyXML).Value
MaxUsersJobsCount.Value = New XMLValue(Of Integer)("MaxJobsCount", DefaultMaxDownloadingTasks, MyXML, {"Users", "FileName"}).Value
CheckUpdatesAtStart.Value = New XMLValue(Of Boolean)("CheckUpdatesAtStart", True, MyXML).Value
ShowNewVersionNotification.Value = New XMLValue(Of Boolean)("ShowNewVersionNotification", True, MyXML).Value
LatestVersion.Value = New XMLValue(Of String)("LatestVersion", String.Empty, MyXML).Value
ProgramText.Value = New XMLValue(Of String)("ProgramText",, MyXML).Value
ProgramDescription.Value = New XMLValue(Of String)("ProgramDescription",, MyXML).Value
UserListImage.Value = New XMLValue(Of SFile)("UserListImage",, MyXML).Value
Dim __UserListBackColor As New XMLValue(Of Color)
__UserListBackColor.SetExtended("UserListBackColor",, MyXML)
UserListBackColor.ValueF = __UserListBackColor.ValueF
Dim __UserListForeColor As New XMLValue(Of Color)
__UserListForeColor.SetExtended("UserListForeColor",, MyXML)
UserListForeColor.ValueF = __UserListForeColor.ValueF
MainFrameUsersSubscriptionsColorBack.Value = New XMLValue(Of Color)("UsersSubscriptionsColorBack", MyColor.OkBack, MyXML).Value
MainFrameUsersSubscriptionsColorFore.Value = New XMLValue(Of Color)("UsersSubscriptionsColorFore", MyColor.OkFore, MyXML).Value
Dim __MainFrameUsersSubscriptionsColorBack_USERS As New XMLValue(Of Color)
__MainFrameUsersSubscriptionsColorBack_USERS.SetExtended("UsersSubscriptionsColorBack_USERS",, MyXML)
MainFrameUsersSubscriptionsColorBack_USERS.ValueF = __MainFrameUsersSubscriptionsColorBack_USERS.ValueF
Dim __MainFrameUsersSubscriptionsColorFore_USERS As New XMLValue(Of Color)
__MainFrameUsersSubscriptionsColorFore_USERS.SetExtended("UsersSubscriptionsColorFore_USERS",, MyXML)
MainFrameUsersSubscriptionsColorFore_USERS.ValueF = __MainFrameUsersSubscriptionsColorFore_USERS.ValueF
CMDEncoding.Value = New XMLValue(Of Integer)("CMDEncoding", DefaultCmdEncoding, MyXML, {"Defaults"}).Value
ExitConfirm.Value = New XMLValue(Of Boolean)("ExitConfirm", True, MyXML).Value
CloseToTray.Value = New XMLValue(Of Boolean)("CloseToTray", True, MyXML).Value
With New XMLValueUse(Of String)("OpenFolderInOtherProgram",,, MyXML)
OpenFolderInOtherProgram.Value = .Value
OpenFolderInOtherProgram.Use = .Use
End With
DeleteToRecycleBin.Value = New XMLValue(Of Boolean)("DeleteToRecycleBin", True, MyXML).Value
FastProfilesLoading.Value = New XMLValue(Of Boolean)("FastProfilesLoading", True, MyXML).Value
With New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenInfo", "OpenAgain", False, False, MyXML)
DownloadOpenInfo.Value = .Value
DownloadOpenInfo.AttributeValue = .AttributeValue
End With
With New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenProgress", "OpenAgain", False, False, MyXML)
DownloadOpenProgress.Value = .Value
DownloadOpenProgress.AttributeValue = .AttributeValue
End With
SeparateVideoFolder.Value = New XMLValue(Of Boolean)("SeparateVideoFolder", True, MyXML).Value
AddMissingToLog.Value = New XMLValue(Of Boolean)("AddMissingToLog", True, MyXML).Value
AddMissingErrorsToLog.Value = New XMLValue(Of Boolean)("AddMissingErrorsToLog", False, MyXML).Value
With New XMLValueAttribute(Of String, Boolean)("DownloadsCompleteCommand", "Use",,, MyXML)
DownloadsCompleteCommand.Value = .Value
DownloadsCompleteCommand.AttributeValue = .AttributeValue
End With
n = {"Users"}
UpdateUserDescriptionEveryTime.Value = New XMLValue(Of Boolean)("UpdateUserDescriptionEveryTime", True, MyXML, n).Value
UpdateUserIconBannerEveryTime.Value = New XMLValue(Of Boolean)("UpdateUserIconBannerEveryTime", True, MyXML, n).Value
n = {"Defaults"}
UpdateUserSiteNameEveryTime.Value = New XMLValue(Of Boolean)("UserSiteNameUpdateEveryTime", False, MyXML, n).Value
ReparseMissingInTheRoutine.Value = New XMLValue(Of Boolean)("ReparseMissingInTheRoutine", False, MyXML, n).Value
UseDefaultAccountIfMissing.Value = New XMLValue(Of Boolean)("UseDefaultAccountIfMissing", True, MyXML, n).Value
n = {"Users"}
FromChannelDownloadTop.Value = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML, n).Value
FromChannelDownloadTopUse.Value = New XMLValue(Of Boolean)("FromChannelDownloadTopUse", False, MyXML, n).Value
FromChannelCopyImageToUser.Value = New XMLValue(Of Boolean)("FromChannelCopyImageToUser", True, MyXML, n).Value
With New XMLValueAttribute(Of String, Boolean)("ScriptData", "Use",,, MyXML, n)
ScriptData.Value = .Value
ScriptData.AttributeValue = .AttributeValue
End With
ViewMode.Value = New XMLValue(Of Integer)("ViewMode", ViewModes.IconLarge, MyXML).Value
GroupUsers.Value = New XMLValue(Of Boolean)("UseGrouping", True, MyXML).Value
ShowGroupsInsteadLabels.Value = New XMLValue(Of Boolean)("ShowGroupsInsteadLabels", False, MyXML).Value
InfoViewMode.Value = New XMLValue(Of Integer)("InfoViewMode", DownloadObjects.DownloadedInfoForm.ViewModes.Session, MyXML).Value
InfoViewDefault.Value = New XMLValue(Of Boolean)("InfoViewDefault", True, MyXML).Value
LatestSavingPath.Value = New XMLValue(Of SFile)("LatestSavingPath", Nothing, MyXML,, New XMLToFilePathProvider).Value
LatestSelectedChannel.Value = New XMLValue(Of String)("LatestSelectedChannel",, MyXML).Value
LastCopyPath.Value = New XMLValue(Of SFile)("LastCopyPath",, MyXML,, New XMLToFilePathProvider).Value
End If
End Sub
#End Region
#Region "Users"
Friend Sub LoadUsers()
@@ -1001,6 +830,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End Get
End Property
#End Region
#Region "Properties"
#Region "Basis"
Friend ReadOnly Property GlobalPath As XMLValue(Of SFile)
Friend ReadOnly Property MaxLargeImageHeight As XMLValue(Of Integer)
@@ -1204,6 +1034,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property DownloadsCompleteCommand As XMLValueAttribute(Of String, Boolean)
Friend ReadOnly Property ReparseMissingInTheRoutine As XMLValue(Of Boolean)
Friend ReadOnly Property UseDefaultAccountIfMissing As XMLValue(Of Boolean)
Friend ReadOnly Property AutomationBrushUndownloadedPlansMinutes As XMLValue(Of Integer)
#End Region
#Region "Downloading: file naming"
Friend ReadOnly Property FileAddDateToFileName As XMLValue(Of Boolean)
@@ -1257,6 +1088,8 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property FeedForeColor As XMLValue(Of Color)
Friend ReadOnly Property FeedEndless As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddSessionToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddSiteToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddTypeToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddDateToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedStoreSessionsData As XMLValue(Of Boolean)
Friend ReadOnly Property FeedStoredSessionsNumber As XMLValue(Of Integer)
@@ -1285,7 +1118,6 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End Get
End Property
Friend ReadOnly Property ShowAllUsers As XMLValue(Of Boolean)
Private ReadOnly Property ViewReorganized As XMLValue(Of Boolean)
Friend ReadOnly Property GroupUsers As XMLValue(Of Boolean)
Friend ReadOnly Property ShowGroupsInsteadLabels As XMLValue(Of Boolean)
#End Region
@@ -1309,6 +1141,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property LatestSavingPath As XMLValue(Of SFile)
Friend ReadOnly Property LatestSelectedChannel As XMLValue(Of String)
#End Region
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)

View File

@@ -0,0 +1,24 @@
REM https://superuser.com/a/577640/1410018
@echo off
set dirname=_MEI
set usewildcard=true
set found=false
if %usewildcard% == true (
set dirname=*%dirname%*
)
set directorytosearch=%UserProfile%\AppData\Local\Temp
echo Searching for %dirname% in %directorytosearch%
for /d %%i in (%directorytosearch%\%dirname%) do (
IF EXIST %%i (
set found=true
echo Deleting the folder %%i
rmdir /s /q "%%i"
)
)
if NOT "%found%" == "true" (
echo No directories were found with the name of %dirname%
)