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

2022.10.23.0

Browse Source 
PluginProvider: added 'DoNotUse' attribute.
Channels: copying a channel to the 'ChannelsDeleted' folder before deleting.
Twitter: updated status codes.
AutoDownloader: removed base parameters initialization; updated 'ToEContainer' function; 'StartupDelay' default value = 1; added IIndexable; fixed NextExecutionDate; added task delay based on index and tasks count; updated user selections algorithms.
MainFrame: coloring the button 'Download All' depending on the pause; updated user selections algorithms.
DownloadGroups: added LabelsExcluded, Sites and SitesExcluded; updated initialization; updated ToEContainer function; updated user selections algorithms
IGroup, GroupParameters: added LabelsExcluded, Sites and SitesExcluded; added Import and Export functions
Removed TrayIcon notifications. All notifications are now ToastNotifications.
SettingsHost: 'DoNotUse' attribute
Settings: added 'GetUsers' predicate function
This commit is contained in:
Andy
2022-10-23 16:39:01 +03:00
parent f5c156b8e5
commit 7d169acebc
40 changed files with 601 additions and 264 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
Changelog.md
View File

@@ -1,3 +1,22 @@
# 2022.10.23.0
*2022-10-23*
- Added
- RedGifs token Auto-Renewal
- Download groups: ability to select sites
- Download groups: ability to exclude labels and sites
- AutoDownloader: ability to exclude labels and sites in ```All```, ```Default``` and ```Specified``` modes
- The ```Download All``` button turns blue when pause is enabled
- Updated Twitter status codes
- Minor improvements
- Fixed
- Updated Twitter status codes
- AutoDownloader: incorrect next run date in scheduler task information
- AutoDownloader: minor bugs
- (Issue #69) **RedGifs data is not downloading**. Requires token.
- Minor bugs
# 2022.10.18.0
*2022-10-18*

BIN
ProgramScreenshots/GroupCreating.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 7.4 KiB

After

Width:  |  Height:  |  Size: 9.2 KiB

BIN
ProgramScreenshots/SettingsAutoDownloader.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 18 KiB

BIN
ProgramScreenshots/SettingsSiteRedGifs.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 14 KiB

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

@@ -53,6 +53,9 @@ Namespace Plugin.Attributes
ElementName = XMLElementName
End Sub
End Class
''' <summary>Attribute to disable some properties for host use</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DoNotUse : Inherits Attribute
End Class
''' <summary>Special property updater</summary>
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute
Public ReadOnly Name As String

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("2022.10.18.0")>
<Assembly: AssemblyFileVersion("2022.10.18.0")>
<Assembly: AssemblyVersion("2022.10.23.0")>
<Assembly: AssemblyFileVersion("2022.10.23.0")>
<Assembly: NeutralResourcesLanguage("en")>

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

@@ -817,6 +817,9 @@ BlockNullPicture:
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response
If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
'TODO: remove
Responser.DecodersError = New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue) With {
.DeclaredMessage = New MMessage($"SymbolsConverter error: [{ToStringForLog()}]", ToStringForLog())}
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(Of Image)(False) Is Nothing
Dim sEnvir() As Boolean = {UserExists, UserSuspended}
@@ -976,7 +979,7 @@ BlockNullPicture:
Dim v As UserMedia
Using w As New OptionalWebClient(Me)
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1
ThrowAny(Token)

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

@@ -702,7 +702,7 @@ Namespace API.Instagram
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(s)
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
Return 3

15
SCrawler/API/Reddit/Channel.vb
View File

@@ -236,8 +236,19 @@ Namespace API.Reddit
Return If(Name.IsEmptyString, ID, Name)
End Function
Friend Sub Delete()
File.Delete(, SFODelete.DeleteToRecycleBin)
FilePosts.Delete(, SFODelete.DeleteToRecycleBin)
Dim f As SFile = ChannelsCollection.ChannelsDeletedPath
With File
f.Name = .Name
f.Extension = .Extension
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
.Delete(, SFODelete.DeleteToRecycleBin)
End With
With FilePosts
f.Name = .Name
f.Extension = .Extension
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
.Delete(, SFODelete.DeleteToRecycleBin)
End With
End Sub
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
Optional ByVal p As MyProgress = Nothing)

5
SCrawler/API/Reddit/ChannelsCollection.vb
View File

@@ -17,6 +17,11 @@ Namespace API.Reddit
Return $"{SettingsFolderName}\Channels\"
End Get
End Property
Friend Shared ReadOnly Property ChannelsDeletedPath As SFile
Get
Return $"{SettingsFolderName}\ChannelsDeleted\"
End Get
End Property
Friend Shared ReadOnly Property ChannelsPathCache As SFile
Get
Return $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\"

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

@@ -79,10 +79,15 @@ Namespace API.Reddit
If Silent Then
Return False
Else
Return MsgBoxE({"Over the past hour, Reddit has received an average of " &
If MsgBoxE({"Over the past hour, Reddit has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr) & vbCr & vbCr &
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
Return True
Else
Return False
End If
End If
End If
End If

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

@@ -793,7 +793,7 @@ Namespace API.Reddit
End Function
Dim m$
Using w As New WebClient
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1
ThrowAny(Token)
@@ -850,7 +850,7 @@ Namespace API.Reddit
End If
If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then
Select Case v.Type
Case UTypes.Picture : DownloadedPictures(False) += 1
Case UTypes.Picture, UTypes.GIF : DownloadedPictures(False) += 1
Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1
End Select
If Not IsChannel Or Not SaveToCache Then
@@ -897,19 +897,20 @@ Namespace API.Reddit
End Sub
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 = HttpStatusCode.NotFound Then
With Responser
If .StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then
ElseIf .StatusCode = HttpStatusCode.Forbidden Then
UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
ElseIf Responser.StatusCode = HttpStatusCode.GatewayTimeout Then
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
Return 1
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
End With
Return 1
End Function
Protected Overrides Sub Dispose(ByVal disposing As Boolean)

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

@@ -9,13 +9,16 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs
<Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.RedGifsIcon_32
@@ -28,7 +31,11 @@ Namespace API.RedGifs
End Property
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
Friend Property Token As PropertyValue
<PXML> Friend Property TokenLastDateUpdated As PropertyValue
<DoNotUse> Friend ReadOnly Property NoCredentialsResponser As Response
Private Const TokenName As String = "authorization"
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New(RedGifsSite, "redgifs.com")
Dim t$ = String.Empty
@@ -40,17 +47,83 @@ Namespace API.RedGifs
If .Headers.Count > 0 AndAlso .Headers.ContainsKey(TokenName) Then t = .Headers(TokenName)
If b Then .SaveSettings()
End With
NoCredentialsResponser = New Response($"{SettingsFolderName}\Responser_{RedGifsSite}_NC.xml") With {
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey,
.CookiesDomain = "redgifs.com"
}
With NoCredentialsResponser
If .File.Exists Then
.LoadSettings()
Else
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.SaveSettings()
End If
End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs"
End Sub
#End Region
#Region "Response updater"
Private Sub UpdateResponse(ByVal Value As String)
With Responser.Headers
If .Count = 0 OrElse Not .ContainsKey(TokenName) Then .Add(TokenName, Value) Else .Item(TokenName) = Value
Responser.SaveSettings()
End With
End Sub
#End Region
#Region "Token updaters"
Friend Function UpdateTokenIfRequired() As Boolean
Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing)
If Not d.HasValue OrElse d.Value < Now.AddDays(-1) Then
Return UpdateToken()
Else
Return True
End If
End Function
<PropertyUpdater(NameOf(Token))>
Friend Function UpdateToken() As Boolean
Try
Dim r$
Dim NewToken$ = String.Empty
Using resp As New Response : r = resp.GetResponse("https://api.redgifs.com/v2/auth/temporary",, EDP.ThrowException) : End Using
If Not r.IsEmptyString Then
Dim j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then
NewToken = j.Value("token")
j.Dispose()
End If
End If
If Not NewToken.IsEmptyString Then
Token.Value = $"Bearer {NewToken}"
TokenLastDateUpdated.Value = Now
Return True
Else
Return False
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.RedGifs.SiteSettings.UpdateToken]", False)
End Try
End Function
#End Region
#Region "Update settings"
Private _LastTokenValue As String = String.Empty
Friend Overrides Sub BeginEdit()
_LastTokenValue = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
MyBase.BeginEdit()
End Sub
Friend Overrides Sub Update()
Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now
MyBase.Update()
End Sub
Friend Overrides Sub EndEdit()
_LastTokenValue = String.Empty
MyBase.EndEdit()
End Sub
#End Region
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
@@ -84,7 +157,7 @@ Namespace API.RedGifs
Return $"https://www.redgifs.com/watch/{PostID}"
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 AndAlso ACheck(Token.Value)
Return UpdateTokenIfRequired() AndAlso ACheck(Token.Value)
End Function
End Class
End Namespace

44
SCrawler/API/Redgifs/UserData.vb
View File

@@ -20,6 +20,11 @@ Namespace API.RedGifs
Friend Const DataGone As HttpStatusCode = HttpStatusCode.Gone
Private Const PostDataUrl As String = "https://api.redgifs.com/v2/gifs/{0}?views=yes&users=yes"
#Region "Base declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
@@ -29,15 +34,21 @@ Namespace API.RedGifs
End Sub
#End Region
#Region "Download functions"
Private NoCredentialsResponser As Response
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ReparseMissing(Token)
Try
NoCredentialsResponser = MySettings.NoCredentialsResponser.Copy
DownloadData(1, Token)
Finally
NoCredentialsResponser.Dispose()
End Try
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent&page={Page}"
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException)
Dim _page As Func(Of String) = Function() If(Page = 1, String.Empty, $"&page={Page}")
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent{_page.Invoke}"
Dim r$ = NoCredentialsResponser.GetResponse(URL,, EDP.ThrowException)
Dim postDate$, postID$
Dim pTotal% = 0
If Not r.IsEmptyString Then
@@ -59,7 +70,7 @@ Namespace API.RedGifs
End If
If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
ProcessException(ex, Token, $"data downloading error [{URL}]",, True)
End Try
End Sub
#End Region
@@ -129,7 +140,7 @@ Namespace API.RedGifs
End If
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
ProcessException(ex, Token, $"missing data downloading error")
ProcessException(ex, Token, $"missing data downloading error",, False)
Finally
If Not Disposed And rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
@@ -192,9 +203,12 @@ Namespace API.RedGifs
End If
Return Nothing
Catch ex As Exception
If Not Responser Is Nothing AndAlso Responser.Client.StatusCode = DataGone Then _
If Not Responser Is Nothing AndAlso (Responser.Client.StatusCode = DataGone Or Responser.Client.StatusCode = HttpStatusCode.NotFound) Then
Return New UserMedia With {.State = DataGone}
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.RedGifs.UserData.GetDataFromUrlId({URL})]", New UserMedia)
Else
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.RedGifs.UserData.GetDataFromUrlId({URL})]",
New UserMedia With {.State = UStates.Missing})
End If
End Try
End Function
#End Region
@@ -218,8 +232,22 @@ Namespace API.RedGifs
#Region "Exception"
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 = HttpStatusCode.NotFound Then
Dim IsNoCredentialsResponser As Boolean = AConvert(Of Boolean)(EObj, False)
Dim s As WebExceptionStatus = -1
Dim sc As HttpStatusCode = -1
If IsNoCredentialsResponser Then
If Not NoCredentialsResponser Is Nothing Then
s = NoCredentialsResponser.Status
sc = NoCredentialsResponser.StatusCode
End If
Else
s = Responser.Client.Status
sc = Responser.Client.StatusCode
End If
If sc = HttpStatusCode.NotFound Or s = DataGone Then
UserExists = False
ElseIf sc = HttpStatusCode.Unauthorized Then
MyMainLOG = $"RedGifs credentials have expired [{CInt(sc)}]: {ToStringForLog()}"
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0

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

