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

2023.11.24.0

Browse Source 
Scheduler: handle scheduler change error (collection was modified)
SchedulerEditorForm: add scheduler name to form title
DownloadProgress: fix disposing error when some objects are already null
API.Reddit: add special notification for error 429
API.Twitter: handle JSON deserialization error
Porn sites: fix incorrect parsing of search queries
YouTube: path not set when adding array to download
This commit is contained in:
Andy
2023-11-24 04:54:04 +03:00
parent 0ec617c1dc
commit a540aded68
20 changed files with 157 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
Changelog.md
View File

@@ -1,3 +1,27 @@
# 2023.11.24.0
*2023-11-24*
For those of you who use TikTok, I recommend updating [TikTok plugin](https://github.com/bashonly/yt-dlp-TTUser) to the latest version using [these instructions](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-install-yt-dlp-ttuser-plugin).
- Added
- Automation: manual task option
- Scheduler: add scheduler name to form title
- Feeds: update when users' location and/or basic information changes
- Reddit: special notification for error 429
- TikTok: ID, username and friendly name extraction from data
- TikTok: new option `Use video date as file date`
- YouTube: absolute path for a single playlist
- Updated
- yt-dlp up to version 2023.11.16
- Fixed
- Scheduler: scheduler change error
- Twitter: JSON deserialization error
- xHamster, XVideos, PornHub, ThisVid: incorrect parsing of search queries
- YouTube: the file name is not changed manually
- YouTube: path not set when adding array to download
- Minor bugs
# 2023.11.17.0
*2023-11-17*

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

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

15
SCrawler.YouTube/Downloader/VideoListForm.vb
View File

@@ -278,6 +278,17 @@ Namespace DownloadObjects.STDownloader
.IsMusic = containers.Any(Function(cc) cc.IsMusic)
}
c.Elements.AddRange(containers)
Dim path$ = c.Elements(0).File.PathWithSeparator
For Each list As List(Of String) In {
c.Elements.Select(Function(cc) cc.UserTitle).ListWithRemove(Function(cc) cc.IsEmptyString).ListIfNothing,
c.Elements.Select(Function(cc) cc.PlaylistTitle).ListWithRemove(Function(cc) cc.IsEmptyString).ListIfNothing
}
If list.Count > 0 AndAlso
(list.Count = 1 OrElse
ListAddList(Nothing, list, LAP.NotContainsOnly, EDP.ReturnValue).ListIfNothing.Count = 1) Then _
path &= $"{list(0)}\"
Next
c.File = path
End If
End If
End With
@@ -450,12 +461,16 @@ Namespace DownloadObjects.STDownloader
UpdateLogButton()
End Sub
Protected Sub AddToDownload(ByRef Item As MediaItem, ByVal RunThread As Boolean)
Try
Dim hc% = Item.MyContainer.GetHashCode
If MyJob.Count = 0 OrElse Not MyJob.Items.Exists(Function(i) i.MyContainer.GetHashCode = hc) Then
MyJob.Add(Item)
Item.AddToQueue()
If RunThread Then StartDownloading()
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[VideoListForm.AddToDownload]")
End Try
End Sub
Private Sub StartDownloading()
If Not MyJob.Working And MyJob.Count > 0 Then

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

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

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

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

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

@@ -1729,8 +1729,6 @@ BlockNullPicture:
DownloadContentDefault_PostProcessing(v, f, Token)
dCount += 1
Catch woex As OperationCanceledException When Token.IsCancellationRequested
'TODELETE: UserDataBase.DownloadContentDefault: remove file when 'OperationCanceledException'
'If f.Exists Then f.Delete(,, EDP.SendToLog)
__deleteFile.Invoke(f, v.URL_BASE)
v.State = UStates.Missing
v.Attempts += 1

64
SCrawler/API/JustForFans/M3U8.vb
View File

@@ -126,70 +126,6 @@ Namespace API.JustForFans
$"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
End Try
End Sub
'TODELETE: JFF.M3U8.GetFiles_OLD 20231008
'Private Sub GetFiles_OLD(ByVal URL As String, ByRef File As SFile, ByVal IsAudio As Boolean)
' Try
' Dim r$ = Responser.GetResponse(URL)
' If Not r.IsEmptyString Then
' Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
' If data.ListExists Then
' Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
' With (From d As RegexMatchStruct In data
' Where Not d.Arr(0).IfNullOrEmpty(d.Arr(1)).IsEmptyString
' Select M3U8Base.CreateUrl(appender, d.Arr(0).IfNullOrEmpty(d.Arr(1)).Trim)).ToList
' If .ListExists Then
' File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
' Dim tmpCache As CacheKeeper = Cache.NewInstance
' Dim tmpFile As SFile = .Item(0)
' If tmpFile.Extension.IsEmptyString Then tmpFile.Extension = "ts"
' tmpFile.Path = tmpCache.RootDirectory.Path
' tmpFile.Separator = "\"
' Dim cFile As SFile = tmpFile
' cFile.Name = "all"
' tmpCache.Validate()
' Using bat As New TextSaver
' Using b As New BatchExecutor(True) With {.Encoding = Settings.CMDEncoding}
' AddHandler b.OutputDataReceived, AddressOf Batch_OutputDataReceived
' bat.AppendLine($"chcp {BatchExecutor.UnicodeEncoding}")
' bat.AppendLine(BatchExecutor.GetDirectoryCommand(tmpCache))
' ProgressChangeMax(.Count * 2 + 1)
' Using w As New WebClient
' For i = 0 To .Count - 1
' tmpFile.Name = $"ConPart_{i}"
' Thrower.ThrowAny()
' 'Responser.DownloadFile(.Item(i), tmpFile)
' w.DownloadFile(.Item(i), tmpFile)
' ProgressPerform()
' tmpCache.AddFile(tmpFile, True)
' bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
' Next
' End Using
' bat.AppendLine($"""{Settings.FfmpegFile}"" -i {cFile.File} -c copy ""{File}""")
' Dim batFile As SFile = bat.SaveAs($"{tmpCache.RootDirectory.PathWithSeparator}command.bat")
' b.Execute($"""{batFile}""")
' If Not File.Exists Then File = Nothing
' End Using
' End Using
' End If
' End With
' End If
' End If
' Catch oex As OperationCanceledException
' Throw oex
' Catch dex As ObjectDisposedException
' Throw dex
' Catch ex As Exception
' ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex,
' $"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
' End Try
'End Sub
Private Async Sub Batch_OutputDataReceived(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() If Not e.Data.IsEmptyString AndAlso e.Data.Contains("] Opening") Then ProgressPerform())
End Sub

2
SCrawler/API/JustForFans/UserData.vb
View File

@@ -168,8 +168,6 @@ Namespace API.JustForFans
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
'TODELETE: UseResponserClient 20231008
'UseResponserClient = True
End Sub
#End Region
#Region "Download functions"

14
SCrawler/API/PornHub/UserData.vb
View File

@@ -423,30 +423,28 @@ Namespace API.PornHub
newLastPageIDs.Add(uv.ID)
If Not _TempPostsList.Contains(uv.ID) Then
_TempPostsList.Add(uv.ID)
newPostsFound = True
Return False
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.id) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Return True
Else
'TODELETE: PornHub old validating
'If Not SessionPosts.Contains(uv.ID) Then nonLastPageDetected = True
If Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
'Debug.WriteLine($"[REMOVED]: {uv.Title}")
Return True
End If
End Function)
'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine))
If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
If prevPostsFound And newPostsFound And pageRepeatSet Then _PageVideosRepeat -= 1
If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia(specFolder)))
SessionPosts.ListAddList(newLastPageIDs, LNC)
newLastPageIDs.Clear()
'TODELETE: PornHub old validating
'If l.Count > 0 AndAlso (l.Count = lBefore Or Not nonLastPageDetected) AndAlso
' Not (limit > 0 And _TempMediaList.Count >= limit) Then tryNextPage = True
If limit > 0 And _TempMediaList.Count >= limit Then Exit Sub
If (Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or
(Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000)) Then tryNextPage = True
If _PageVideosRepeat < 2 And
((Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or
(Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000))) Then tryNextPage = True
l.Clear()
End If

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