@@ -355,18 +355,20 @@ Namespace API.Twitter
#Region "Exception"
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 = HttpStatusCode.NotFound Then
With Responser
If .StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Unauthorized Then
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then
UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
ElseIf .StatusCode = HttpStatusCode.BadRequest Then
MyMainLOG = "Twitter has invalid credentials"
ElseIf Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"Twitter is currently unavailable ({ToString()})"
ElseIf .StatusCode = HttpStatusCode.ServiceUnavailable Or .StatusCode = HttpStatusCode.InternalServerError Then
MyMainLOG = $"[{CInt(.StatusCode)}] Twitter is currently unavailable ({ToString()})"
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
End With
Return 1
End Function
#End Region

1
SCrawler/Channels/ChannelsStatsForm.vb
View File

@@ -20,6 +20,7 @@ Friend Class ChannelsStatsForm
.MyViewInitialize()
.AddOkCancelToolbar()
If Settings.Channels.Count > 0 Then RefillList() Else MsgBoxE("Channels not found", vbExclamation)
.DelegateClosingChecker = False
.EndLoaderOperations()
End With
End Sub

BIN
SCrawler/Content/Icons/TagIcon_32.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.3 KiB

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

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Notifications
Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IEContainerProvider
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider
Friend Event PauseDisabled()
Private Shared ReadOnly Property CachePath As SFile
Get
@@ -135,8 +135,9 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[AutoDownloader.NotifiedUser.ShowNotification]")
If Not User Is Nothing Then
MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader,
$"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos",
User.ToString, IIf(User.HasError, ToolTipIcon.Warning, ToolTipIcon.Info))
User.ToString & vbNewLine &
$"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos" &
If(User.HasError, vbNewLine & "With errors", String.Empty))
End If
End Try
End Sub
@@ -182,7 +183,6 @@ Namespace DownloadObjects
#Region "XML Names"
Private Const Name_Mode As String = "Mode"
Private Const Name_Groups As String = "Groups"
Private Const Name_Labels As String = "Labels"
Private Const Name_Timer As String = "Timer"
Private Const Name_StartupDelay As String = "StartupDelay"
Private Const Name_LastDownloadDate As String = "LastDownloadDate"
@@ -205,11 +205,16 @@ Namespace DownloadObjects
End Property
Friend ReadOnly Property Groups As List(Of String)
Friend Property Timer As Integer = DefaultTimer
Friend Property StartupDelay As Integer = 0
Friend Property StartupDelay As Integer = 1
Friend Property ShowNotifications As Boolean = True
Friend Property ShowPictureDownloaded As Boolean = True
Friend Property ShowPictureUser As Boolean = True
Friend Property ShowSimpleNotification As Boolean = False
Private Property Index As Integer = -1 Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex
DirectCast(Obj, AutoDownloader).Index = Index
Return Obj
End Function
#Region "Date"
Private ReadOnly LastDownloadDateXML As Date? = Nothing
Private _LastDownloadDate As Date = Now.AddYears(-1)
@@ -223,20 +228,25 @@ Namespace DownloadObjects
If Not Initialization Then _LastDownloadDateChanged = True
End Set
End Property
Private ReadOnly Property NextExecutionDate As Date
Get
If _PauseValue.HasValue Then
Return {LastDownloadDate.AddMinutes(Timer), _StartTime.AddMinutes(StartupDelay), _PauseValue.Value}.Max
Else
Return {LastDownloadDate.AddMinutes(Timer), _StartTime.AddMinutes(StartupDelay)}.Max
End If
End Get
End Property
Private ReadOnly DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Private Function GetLastDateString() As String
If LastDownloadDateXML.HasValue Or _LastDownloadDateChanged Then
Return LastDownloadDate.ToStringDate(ADateTime.Formats.BaseDateTime)
Return LastDownloadDate.ToStringDate(DateProvider)
Else
Return "never"
End If
End Function
Private Function GetNextDateString() As String
If _LastDownloadDateChanged Then
Return LastDownloadDate.AddMinutes(Timer).ToStringDate(ADateTime.Formats.BaseDateTime)
Else
Return _StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)
End If
Return NextExecutionDate.ToStringDate(DateProvider)
End Function
#End Region
#Region "Information"
@@ -287,14 +297,11 @@ Namespace DownloadObjects
End Sub
Friend Sub New(ByVal x As EContainer)
Me.New
Name = x.Value(Name_Name).FromXML(Of String)("Default")
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)
Labels.ListAddList(x.Value(Name_Labels).StringToList(Of String)("|"), LAP.NotContainsOnly)
Temporary = x.Value(Name_Temporary).FromXML(Of Integer)(CheckState.Indeterminate)
Favorite = x.Value(Name_Favorite).FromXML(Of Integer)(CheckState.Indeterminate)
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
ReadyForDownloadIgnore = x.Value(Name_ReadyForDownloadIgnore).FromXML(Of Boolean)(False)
Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer)
If Timer <= 0 Then Timer = DefaultTimer
StartupDelay = x.Value(Name_StartupDelay).FromXML(Of Integer)(0)
@@ -331,15 +338,9 @@ Namespace DownloadObjects
If Not Source Is Nothing Then Source.Update()
End Sub
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer(Scheduler.Name_Plan, String.Empty) From {
New EContainer(Name_Name, Name),
Return Export(New EContainer(Scheduler.Name_Plan, String.Empty) From {
New EContainer(Name_Mode, CInt(Mode)),
New EContainer(Name_Groups, Groups.ListToString("|")),
New EContainer(Name_Labels, Labels.ListToString("|")),
New EContainer(Name_Temporary, CInt(Temporary)),
New EContainer(Name_Favorite, CInt(Favorite)),
New EContainer(Name_ReadyForDownload, ReadyForDownload.BoolToInteger),
New EContainer(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger),
New EContainer(Name_Timer, Timer),
New EContainer(Name_StartupDelay, StartupDelay),
New EContainer(Name_ShowNotifications, ShowNotifications.BoolToInteger),
@@ -348,7 +349,7 @@ Namespace DownloadObjects
New EContainer(Name_ShowSimpleNotification, ShowSimpleNotification.BoolToInteger),
New EContainer(Name_LastDownloadDate, CStr(AConvert(Of String)(If(LastDownloadDateXML.HasValue Or _LastDownloadDateChanged,
CObj(LastDownloadDate), Nothing), DateProvider, String.Empty)))
}
})
End Function
#End Region
#Region "Execution"
@@ -422,9 +423,20 @@ Namespace DownloadObjects
End Sub
Private Sub Checker()
Try
Dim _StartDownload As Boolean
While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None
If LastDownloadDate.AddMinutes(Timer) < Now And _StartTime.AddMinutes(StartupDelay) < Now And
Not Downloader.Working And Not IsPaused And Not _StopRequested And Not Mode = Modes.None Then Download()
Not Downloader.Working And Not IsPaused And Not _StopRequested And Not Mode = Modes.None Then
_StartDownload = False
If Settings.Automation.Count = 1 Then
_StartDownload = True
ElseIf Index = -1 Then
_StartDownload = True
Else
_StartDownload = NextExecutionDate.AddMilliseconds(1000 * (Index + 1)).Ticks <= Now.Ticks
End If
If _StartDownload Then Download()
End If
Thread.Sleep(500)
End While
Catch ex As Exception
@@ -447,7 +459,6 @@ Namespace DownloadObjects
Dim GName$
Dim i%
Dim DownloadedUsersCount% = 0
Dim l As New ListAddParams(LAP.IgnoreICopier + LAP.NotContainsOnly)
Dim simple As Boolean = ShowSimpleNotification And ShowNotifications
Dim notify As Action = Sub()
With Downloader.Downloaded
@@ -464,7 +475,18 @@ Namespace DownloadObjects
End With
End Sub
Select Case Mode
Case Modes.All : users.ListAddList(Settings.Users.Where(Function(u) u.Exists))
Case Modes.All
Dim CheckLabels As Predicate(Of IUserData) = Function(ByVal u As IUserData) As Boolean
If LabelsExcluded.Count = 0 Then
Return True
ElseIf u.Labels.Count = 0 Then
Return True
Else
Return Not u.Labels.ListContains(LabelsExcluded)
End If
End Function
Dim CheckSites As Predicate(Of IUserData) = Function(u) SitesExcluded.Count = 0 OrElse Not SitesExcluded.Contains(u.Site)
users.ListAddList(Settings.GetUsers(Function(u) UserExistsPredicate(u) And CheckLabels.Invoke(u) And CheckSites.Invoke(u)))
Case Modes.Default
Using g As New GroupParameters : users.ListAddList(DownloadGroup.GetUsers(g, True)) : End Using
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me, True))
@@ -472,24 +494,12 @@ Namespace DownloadObjects
If Groups.Count > 0 And Settings.Groups.Count > 0 Then
For Each GName In Groups
i = Settings.Groups.IndexOf(GName)
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, l)
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, LAP.IgnoreICopier, LAP.NotContainsOnly)
Next
End If
End Select
If users.Count > 0 Then
Keys.ListAddList(users.SelectMany(Of String)(Function(ByVal user As IUserData) As IEnumerable(Of String)
If user.IsCollection Then
With DirectCast(user, UserDataBind)
If .Count > 0 Then
Return .Collections.Select(Function(u) u.Key)
Else
Return New String() {}
End If
End With
Else
Return {user.Key}
End If
End Function))
Keys.ListAddList(users.Select(Function(u) u.Key))
With Downloader
.AutoDownloaderWorking = True
If .Downloaded.Count > 0 Then .Downloaded.RemoveAll(Function(u) Keys.Contains(u.Key)) : .InvokeDownloadsChangeEvent()
@@ -499,7 +509,7 @@ Namespace DownloadObjects
notify.Invoke
If simple And DownloadedUsersCount > 0 Then _
MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader,
$"{DownloadedUsersCount} user(s) downloaded with scheduler plan '{Name}'", $"Scheduler plan '{Name}'")
$"{DownloadedUsersCount} user(s) downloaded with scheduler plan '{Name}'")
End With
End If
Catch ex As Exception

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

@@ -66,13 +66,13 @@ Namespace DownloadObjects
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 276)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 308)
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(476, 301)
CONTAINER_MAIN.Size = New System.Drawing.Size(476, 333)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
@@ -81,29 +81,30 @@ Namespace DownloadObjects
Me.DEF_GROUP.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.DEF_GROUP.ColumnCount = 1
Me.DEF_GROUP.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.Controls.Add(Me.TXT_GROUPS, 0, 5)
Me.DEF_GROUP.Controls.Add(Me.TXT_GROUPS, 0, 6)
Me.DEF_GROUP.Controls.Add(TP_MODE, 0, 0)
Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 7)
Me.DEF_GROUP.Controls.Add(Me.LBL_LAST_TIME_UP, 0, 9)
Me.DEF_GROUP.Controls.Add(Me.NUM_DELAY, 0, 8)
Me.DEF_GROUP.Controls.Add(TP_NOTIFY, 0, 6)
Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 8)
Me.DEF_GROUP.Controls.Add(Me.LBL_LAST_TIME_UP, 0, 10)
Me.DEF_GROUP.Controls.Add(Me.NUM_DELAY, 0, 9)
Me.DEF_GROUP.Controls.Add(TP_NOTIFY, 0, 7)
Me.DEF_GROUP.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEF_GROUP.Location = New System.Drawing.Point(0, 0)
Me.DEF_GROUP.Name = "DEF_GROUP"
Me.DEF_GROUP.RowCount = 11
Me.DEF_GROUP.RowCount = 12
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 276)
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 308)
Me.DEF_GROUP.TabIndex = 0
'
'TXT_GROUPS
@@ -117,10 +118,11 @@ Namespace DownloadObjects
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 140)
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 169)
Me.TXT_GROUPS.Name = "TXT_GROUPS"
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
Me.TXT_GROUPS.TabIndex = 1
Me.TXT_GROUPS.TextBoxReadOnly = True
'
'TP_MODE
'
@@ -220,7 +222,7 @@ Namespace DownloadObjects
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
Me.TXT_TIMER.CaptionWidth = 50.0R
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 195)
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 227)
Me.TXT_TIMER.Name = "TXT_TIMER"
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22)
Me.TXT_TIMER.TabIndex = 3
@@ -230,7 +232,7 @@ Namespace DownloadObjects
Me.LBL_LAST_TIME_UP.AutoSize = True
Me.LBL_LAST_TIME_UP.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_LAST_TIME_UP.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Italic, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 250)
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 282)
Me.LBL_LAST_TIME_UP.Name = "LBL_LAST_TIME_UP"
Me.LBL_LAST_TIME_UP.Size = New System.Drawing.Size(468, 25)
Me.LBL_LAST_TIME_UP.TabIndex = 5
@@ -249,7 +251,7 @@ Namespace DownloadObjects
Me.NUM_DELAY.ClearTextByButtonClear = False
Me.NUM_DELAY.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.NUM_DELAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 224)
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 256)
Me.NUM_DELAY.Name = "NUM_DELAY"
Me.NUM_DELAY.NumberMaximum = New Decimal(New Integer() {1440, 0, 0, 0})
Me.NUM_DELAY.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
@@ -269,12 +271,12 @@ Namespace DownloadObjects
TP_NOTIFY.Controls.Add(Me.CH_SHOW_PIC_USER, 3, 0)
TP_NOTIFY.Controls.Add(Me.CH_NOTIFY_SIMPLE, 1, 0)
TP_NOTIFY.Dock = System.Windows.Forms.DockStyle.Fill
TP_NOTIFY.Location = New System.Drawing.Point(1, 166)
TP_NOTIFY.Location = New System.Drawing.Point(1, 195)
TP_NOTIFY.Margin = New System.Windows.Forms.Padding(0)
TP_NOTIFY.Name = "TP_NOTIFY"
TP_NOTIFY.RowCount = 1
TP_NOTIFY.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_NOTIFY.Size = New System.Drawing.Size(474, 25)
TP_NOTIFY.Size = New System.Drawing.Size(474, 28)
TP_NOTIFY.TabIndex = 2
'
'CH_NOTIFY
@@ -283,7 +285,7 @@ Namespace DownloadObjects
Me.CH_NOTIFY.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_NOTIFY.Location = New System.Drawing.Point(3, 3)
Me.CH_NOTIFY.Name = "CH_NOTIFY"
Me.CH_NOTIFY.Size = New System.Drawing.Size(112, 19)
Me.CH_NOTIFY.Size = New System.Drawing.Size(112, 22)
Me.CH_NOTIFY.TabIndex = 0
Me.CH_NOTIFY.Text = "Show notifications"
TT_MAIN.SetToolTip(Me.CH_NOTIFY, "Show notification when some data has been downloaded")
@@ -295,7 +297,7 @@ Namespace DownloadObjects
Me.CH_SHOW_PIC.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_SHOW_PIC.Location = New System.Drawing.Point(239, 3)
Me.CH_SHOW_PIC.Name = "CH_SHOW_PIC"
Me.CH_SHOW_PIC.Size = New System.Drawing.Size(112, 19)
Me.CH_SHOW_PIC.Size = New System.Drawing.Size(112, 22)
Me.CH_SHOW_PIC.TabIndex = 2
Me.CH_SHOW_PIC.Text = "Image"
TT_MAIN.SetToolTip(Me.CH_SHOW_PIC, "Show downloaded image in notification")
@@ -307,7 +309,7 @@ Namespace DownloadObjects
Me.CH_SHOW_PIC_USER.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_SHOW_PIC_USER.Location = New System.Drawing.Point(357, 3)
Me.CH_SHOW_PIC_USER.Name = "CH_SHOW_PIC_USER"
Me.CH_SHOW_PIC_USER.Size = New System.Drawing.Size(114, 19)
Me.CH_SHOW_PIC_USER.Size = New System.Drawing.Size(114, 22)
Me.CH_SHOW_PIC_USER.TabIndex = 3
Me.CH_SHOW_PIC_USER.Text = "User icon"
TT_MAIN.SetToolTip(Me.CH_SHOW_PIC_USER, "Show user image in notification")
@@ -319,7 +321,7 @@ Namespace DownloadObjects
Me.CH_NOTIFY_SIMPLE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_NOTIFY_SIMPLE.Location = New System.Drawing.Point(121, 3)
Me.CH_NOTIFY_SIMPLE.Name = "CH_NOTIFY_SIMPLE"
Me.CH_NOTIFY_SIMPLE.Size = New System.Drawing.Size(112, 19)
Me.CH_NOTIFY_SIMPLE.Size = New System.Drawing.Size(112, 22)
Me.CH_NOTIFY_SIMPLE.TabIndex = 1
Me.CH_NOTIFY_SIMPLE.Text = "Simple"
TT_MAIN.SetToolTip(Me.CH_NOTIFY_SIMPLE, resources.GetString("CH_NOTIFY_SIMPLE.ToolTip"))
@@ -329,15 +331,15 @@ Namespace DownloadObjects
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(476, 301)
Me.ClientSize = New System.Drawing.Size(476, 333)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.Resources.ArrowDownIcon_Blue_24
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(492, 340)
Me.MaximumSize = New System.Drawing.Size(492, 372)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(492, 340)
Me.MinimumSize = New System.Drawing.Size(492, 372)
Me.Name = "AutoDownloaderEditorForm"
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "AutoDownloader settings"