@@ -50,6 +50,12 @@ Namespace API.Reddit
Friend ReadOnly Property UseCookiesForTimelines As PropertyValue
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip, IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend ReadOnly Property CredentialsExists As Boolean
Get
Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
End Get
End Property
#End Region
#Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable>
@@ -238,8 +244,7 @@ Namespace API.Reddit
Return False
End Function
Private Function UpdateTokenIfRequired() As Boolean
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso
{AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString) Then
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then
If CDate(BearerTokenDateUpdate.Value).AddMinutes(TokenUpdateInterval.Value) <= Now Then Return UpdateToken()
End If
Return True

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

@@ -1037,22 +1037,29 @@ Namespace API.Reddit
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
With Responser
If .StatusCode = HttpStatusCode.NotFound Then
If .StatusCode = HttpStatusCode.NotFound Then '404
UserExists = False
ElseIf .StatusCode = HttpStatusCode.Forbidden Then
ElseIf .StatusCode = HttpStatusCode.Forbidden Then '403
UserSuspended = True
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then '502, 503
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit is currently unavailable"
Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then '504
Return 1
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit credentials expired ({ToString()})"
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then '401
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit credentials expired"
MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError
ElseIf .StatusCode = 429 AndAlso
((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And MySiteSettings.UseTokenForSavedPosts.Value)) AndAlso
Not MySiteSettings.CredentialsExists Then '429
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " &
IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines")
MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True}
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0

11
SCrawler/API/ThisVid/UserData.vb
View File

@@ -304,14 +304,12 @@ Namespace API.ThisVid
_TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder})
AddedCount += 1
newPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
If limit > 0 And AddedCount >= limit Then Exit Sub
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(u) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Continue For
Else
If _PageVideosRepeat > 2 Then
If _PageVideosRepeat >= 2 Then
Exit Sub
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
@@ -320,12 +318,15 @@ Namespace API.ThisVid
End If
End If
Next
If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
If prevPostsFound And newPostsFound And pageRepeatSet Then _PageVideosRepeat -= 1
SessionPosts.ListAddList(l, LNC)
l.Clear()
End If
End If
If (Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or
(Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000)) Then DownloadData(Page + 1, Model, Token)
If _PageVideosRepeat < 2 And
((Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or
(Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000))) Then DownloadData(Page + 1, Model, Token)
Catch aex As ArgumentNullException When aex.HelpLink = 1
Catch ex As Exception
ProcessException(ex, Token, $"videos downloading error [{URL}]")

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