4
SCrawler/Download/Automation/AutoDownloaderEditorForm.vb
View File

@@ -101,7 +101,7 @@ Namespace DownloadObjects
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GROUPS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ActionButton.DefaultButtons.Edit
Using f As New LabelsForm(MyGroups, Settings.Groups.Select(Function(g) g.Name)) With {.Text = "Groups"}
Using f As New LabelsForm(MyGroups, Settings.Groups.Select(Function(g) g.Name)) With {.Text = "Groups", .Icon = My.Resources.GroupByIcon_16}
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then MyGroups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : TXT_GROUPS.Text = MyGroups.ListToString
End Using
@@ -111,7 +111,7 @@ Namespace DownloadObjects
Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged, OPT_ALL.CheckedChanged, OPT_DEFAULT.CheckedChanged,
OPT_SPEC.CheckedChanged, OPT_GROUP.CheckedChanged,
CH_NOTIFY.CheckedChanged, CH_NOTIFY_SIMPLE.CheckedChanged
DEF_GROUP.Enabled = OPT_SPEC.Checked
DEF_GROUP.Enabled(OPT_ALL.Checked Or OPT_DEFAULT.Checked Or OPT_SPEC.Checked) = OPT_SPEC.Checked
TXT_GROUPS.Enabled = OPT_GROUP.Checked
TXT_TIMER.Enabled = Not OPT_DISABLED.Checked
NUM_DELAY.Enabled = Not OPT_DISABLED.Checked

13
SCrawler/Download/Automation/AutoDownloaderPauseButtons.vb
View File

@@ -178,7 +178,18 @@ Namespace DownloadObjects
Private Sub UpdateBaseButton(ByVal Checked As Boolean)
With MainFrameObj.MF
Select Case Place
Case ButtonsPlace.MainFrame : ApplyButtonStyle(.BTT_DOWN_AUTOMATION_PAUSE, Sub() .BTT_DOWN_AUTOMATION_PAUSE.Checked = Checked)
Case ButtonsPlace.MainFrame : ApplyButtonStyle(.BTT_DOWN_AUTOMATION_PAUSE, Sub()
.BTT_DOWN_AUTOMATION_PAUSE.Checked = Checked
With .MENU_DOWN_ALL
If Checked Then
.BackColor = MyColor.UpdateBack
.ForeColor = MyColor.UpdateFore
Else
.BackColor = Control.DefaultBackColor
.ForeColor = Control.DefaultForeColor
End If
End With
End Sub)
Case ButtonsPlace.Tray : ApplyButtonStyle(MainFrameObj.MF.BTT_TRAY_PAUSE_AUTOMATION, Sub() MainFrameObj.MF.BTT_TRAY_PAUSE_AUTOMATION.Checked = Checked)
End Select
End With

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

@@ -40,7 +40,7 @@ Namespace DownloadObjects
If Plans.Count > 0 Then Plans.ForEach(Sub(p)
p.Source = Me
AddHandler p.PauseDisabled, AddressOf OnPauseDisabled
End Sub)
End Sub) : Plans.ListReindex
End Sub
Default Friend ReadOnly Property Item(ByVal Index As Integer) As AutoDownloader Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorObject
Get
@@ -59,6 +59,7 @@ Namespace DownloadObjects
Plan.Source = Me
AddHandler Plan.PauseDisabled, AddressOf OnPauseDisabled
Plans.Add(Plan)
Plans.ListReindex
Update()
End Sub
Friend Async Function RemoveAt(ByVal Index As Integer) As Task
@@ -73,6 +74,7 @@ Namespace DownloadObjects
.Dispose()
End With
Plans.RemoveAt(Index)
Plans.ListReindex
Update()
End If
End Function
@@ -98,16 +100,18 @@ Namespace DownloadObjects
End Sub
#End Region
#Region "Execution"
Friend Async Sub Start(ByVal Init As Boolean)
Friend Async Function Start(ByVal Init As Boolean) As Task
Await Task.Run(Sub()
If Count > 0 Then
If Plans.Exists(PlanDownloading) Then Await Task.Run(Sub() PlansWaiter(PlanDownloading))
If Plans.Exists(PlanDownloading) Then PlansWaiter(PlanDownloading)
For Each Plan In Plans
Plan.Start(Init)
PlansWaiter(PlanDownloading)
Thread.Sleep(1000)
Await Task.Run(Sub() PlansWaiter(PlanDownloading))
Next
End If
End Sub
End Sub)
End Function
Friend Sub [Stop]()
If Count > 0 Then Plans.ForEach(Sub(p) p.Stop())
End Sub

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

@@ -51,6 +51,7 @@ Namespace DownloadObjects.Groups
End Function
#End Region
#Region "Initializers"
Friend ReadOnly NeedToSave As Boolean = False
Friend Sub New()
BTT_MENU = New ToolStripMenuItem With {
.ToolTipText = "Download users of this group",
@@ -90,12 +91,18 @@ Namespace DownloadObjects.Groups
End Sub
Friend Sub New(ByVal e As EContainer)
Me.New
If e.Attributes.Contains(New EAttribute(Name_Name)) Then
'TODELETE: 2022.10.18.0
NeedToSave = True
Name = e.Attribute(Name_Name)
Temporary = e.Attribute(Name_Temporary).Value.FromXML(Of Integer)(CInt(CheckState.Indeterminate))
Favorite = e.Attribute(Name_Favorite).Value.FromXML(Of Integer)(CInt(CheckState.Indeterminate))
ReadyForDownload = e.Attribute(Name_ReadyForDownload).Value.FromXML(Of Boolean)(True)
ReadyForDownloadIgnore = e.Attribute(Name_ReadyForDownloadIgnore).Value.FromXML(Of Boolean)(False)
If Not e.Value.IsEmptyString Then Labels.ListAddList(e.Value.Split("|"), LAP.NotContainsOnly)
Else
Import(e)
End If
End Sub
#End Region
#Region "ToString"
@@ -149,19 +156,28 @@ Namespace DownloadObjects.Groups
(.Temporary = CheckState.Indeterminate Or user.Temporary = CBool(.Temporary)) And
(.Favorite = CheckState.Indeterminate Or (user.Favorite = CBool(.Favorite))) And
(Not UseReadyOption Or .ReadyForDownloadIgnore Or user.ReadyForDownload = .ReadyForDownload) And user.Exists
Dim f As Func(Of IUserData, IEnumerable(Of IUserData)) = Function(ByVal user As IUserData) As IEnumerable(Of IUserData)
If user.IsCollection Then
With DirectCast(user, UserDataBind)
If .Count > 0 Then Return .Collections.SelectMany(f)
End With
Dim CheckLabelsExcluded As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
If .LabelsExcluded.Count = 0 Then
Return True
ElseIf user.Labels.Count = 0 Then
Return True
Else
If .Labels.Count = 0 OrElse user.Labels.ListContains(.Labels) Then
If CheckParams.Invoke(user) Then Return {user}
Return Not user.Labels.ListContains(.LabelsExcluded)
End If
End If
Return New IUserData() {}
End Function
Return Settings.Users.SelectMany(f)
Dim CheckLabels As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
If .Labels.Count = 0 Then
Return CheckLabelsExcluded.Invoke(user)
ElseIf user.Labels.Count = 0 Then
Return False
Else
Return user.Labels.ListContains(.Labels) And CheckLabelsExcluded.Invoke(user)
End If
End Function
Dim CheckSites As Predicate(Of IUserData) = Function(user) _
(.Sites.Count = 0 OrElse .Sites.Contains(user.Site)) AndAlso
(.SitesExcluded.Count = 0 OrElse Not .SitesExcluded.Contains(user.Site))
Return Settings.GetUsers(Function(user) CheckLabels.Invoke(user) AndAlso CheckSites.Invoke(user) AndAlso CheckParams.Invoke(user))
End With
Else
Return Nothing
@@ -189,11 +205,7 @@ Namespace DownloadObjects.Groups
#End Region
#Region "IEContainerProvider Support"
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer("Group", Labels.ListToString("|"), {New EAttribute(Name_Name, Name),
New EAttribute(Name_Temporary, CInt(Temporary)),
New EAttribute(Name_Favorite, CInt(Favorite)),
New EAttribute(Name_ReadyForDownload, ReadyForDownload.BoolToInteger),
New EAttribute(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger)})
Return Export(New EContainer("Group"))
End Function
#End Region
#Region "IDisposable Support"

17
SCrawler/Download/Groups/DownloadGroupCollection.vb
View File

@@ -22,10 +22,15 @@ Namespace DownloadObjects.Groups
x.LoadData()
If x.Count > 0 Then GroupsList.ListAddList(x, LAP.IgnoreICopier)
End Using
If GroupsList.Count > 0 Then GroupsList.ForEach(Sub(ByVal g As DownloadGroup)
With GroupsList
If .Count > 0 Then
.ForEach(Sub(ByVal g As DownloadGroup)
AddHandler g.Deleted, AddressOf OnGroupDeleted
AddHandler g.Updated, AddressOf OnGroupUpdated
End Sub)
If .Exists(Function(g) g.NeedToSave) Then Update()
End If
End With
End If
GroupsList.ListReindex
End Sub
@@ -49,9 +54,9 @@ Namespace DownloadObjects.Groups
GroupFile.Delete()
End If
End Sub
Private _GroupAddInProgress As Boolean = False
Private Sub OnGroupUpdated(ByVal Sender As DownloadGroup)
Update()
RaiseEvent Updated(Sender)
If Not _GroupAddInProgress Then Update() : RaiseEvent Updated(Sender)
End Sub
Private Sub OnGroupDeleted(ByVal Sender As DownloadGroup)
RaiseEvent Deleted(Sender)
@@ -67,10 +72,16 @@ Namespace DownloadObjects.Groups
Using f As New GroupEditorForm(Nothing)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
_GroupAddInProgress = True
GroupsList.Add(f.MyGroup)
With GroupsList.Last
AddHandler .Deleted, AddressOf OnGroupDeleted
AddHandler .Updated, AddressOf OnGroupUpdated
End With
GroupsList.ListReindex
RaiseEvent Added(GroupsList.Last)
Update()
_GroupAddInProgress = False
End If
End Using
End Sub

132
SCrawler/Download/Groups/GroupDefaults.vb
View File

@@ -18,28 +18,28 @@ Namespace DownloadObjects.Groups
Private ReadOnly CH_READY_FOR_DOWN As CheckBox
Private ReadOnly CH_READY_FOR_DOWN_IGNORE As CheckBox
Private WithEvents TXT_LABELS As TextBoxExtended
Private WithEvents TXT_SITES As TextBoxExtended
Friend WithEvents TXT_NAME As TextBoxExtended
Private ReadOnly Labels As List(Of String)
Private ReadOnly LabelsExcluded As List(Of String)
Private ReadOnly Sites As List(Of String)
Private ReadOnly SitesExcluded As List(Of String)
Public Sub New()
Labels = New List(Of String)
TXT_LABELS = New TextBoxExtended
With TXT_LABELS
.BeginInit()
.Buttons.AddRange({ADB.Edit, ADB.Clear})
.CaptionText = "Labels"
.CaptionWidth = 50
.Dock = DockStyle.Fill
.EndInit()
End With
TXT_NAME = New TextBoxExtended
With TXT_NAME
.BeginInit()
.Buttons.Add(ADB.Clear)
.CaptionText = "Name"
.CaptionWidth = 50
.Dock = DockStyle.Fill
.EndInit()
End With
LabelsExcluded = New List(Of String)
Sites = New List(Of String)
SitesExcluded = New List(Of String)
InitTextBox(TXT_LABELS, "Labels", {New ActionButton(ADB.Edit) With {.ToolTipText = "Edit selected labels"},
New ActionButton(ADB.Delete) With {.ToolTipText = "Edit excluded labels"}, ADB.Clear})
TXT_LABELS.TextBoxReadOnly = True
InitTextBox(TXT_SITES, "Sites", {New ActionButton(ADB.Edit) With {.ToolTipText = "Edit selected sites"},
New ActionButton(ADB.Delete) With {.ToolTipText = "Edit excluded sites"}, ADB.Clear})
TXT_SITES.TextBoxReadOnly = True
InitTextBox(TXT_NAME, "Name", {ADB.Clear})
CH_TEMPORARY = New CheckBox With {.Text = "Temporary", .Name = "CH_TEMPORARY", .ThreeState = True, .CheckState = CheckState.Indeterminate, .Dock = DockStyle.Fill}
CH_FAV = New CheckBox With {.Text = "Favorite", .Name = "CH_FAV", .ThreeState = True, .CheckState = CheckState.Indeterminate, .Dock = DockStyle.Fill}
CH_READY_FOR_DOWN = New CheckBox With {.Text = "Ready for download", .Name = "CH_READY_FOR_DOWN", .Checked = True, .Dock = DockStyle.Fill}
@@ -49,6 +49,17 @@ Namespace DownloadObjects.Groups
TP_2 = New TableLayoutPanel With {.CellBorderStyle = TableLayoutPanelCellBorderStyle.Single, .Margin = New Padding(0), .Dock = DockStyle.Fill}
FillTP(TP_2, CH_READY_FOR_DOWN, CH_READY_FOR_DOWN_IGNORE)
End Sub
Private Sub InitTextBox(ByRef TXT As TextBoxExtended, ByVal Caption As String, ByVal Buttons As ActionButton())
TXT = New TextBoxExtended
With TXT
.BeginInit()
.Buttons.AddRange(Buttons)
.CaptionText = Caption
.CaptionWidth = 50
.Dock = DockStyle.Fill
.EndInit()
End With
End Sub
Private Sub FillTP(ByRef TP As TableLayoutPanel, ByVal CNT1 As Control, ByVal CNT2 As Control)
With TP
.ColumnCount = 2
@@ -87,33 +98,63 @@ Namespace DownloadObjects.Groups
CellBorderStyle = TableLayoutPanelCellBorderStyle.Single
ColumnCount = 1
ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100))
RowCount = 6
RowCount = 7
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
RowStyles.Add(New RowStyle(SizeType.Absolute, 25))
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
RowStyles.Add(New RowStyle(SizeType.Absolute, 28))
RowStyles.Add(New RowStyle(SizeType.Percent, 100))
End If
Controls.Add(TXT_NAME, 0, 1)
Controls.Add(TP_1, 0, 2)
Controls.Add(TP_2, 0, 3)
Controls.Add(TXT_LABELS, 0, 4)
Controls.Add(TXT_SITES, 0, 5)
End Sub
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_LABELS.ActionOnButtonClick
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_LABELS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ADB.Edit
Using f As New LabelsForm(Labels)
Case ADB.Edit, ADB.Delete
With If(Sender.DefaultButton = ADB.Edit, Labels, LabelsExcluded)
Using f As New LabelsForm(.ListSelf, True)
If Sender.DefaultButton = ADB.Delete Then f.Text &= " excluded"
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Labels.ListAddList(f.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
TXT_LABELS.Clear()
TXT_LABELS.Text = Labels.ListToString
.AsList.ListAddList(f.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
UpdateLabelsText()
End If
End Using
Case ADB.Clear : Labels.Clear()
End With
Case ADB.Clear : Labels.Clear() : LabelsExcluded.Clear() : TXT_LABELS.Clear() : UpdateLabelsText()
End Select
End Sub
Private Sub TXT_SITES_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_SITES.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ADB.Edit, ADB.Delete
With If(Sender.DefaultButton = ADB.Edit, Sites, SitesExcluded)
Using f As New Editors.SiteSelectionForm(.ListSelf)
If Sender.DefaultButton = ADB.Delete Then f.Text &= " excluded"
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
.AsList.ListAddList(f.SelectedSites, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
UpdateSitesText()
End If
End Using
End With
Case ADB.Clear : Sites.Clear() : SitesExcluded.Clear() : TXT_SITES.Clear() : UpdateSitesText()
End Select
End Sub
Private Sub UpdateLabelsText()
TXT_LABELS.Clear()
If Not _JustExcludeOptions Then TXT_LABELS.Text = Labels.ListToString
If LabelsExcluded.Count > 0 Then TXT_LABELS.Text.StringAppend($"EXCLUDED: {LabelsExcluded.ListToString}", "; ")
End Sub
Private Sub UpdateSitesText()
TXT_SITES.Clear()
If Not _JustExcludeOptions Then TXT_SITES.Text = Sites.ListToString
If SitesExcluded.Count > 0 Then TXT_SITES.Text.StringAppend($"EXCLUDED: {SitesExcluded.ListToString}", "; ")
End Sub
Friend Sub [Get](ByRef Instance As IGroup)
If Not Instance Is Nothing Then
With Instance
@@ -124,6 +165,12 @@ Namespace DownloadObjects.Groups
.ReadyForDownloadIgnore = CH_READY_FOR_DOWN_IGNORE.Checked
.Labels.Clear()
.Labels.ListAddList(Labels)
.LabelsExcluded.Clear()
.LabelsExcluded.ListAddList(LabelsExcluded)
.Sites.Clear()
.Sites.ListAddList(Sites)
.SitesExcluded.Clear()
.SitesExcluded.ListAddList(SitesExcluded)
End With
End If
End Sub
@@ -135,21 +182,48 @@ Namespace DownloadObjects.Groups
CH_FAV.CheckState = .Favorite
CH_READY_FOR_DOWN.Checked = .ReadyForDownload
CH_READY_FOR_DOWN_IGNORE.Checked = .ReadyForDownloadIgnore
Labels.ListAddList(.Labels)
TXT_LABELS.Text = Labels.ListToString
LabelsExcluded.ListAddList(.LabelsExcluded)
UpdateLabelsText()
Sites.ListAddList(.Sites)
SitesExcluded.ListAddList(.SitesExcluded)
UpdateSitesText()
End With
End If
End Sub
Private _Enabled As Boolean = True
Friend Shadows Property Enabled As Boolean
Private _JustExcludeOptions As Boolean = False
Friend Overloads Property Enabled(Optional ByVal LeaveExcludeOptions As Boolean = False) As Boolean
Get
Return _Enabled
End Get
Set(ByVal e As Boolean)
_Enabled = e
_JustExcludeOptions = False
TP_1.Enabled = e
TP_2.Enabled = e
TXT_LABELS.Enabled = e
If e Then
TXT_LABELS.Enabled = True
TXT_SITES.Enabled = True
ElseIf LeaveExcludeOptions Then
_JustExcludeOptions = True
TXT_LABELS.Enabled = True
TXT_LABELS.Button(ADB.Edit).Enabled = False
TXT_LABELS.Button(ADB.Delete).Enabled = True
TXT_LABELS.Button(ADB.Clear).Enabled = False
TXT_SITES.Enabled = True
TXT_SITES.Button(ADB.Edit).Enabled = False
TXT_SITES.Button(ADB.Delete).Enabled = True
TXT_SITES.Button(ADB.Clear).Enabled = False
Else
TXT_LABELS.Enabled = False
TXT_SITES.Enabled = False
End If
UpdateLabelsText()
UpdateSitesText()
End Set
End Property
End Class

18
SCrawler/Download/Groups/GroupEditorForm.Designer.vb generated
View File

@@ -35,13 +35,13 @@ Namespace DownloadObjects.Groups
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEFS_GROUP)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 109)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 141)
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(476, 134)
CONTAINER_MAIN.Size = New System.Drawing.Size(476, 166)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
@@ -53,29 +53,30 @@ Namespace DownloadObjects.Groups
Me.DEFS_GROUP.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEFS_GROUP.Location = New System.Drawing.Point(0, 0)
Me.DEFS_GROUP.Name = "DEFS_GROUP"
Me.DEFS_GROUP.RowCount = 6
Me.DEFS_GROUP.RowCount = 7
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_GROUP.Size = New System.Drawing.Size(476, 109)
Me.DEFS_GROUP.TabIndex = 1
Me.DEFS_GROUP.Size = New System.Drawing.Size(476, 141)
Me.DEFS_GROUP.TabIndex = 0
'
'GroupEditorForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(476, 134)
Me.ClientSize = New System.Drawing.Size(476, 166)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.Resources.GroupByIcon_16
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(492, 173)
Me.MaximumSize = New System.Drawing.Size(492, 205)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(492, 173)
Me.MinimumSize = New System.Drawing.Size(492, 205)
Me.Name = "GroupEditorForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
@@ -86,6 +87,7 @@ Namespace DownloadObjects.Groups
Me.ResumeLayout(False)
End Sub
Private WithEvents DEFS_GROUP As GroupDefaults
End Class
End Namespace