@@ -12,6 +12,7 @@ Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Documents
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
@@ -154,6 +155,7 @@ Namespace API.Twitter
Private Sub DownloadData_Timeline(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim tCache As CacheKeeper = Nothing
Dim jsonArgs As New WebDocumentEventArgs With {.DeclaredError = EDP.ThrowException}
Try
Const entry$ = "entry"
Dim PostID$ = String.Empty
@@ -231,7 +233,8 @@ Namespace API.Twitter
For i = 0 To timelineFiles.Count - 1 : timelineFiles(i) = RenameGdlFile(timelineFiles(i), i) : Next
'parse files
For i = 0 To timelineFiles.Count - 1
j = JsonDocument.Parse(timelineFiles(i).GetText)
j = JsonDocument.Parse(timelineFiles(i).GetText, jsonArgs)
jsonArgs.Reset()
If Not j Is Nothing Then
If i = 0 Then
If Not userInfoParsed Then
@@ -339,12 +342,15 @@ Namespace API.Twitter
End If
DownloadModelForceApply = False
FirstDownloadComplete = True
Catch jsonNull_ex As ArgumentNullException When jsonArgs.State = WebDocumentEventArgs.States.Error
Throw New Plugin.ExitException($"{ToStringForLog()}: No deserialized data found")
Catch limit_ex As TwitterLimitException
Throw limit_ex
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
Finally
If Not tCache Is Nothing Then tCache.Dispose()
jsonArgs.DisposeIfReady
If _TempPostsList.Count > 0 Then _TempPostsList.Sort()
End Try
End Sub

8
SCrawler/API/XVIDEOS/UserData.vb
View File

@@ -375,9 +375,9 @@ Namespace API.XVIDEOS
_TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC)
newPostsFound = cBefore <> _TempMediaList.Count
ElseIf sessionPosts.Count > 0 AndAlso sessionPosts.ListContains(pids) Then
If pageRepeatSet Then pageRepeatSet = False : pageVideosRepeat -= 1
prevPostsFound = True
Else
If pageVideosRepeat > 2 Then
If pageVideosRepeat >= 2 Then
Exit Do
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
@@ -388,8 +388,10 @@ Namespace API.XVIDEOS
End If
End If
If limit > 0 And _TempMediaList.Count >= limit Then Exit Do
If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : pageVideosRepeat += 1
If prevPostsFound And newPostsFound And pageRepeatSet Then pageVideosRepeat -= 1
If IsSearch Then
__continue = NextPage < 1000 And (newPostsFound Or (prevPostsFound And Not newPostsFound))
__continue = pageVideosRepeat < 2 And NextPage < 1000 And (newPostsFound Or (prevPostsFound And Not newPostsFound))
ElseIf __continue Then
__continue = Not cBefore = _TempMediaList.Count
End If

10
SCrawler/API/Xhamster/UserData.vb
View File