46
SCrawler/Download/Groups/GroupParameters.vb
View File

@@ -6,10 +6,14 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Namespace DownloadObjects.Groups
Friend Interface IGroup
Property Name As String
ReadOnly Property Labels As List(Of String)
ReadOnly Property LabelsExcluded As List(Of String)
ReadOnly Property Sites As List(Of String)
ReadOnly Property SitesExcluded As List(Of String)
Property Temporary As CheckState
Property Favorite As CheckState
Property ReadyForDownload As Boolean
@@ -21,20 +25,60 @@ Namespace DownloadObjects.Groups
Protected Const Name_Favorite As String = "Favorite"
Protected Const Name_ReadyForDownload As String = "RFD"
Protected Const Name_ReadyForDownloadIgnore As String = "RFDI"
Protected Const Name_Labels As String = "Labels"
Protected Const Name_Labels_Excluded As String = "LabelsExcluded"
Protected Const Name_Sites As String = "Sites"
Protected Const Name_Sites_Excluded As String = "SitesExcluded"
Friend Property Name As String Implements IGroup.Name
Friend ReadOnly Property Labels As List(Of String) Implements IGroup.Labels
Friend ReadOnly Property LabelsExcluded As List(Of String) Implements IGroup.LabelsExcluded
Friend ReadOnly Property Sites As List(Of String) Implements IGroup.Sites
Friend ReadOnly Property SitesExcluded As List(Of String) Implements IGroup.SitesExcluded
Friend Property Temporary As CheckState = CheckState.Indeterminate Implements IGroup.Temporary
Friend Property Favorite As CheckState = CheckState.Indeterminate Implements IGroup.Favorite
Friend Property ReadyForDownload As Boolean = True Implements IGroup.ReadyForDownload
Friend Property ReadyForDownloadIgnore As Boolean = False Implements IGroup.ReadyForDownloadIgnore
Friend Sub New()
Labels = New List(Of String)
LabelsExcluded = New List(Of String)
Sites = New List(Of String)
SitesExcluded = New List(Of String)
End Sub
Protected Sub Import(ByVal e As EContainer)
Name = e.Value(Name_Name)
Temporary = e.Value(Name_Temporary).FromXML(Of Integer)(CInt(CheckState.Indeterminate))
Favorite = e.Value(Name_Favorite).FromXML(Of Integer)(CInt(CheckState.Indeterminate))
ReadyForDownload = e.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
ReadyForDownloadIgnore = e.Value(Name_ReadyForDownloadIgnore).FromXML(Of Boolean)(False)
Dim l As New ListAddParams(LAP.NotContainsOnly)
If Not e.Value(Name_Labels).IsEmptyString Then Labels.ListAddList(e.Value(Name_Labels).Split("|"), l)
If Not e.Value(Name_Labels_Excluded).IsEmptyString Then LabelsExcluded.ListAddList(e.Value(Name_Labels_Excluded).Split("|"), l)
If Not e.Value(Name_Sites).IsEmptyString Then Sites.ListAddList(e.Value(Name_Sites).Split("|"), l)
If Not e.Value(Name_Sites_Excluded).IsEmptyString Then SitesExcluded.ListAddList(e.Value(Name_Sites_Excluded).Split("|"), l)
End Sub
Protected Function Export(ByVal e As EContainer) As EContainer
e.AddRange({New EContainer(Name_Name, Name),
New EContainer(Name_Temporary, CInt(Temporary)),
New EContainer(Name_Favorite, CInt(Favorite)),
New EContainer(Name_ReadyForDownload, ReadyForDownload.BoolToInteger),
New EContainer(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger),
New EContainer(Name_Labels, Labels.ListToString("|")),
New EContainer(Name_Labels_Excluded, LabelsExcluded.ListToString("|")),
New EContainer(Name_Sites, Sites.ListToString("|")),
New EContainer(Name_Sites_Excluded, SitesExcluded.ListToString("|"))})
Return e
End Function
#Region "IDisposable Support"
Protected disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Labels.Clear()
If disposing Then
Labels.Clear()
LabelsExcluded.Clear()
Sites.Clear()
SitesExcluded.Clear()
End If
disposedValue = True
End If
End Sub

2
SCrawler/Editors/LabelsForm.Designer.vb generated
View File

@@ -79,11 +79,11 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(374, 421)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = Global.SCrawler.My.Resources.Resources.TagIcon_32
Me.KeyPreview = True
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(390, 460)
Me.Name = "LabelsForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.Text = "Labels"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)

6
SCrawler/Editors/LabelsForm.vb
View File

@@ -18,6 +18,8 @@ Friend Class LabelsForm
Get
If Not _Source Is Nothing Then
Return _Source
ElseIf AddNoParsed Then
Return ListAddList(Nothing, Settings.Labels).ListAddValue(LabelsKeeper.NoParsedUser, LAP.NotContainsOnly)
Else
Return Settings.Labels
End If
@@ -27,8 +29,10 @@ Friend Class LabelsForm
Friend Property MultiUser As Boolean = False
Friend Property MultiUserClearExists As Boolean = False
Friend Property WithDeleteButton As Boolean = False
Friend Sub New(ByVal LabelsArr As IEnumerable(Of String))
Private ReadOnly AddNoParsed As Boolean = False
Friend Sub New(ByVal LabelsArr As IEnumerable(Of String), Optional ByVal AddNoParsed As Boolean = False)
InitializeComponent()
Me.AddNoParsed = AddNoParsed
LabelsList = New List(Of String)
LabelsList.ListAddList(LabelsArr)
MyDefs = New DefaultFormOptions(Me, Settings.Design)

2
SCrawler/Editors/SiteSelectionForm.Designer.vb generated
View File

@@ -87,7 +87,7 @@ Namespace Editors
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Select Site"
Me.Text = "Sites"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()

2
SCrawler/MainFrame.Designer.vb generated
View File

@@ -910,7 +910,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents BTT_ADD_USER As ToolStripButton
Private WithEvents BTT_DELETE_USER As ToolStripButton
Private WithEvents BTT_DOWN_SELECTED As ToolStripKeyMenuItem
Private WithEvents MENU_DOWN_ALL As ToolStripDropDownButton
Private WithEvents Toolbar_BOTTOM As StatusStrip
Private WithEvents PR_MAIN As ToolStripProgressBar
Private WithEvents LBL_STATUS As ToolStripStatusLabel
@@ -986,4 +985,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents BTT_SILENT_MODE As ToolStripMenuItem
Friend WithEvents BTT_DOWN_AUTOMATION_PAUSE As ToolStripMenuItem
Private WithEvents BTT_TRAY_FEED_SHOW As ToolStripMenuItem
Friend WithEvents MENU_DOWN_ALL As ToolStripDropDownButton
End Class

43
SCrawler/MainFrame.vb
View File

@@ -52,7 +52,7 @@ Public Class MainFrame
End Sub
#End Region
#Region "Form handlers"
Private Sub MainFrame_Load(sender As Object, e As EventArgs) Handles Me.Load
Private Async Sub MainFrame_Load(sender As Object, e As EventArgs) Handles Me.Load
If _VideoDownloadingMode Then GoTo FormClosingInvoker
If Now.Month.ValueBetween(6, 8) Then Text = "SCrawler: Happy LGBT Pride Month! :-)"
Settings.DeleteCachePath()
@@ -115,7 +115,7 @@ Public Class MainFrame
AddHandler Settings.Groups.Deleted, AddressOf Settings.Automation.GROUPS_Deleted
AddHandler Settings.Automation.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons
_UFinit = False
Settings.Automation.Start(True)
Await Settings.Automation.Start(True)
UpdatePauseButtonsVisibility()
GoTo EndFunction
FormClosingInvoker:
@@ -376,13 +376,13 @@ CloseResume:
DownloadSelectedUser(DownUserLimits.None, e.IncludeInTheFeed)
End Sub
Private Sub BTT_DOWN_ALL_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_ALL.KeyClick
Downloader.AddRange(Settings.Users.Where(Function(u) u.ReadyForDownload And u.Exists), e.IncludeInTheFeed)
Downloader.AddRange(Settings.GetUsers(Function(u) u.ReadyForDownload And u.Exists), e.IncludeInTheFeed)
End Sub
Private Sub BTT_DOWN_SITE_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_SITE.KeyClick
DownloadSiteFull(True, e.IncludeInTheFeed)
End Sub
Private Sub BTT_DOWN_ALL_FULL_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_ALL_FULL.KeyClick
Downloader.AddRange(Settings.Users.Where(Function(u) u.Exists), e.IncludeInTheFeed)
Downloader.AddRange(Settings.GetUsers(UserExistsPredicate), e.IncludeInTheFeed)
End Sub
Private Sub BTT_DOWN_SITE_FULL_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_DOWN_SITE_FULL.KeyClick
DownloadSiteFull(False, e.IncludeInTheFeed)
@@ -395,18 +395,8 @@ CloseResume:
Settings.LatestDownloadedSites.AddRange(f.SelectedSites)
Settings.LatestDownloadedSites.Update()
If f.SelectedSites.Count > 0 Then
Downloader.AddRange(Settings.Users.SelectMany(Function(ByVal u As IUserData) As IEnumerable(Of IUserData)
If u.IsCollection Then
Return DirectCast(u, UserDataBind).Collections.
Where(Function(uu) f.SelectedSites.Contains(uu.Site) And u.Exists And
(Not ReadyForDownloadOnly Or uu.ReadyForDownload))
ElseIf f.SelectedSites.Contains(u.Site) And u.Exists And
(Not ReadyForDownloadOnly Or u.ReadyForDownload) Then
Return {u}
Else
Return New IUserData() {}
End If
End Function), IncludeInTheFeed)
Downloader.AddRange(Settings.GetUsers(Function(u) f.SelectedSites.Contains(u.Site) And u.Exists And
(Not ReadyForDownloadOnly Or u.ReadyForDownload)), IncludeInTheFeed)
End If
End If
End Using
@@ -421,7 +411,7 @@ CloseResume:
End Sub
Private Sub GROUPS_Updated(ByVal Sender As Groups.DownloadGroup)
Dim i% = MENU_DOWN_ALL.DropDownItems.IndexOf(Sender.GetControl)
ControlInvoke(Toolbar_TOP, MENU_DOWN_ALL, Sub() MENU_DOWN_ALL.DropDownItems(i).Text = Sender.ToString)
If i >= 0 Then ControlInvoke(Toolbar_TOP, MENU_DOWN_ALL, Sub() MENU_DOWN_ALL.DropDownItems(i).Text = Sender.ToString)
End Sub
Private Sub GROUPS_Deleted(ByVal Sender As Groups.DownloadGroup)
MENU_DOWN_ALL.DropDownItems.Remove(Sender.GetControl)
@@ -442,9 +432,9 @@ CloseResume:
ControlInvokeFast(Toolbar_TOP, BTT_DOWN_AUTOMATION_PAUSE, Sub() BTT_DOWN_AUTOMATION_PAUSE.Visible = b)
ControlInvokeFast(Me, Sub() BTT_TRAY_PAUSE_AUTOMATION.Visible = b)
End Sub
Private Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click
Private Async Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click
Using f As New SchedulerEditorForm : f.ShowDialog() : End Using
Settings.Automation.Start(False)
Await Settings.Automation.Start(False)
UpdatePauseButtonsVisibility()
MainFrameObj.PauseButtons.UpdatePauseButtons()
End Sub
@@ -1438,21 +1428,14 @@ ResumeDownloadingOperation:
Friend Sub User_OnUserUpdated(ByVal User As IUserData)
UserListUpdate(User, False)
End Sub
Private _LogColorChanged As Boolean = False
Private Sub Downloader_UpdateJobsCount(ByVal TotalCount As Integer)
Dim a As Action = Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]")
If Toolbar_BOTTOM.InvokeRequired Then Toolbar_BOTTOM.Invoke(a) Else a.Invoke
If Not _LogColorChanged AndAlso Not MyMainLOG.IsEmptyString Then
ControlInvokeFast(Toolbar_BOTTOM, LBL_JOBS_COUNT, Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]"))
MainFrameObj.UpdateLogButton()
_LogColorChanged = True
ElseIf _LogColorChanged And MyMainLOG.IsEmptyString Then
MainFrameObj.UpdateLogButton()
_LogColorChanged = False
End If
End Sub
Private Sub Downloader_Downloading(ByVal Value As Boolean)
Dim a As Action = Sub() BTT_DOWN_STOP.Enabled = Value Or Downloader.Working
If Toolbar_TOP.InvokeRequired Then Toolbar_TOP.Invoke(a) Else a.Invoke
Dim __isDownloading As Boolean = Value Or Downloader.Working
ControlInvokeFast(Toolbar_TOP, BTT_DOWN_STOP, Sub() BTT_DOWN_STOP.Enabled = __isDownloading)
ControlInvokeFast(Me, Sub() TrayIcon.Icon = If(__isDownloading, My.Resources.ArrowDownIcon_Blue_24, My.Resources.RainbowIcon_48))
End Sub
#End Region
End Class