@@ -308,7 +308,6 @@ Namespace API.Xhamster
_TempMediaList.ListAddValue(m, LNC)
SearchPostsCount += 1
newPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
If checkLimit.Invoke Then Exit Sub
ElseIf Not IsVideo Then
If DirectCast(m.Object, ExchObj).IsPhoto Then
@@ -322,9 +321,8 @@ Namespace API.Xhamster
ElseIf IsVideo And _TempPostsList.Contains(m.Post.ID) Then
If SessionPosts.Count > 0 AndAlso SessionPosts.Contains(m.Post.ID) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Continue For
ElseIf _PageVideosRepeat > 2 Then
ElseIf _PageVideosRepeat >= 2 Then
Exit Sub
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
@@ -335,6 +333,8 @@ Namespace API.Xhamster
End If
End If
Next
If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
If prevPostsFound And newPostsFound And pageRepeatSet Then _PageVideosRepeat -= 1
SessionPosts.ListAddList(pids, LNC)
pids.Clear()
Exit For
@@ -347,11 +347,11 @@ Namespace API.Xhamster
containerNodes.Clear()
If (
If _PageVideosRepeat < 2 And ((
(MaxPage = -1 Or Page < MaxPage) And
((Not _TempMediaList.Count = cBefore Or skipped) And (IsUser Or Page < 1000))
) Or
(IsChannel Or (Not IsUser And Page < 1000 And prevPostsFound And Not newPostsFound)) Then DownloadData(Page + 1, IsVideo, Token)
(IsChannel Or (Not IsUser And Page < 1000 And prevPostsFound And Not newPostsFound))) Then DownloadData(Page + 1, IsVideo, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try

17
SCrawler/Download/Automation/Scheduler.vb
View File

@@ -27,6 +27,15 @@ Namespace DownloadObjects
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
End Sub
Friend ReadOnly Property Name As String
Get
If Not File.Name.IsEmptyString AndAlso Not File.Name = FileNameDefault Then
Return File.Name.Replace(FileNameDefault, String.Empty).StringTrimStart("_").IfNullOrEmpty("Default")
Else
Return "Default"
End If
End Get
End Property
Friend Sub New()
Plans = New List(Of AutoDownloader)
File = Settings.AutomationFile.Value.IfNullOrEmpty(FileDefault)
@@ -132,6 +141,10 @@ Namespace DownloadObjects
Friend Async Function Start(ByVal Init As Boolean) As Task
Try
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
@@ -140,6 +153,10 @@ Namespace DownloadObjects
Thread.Sleep(1000)
Next
End If
Exit Do
Catch io_ex As InvalidOperationException 'Collection was modified; enumeration operation may not execute
End Try
Loop While r < 10
End Sub)
Catch ex As Exception
If Init Then

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

@@ -14,6 +14,7 @@ Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace DownloadObjects
Friend Class SchedulerEditorForm
#Region "Declarations"
Private Const TitleDefault As String = "Scheduler"
Private WithEvents MyDefs As DefaultFormOptions
Private WithEvents BTT_SETTINGS As ToolStripButton
Private WithEvents BTT_CLONE As ToolStripButton
@@ -110,6 +111,7 @@ Namespace DownloadObjects
BTT_START, BTT_START_FORCE, MENU_SKIP, BTT_PAUSE})
PauseArr.AddButtons(BTT_PAUSE, .MyEditToolbar.ToolStrip)
Refill()
SetTitle()
.EndLoaderOperations(False)
End With
End Sub
@@ -138,6 +140,17 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.SchedulerEditorForm.Refill]")
End Try
End Sub
Private Sub SetTitle()
Try
If GetSchedulerFiles.ListExists(2) Then
Text = $"{TitleDefault} [{Settings.Automation.Name}]"
Else
Text = TitleDefault
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[SchedulerEditorForm.SetTitle]")
End Try
End Sub
#Region "Add, Edit, Delete"
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EventArgs) Handles MyDefs.ButtonAddClick, BTT_CLONE.Click
Dim a As AutoDownloader = Nothing
@@ -199,12 +212,15 @@ Namespace DownloadObjects
End Sub
#End Region
#Region "Settings, Start, Skip, Pause"
Private Function GetSchedulerFiles() As List(Of SFile)
Return SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue)
End Function
Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
Const msgTitle$ = "Change scheduler"
Try
Const defName$ = "Default"
Dim l As New Dictionary(Of SFile, String)
With SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue)
With GetSchedulerFiles()
If .ListExists Then .ForEach(Sub(ff) l.Add(ff, ff.Name.Replace(Scheduler.FileNameDefault, String.Empty).StringTrimStart("_").IfNullOrEmpty(defName)))
End With
If l.Count > 0 Then
@@ -260,6 +276,7 @@ Namespace DownloadObjects
Next
End If
End If
SetTitle()
End If
End If
End With

8
SCrawler/Download/DownloadProgress.vb
View File

@@ -218,13 +218,17 @@ Namespace DownloadObjects
If Not BTT_STOP Is Nothing Then BTT_STOP.Dispose()
If Not BTT_OPEN Is Nothing Then BTT_OPEN.Dispose()
If Not Icon Is Nothing Then Icon.Dispose()
PR_MAIN.Dispose()
LBL_INFO.Dispose()
PR_MAIN.DisposeIfReady()
LBL_INFO.DisposeIfReady()
If Not TP_CONTROLS Is Nothing Then
TP_CONTROLS.Controls.Clear()
TP_CONTROLS.Dispose()
End If
If Not TP_MAIN Is Nothing Then
TP_MAIN.Controls.Clear()
TP_MAIN.Dispose()
End If
End If
disposedValue = True
End If
End Sub

4
SCrawler/My Project/AssemblyInfo.vb
View File

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

2
SCrawler/UserSearchForm.vb
View File

@@ -41,9 +41,7 @@ Friend Class UserSearchForm
End If
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
'TODO: [UserSearchForm]: updated equal function
With DirectCast(Obj, SearchResult) : Return Key = .Key : End With
'With DirectCast(Obj, SearchResult) : Return Key = .Key And Mode = .Mode : End With
End Function
End Structure
Public Sub New()