24
SCrawler/MainFrameObjects.vb
View File

@@ -48,35 +48,31 @@ Friend Class MainFrameObjects
#End Region
#Region "Form functions"
Friend Sub Focus(Optional ByVal Show As Boolean = False)
ControlInvokeFast(MF, Sub()
If Not MF.Visible And Show Then MF.Show()
If MF.Visible Then MF.BringToFront() : MF.Activate()
End Sub)
End Sub
Friend Sub ChangeCloseVisible()
Dim a As Action = Sub() MF.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = Settings.ClosingCommand.Attribute And Not Settings.ClosingCommand.IsEmptyString
If MF.TRAY_CONTEXT.InvokeRequired Then MF.TRAY_CONTEXT.Invoke(a) Else a.Invoke
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)
End Sub
#End Region
#Region "Notifications"
Friend Overloads Sub ShowNotification(ByVal Sender As SettingsCLS.NotificationObjects, ByVal Message As String)
If Settings.ProcessNotification(Sender) Then MF.TrayIcon.ShowBalloonTip(2000, MF.TrayIcon.BalloonTipTitle, Message, ToolTipIcon.Info)
End Sub
Friend Overloads Sub ShowNotification(ByVal Sender As SettingsCLS.NotificationObjects, ByVal Message As String, ByVal Title As String)
If Settings.ProcessNotification(Sender) Then MF.TrayIcon.ShowBalloonTip(2000, Title, Message, ToolTipIcon.Info)
End Sub
Friend Overloads Sub ShowNotification(ByVal Sender As SettingsCLS.NotificationObjects, ByVal Message As String, ByVal Title As String, ByVal Icon As ToolTipIcon)
If Settings.ProcessNotification(Sender) Then MF.TrayIcon.ShowBalloonTip(2000, Title, Message, Icon)
Private Const NotificationInternalKey As String = "NotificationInternalKey"
Friend Sub ShowNotification(ByVal Sender As SettingsCLS.NotificationObjects, ByVal Message As String)
If Settings.ProcessNotification(Sender) Then
Using n As New Notification(Message) With {.Key = NotificationInternalKey} : n.Show() : End Using
End If
End Sub
Friend Sub ClearNotifications()
Notificator.Clear()
End Sub
Private Sub Notificator_OnClicked(ByVal Key As String) Handles Notificator.OnClicked
If Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key) Then
If Not MF.Visible Then MF.Show()
Focus()
End If
If Key = NotificationInternalKey OrElse Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key) Then Focus(True)
End Sub
#End Region
End Class

1
SCrawler/MainMod.vb
View File

@@ -101,6 +101,7 @@ Friend Module MainMod
Friend MainFrameObj As MainFrameObjects
Friend ReadOnly ParsersDataDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Friend ReadOnly FeedVideoLengthProvider As New ADateTime("hh\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
Friend ReadOnly UserExistsPredicate As New FPredicate(Of IUserData)(Function(u) u.Exists)
Friend ReadOnly LogConnector As New LogHost
#Region "File name operations"
Friend FileDateAppenderProvider As IFormatProvider

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("2022.10.18.0")>
<Assembly: AssemblyFileVersion("2022.10.18.0")>
<Assembly: AssemblyVersion("2022.10.23.0")>
<Assembly: AssemblyFileVersion("2022.10.23.0")>
<Assembly: NeutralResourcesLanguage("en")>

10
SCrawler/My Project/Resources.Designer.vb generated
View File

@@ -360,6 +360,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
'''</summary>
Friend ReadOnly Property TagIcon_32() As System.Drawing.Icon
Get
Dim obj As Object = ResourceManager.GetObject("TagIcon_32", resourceCulture)
Return CType(obj,System.Drawing.Icon)
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
'''</summary>

3
SCrawler/My Project/Resources.resx
View File

@@ -211,4 +211,7 @@
<data name="PinPic_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\PinPic_32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="TagIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Icons\TagIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
</root>

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

@@ -187,7 +187,7 @@ Namespace Plugin.Hosts
If m.MemberType = MemberTypes.Property Then
PropList.Add(New PropertyValueHost(Source, m))
With DirectCast(m, PropertyInfo)
If .PropertyType Is GetType(Response) Then _ResponserGetMethod = .GetMethod
If .PropertyType Is GetType(Response) AndAlso m.GetCustomAttribute(Of DoNotUse)() Is Nothing Then _ResponserGetMethod = .GetMethod
End With
End If
With m.GetCustomAttributes()

1
SCrawler/SCrawler.vbproj
View File

@@ -563,6 +563,7 @@
<None Include="Content\Pictures\ArrowDownPic_Blue_24.png" />
<None Include="Content\Icons\ArrowDownIcon_Blue_24.ico" />
<None Include="Content\Pictures\PinPic_32.png" />
<None Include="Content\Icons\TagIcon_32.ico" />
<Content Include="ffmpeg.exe">
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</Content>

18
SCrawler/SettingsCLS.vb
View File

@@ -449,6 +449,24 @@ Friend Class SettingsCLS : Implements IDisposable
End If
Return Nothing
End Function
Friend Function GetUsers(ByVal Predicate As Predicate(Of IUserData)) As IEnumerable(Of IUserData)
With Users
If .Count > 0 Then
Dim fp As Func(Of IUserData, Boolean) = FPredicate(Of IUserData).ToFunc(Predicate)
Return .SelectMany(Of IUserData)(Function(ByVal user As IUserData) As IEnumerable(Of IUserData)
If user.IsCollection Then
With DirectCast(user, UserDataBind)
If .Count > 0 Then Return .Where(fp)
End With
Else
If Predicate.Invoke(user) Then Return {user}
End If
Return New IUserData() {}
End Function)
End If
End With
Return New IUserData() {}
End Function
#End Region
Friend Sub UpdateBlackList()
If BlackList.Count > 0 Then