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

3.0.0.0

Browse Source 
Parsing profiles descriptions (Reddit and Twitter) and updating it
Filters: deleted, suspended, dates
Collections containing deleted profiles are marked in blue
Marked collection context elements
Find profile in the main window from the info form
New hotkeys in the info form: up, down, find, enter
New hotkey in the main window: enter
New list refill algo
Added copying user pictures from all channels
Changed view modes
Changed comparer and ToString of UserDataBase
New parameter added to channels stats (my users)
Added view mode "details"
Fixed twitter files overriding
Fixed full parsing of reddit posts
Fixed Insta timers and minors
Fixed library fatal
Removed UserDataBind comparer override
Added GetUserMediaOnly for reddit users from channels
Added Reddit availability check with DownDetector
Added PLUGINS
This commit is contained in:
Andy
2022-03-17 21:15:22 +03:00
parent 19373ec4ba
commit 05c84c2c08
135 changed files with 7889 additions and 3794 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
SCrawler/API/Base/DownDetector.vb Normal file
View File

@@ -0,0 +1,60 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base
Friend NotInheritable Class DownDetector
Private Shared ReadOnly Property Params As New RParams("x:.'([\S]+?)',.y:.(\d+)", -1, Nothing, RegexReturn.List)
Private Sub New()
End Sub
Friend Structure Data : Implements IRegExCreator, IComparable(Of Data)
Friend [Date] As Date
Friend Value As Integer
Friend Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists Then
Try : [Date] = Date.Parse(ParamsArray(0)) : Catch : End Try
If ParamsArray.Length > 1 Then Value = AConvert(Of Integer)(ParamsArray(1), 0)
End If
Return Me
End Function
Public Overrides Function ToString() As String
Return $"{AConvert(Of String)([Date], ADateTime.Formats.BaseDateTime, String.Empty)} [{Value}]"
End Function
Friend Function CompareTo(ByVal Other As Data) As Integer Implements IComparable(Of Data).CompareTo
Return [Date].CompareTo(Other.Date) * -1
End Function
End Structure
Friend Shared Function GetData(ByVal Site As String) As List(Of Data)
Try
Dim l As List(Of Data) = Nothing
Using w As New WebClient
Dim r$ = w.DownloadString($"https://downdetector.co.uk/status/{Site}/")
If Not r.IsEmptyString Then
l = FNF.RegexFields(Of Data)(r, {Params}, {1, 2})
If l.ListExists(2) Then
Dim lDate As Date = l(0).Date
Dim i%
Dim indx% = -1
For i = 1 To l.Count - 1
If l(i).Date < lDate Then indx = i : Exit For Else lDate = l(i).Date
Next
If indx >= 0 Then
For i = indx To 0 Step -1 : l.RemoveAt(i) : Next
End If
l.Sort()
End If
End If
End Using
Return l
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[DownDetector.GetData({Site})]")
End Try
End Function
End Class
End Namespace

61
SCrawler/API/Base/ProfileSaved.vb Normal file
View File

@@ -0,0 +1,61 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Hosts
Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Imports PDownload = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base
Friend NotInheritable Class ProfileSaved
Private ReadOnly Property HOST As SettingsHost
Private ReadOnly Property Progress As MyProgress
Friend Sub New(ByRef h As SettingsHost, ByRef Bar As MyProgress)
HOST = h
Progress = Bar
End Sub
Friend Sub Download(ByVal Token As CancellationToken)
Try
If HOST.Source.ReadyToDownload(PDownload.SavedPosts) Then
If HOST.Available(PDownload.SavedPosts) Then
HOST.DownloadStarted(PDownload.SavedPosts)
Dim u As New UserInfo With {.Plugin = HOST.Key, .Site = HOST.Name, .SpecialPath = HOST.SavedPostsPath}
Using user As IUserData = HOST.GetInstance(PDownload.SavedPosts, Nothing, False, False)
If Not user Is Nothing AndAlso (Not user.Name.IsEmptyString Or Not HOST.IsMyClass) Then
u.Name = user.Name
With DirectCast(user, UserDataBase).User
u.IsChannel = .IsChannel
u.UpdateUserFile()
End With
With DirectCast(user, UserDataBase)
.User = u
.LoadUserInformation()
.IsSavedPosts = True
.Progress = Progress
If Not .FileExists Then .UpdateUserInformation()
End With
HOST.BeforeStartDownload(user, PDownload.SavedPosts)
user.DownloadData(Token)
Progress.InformationTemporary = $"Images: {user.DownloadedPictures(False)}; Videos: {user.DownloadedVideos(False)}"
HOST.AfterDownload(user, PDownload.SavedPosts)
End If
End Using
Else
Progress.InformationTemporary = $"Host [{HOST.Name}] is unavailable"
End If
Else
Progress.InformationTemporary = $"Host [{HOST.Name}] is nor ready"
End If
Catch ex As Exception
Progress.InformationTemporary = $"{HOST.Name} downloading error"
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Base.ProfileSaved.Download({HOST.Key})]")
Finally
HOST.DownloadDone(PDownload.SavedPosts)
End Try
End Sub
End Class
End Namespace

239
SCrawler/API/Base/SiteSettings.vb
View File

@@ -1,239 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base
Friend Class SiteSettings : Implements IDisposable
Friend Const Header_Twitter_Authorization As String = "authorization"
Friend Const Header_Twitter_Token As String = "x-csrf-token"
Friend ReadOnly Site As Sites
Friend ReadOnly Responser As WEB.Response
Private ReadOnly _Path As XMLValue(Of SFile)
Friend Property Path(Optional ByVal SetProp As Boolean = True) As SFile
Get
If _Path.IsEmptyString Then
Dim tmpPath As SFile = SFile.GetPath($"{Settings.GlobalPath.Value.PathWithSeparator}{Site}")
If SetProp Then _Path.Value = tmpPath Else Return tmpPath
End If
Return _Path.Value
End Get
Set(ByVal NewPath As SFile)
_Path.Value = NewPath
End Set
End Property
Private ReadOnly _SavedPostsPath As XMLValue(Of SFile)
Friend Property SavedPostsPath(Optional ByVal GetAny As Boolean = True) As SFile
Get
If Not _SavedPostsPath.Value.IsEmptyString Then
Return _SavedPostsPath.Value
Else
If GetAny Then
Return $"{Path.PathNoSeparator}\!Saved\"
Else
Return Nothing
End If
End If
End Get
Set(ByVal NewPath As SFile)
_SavedPostsPath.Value = NewPath
End Set
End Property
#Region "Instagram"
Friend ReadOnly Property InstaHash As XMLValue(Of String)
Friend ReadOnly Property InstaHash_SP As XMLValue(Of String)
Friend ReadOnly Property InstaHashUpdateRequired As XMLValue(Of Boolean)
Friend ReadOnly Property InstagramDownloadingErrorDate As XMLValue(Of Date)
Friend Property InstagramLastApplyingValue As Integer? = Nothing
Friend ReadOnly Property InstagramReadyForDownload As Boolean
Get
With InstagramDownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(InstagramLastApplyingValue, 10)) < Now
Else
Return True
End If
End With
End Get
End Property
Friend ReadOnly Property InstagramLastDownloadDate As XMLValue(Of Date)
Friend ReadOnly Property InstagramLastRequestsCount As XMLValue(Of Integer)
Private InstagramTooManyRequestsReadyForCatch As Boolean = True
Friend Function GetInstaWaitDate() As Date
With InstagramDownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(InstagramLastApplyingValue, 10))
Else
Return Now
End If
End With
End Function
Friend Sub InstagramTooManyRequests(ByVal Catched As Boolean)
With InstagramDownloadingErrorDate
If Catched Then
If Not .ValueF.Exists Then
.Value = Now
If InstagramTooManyRequestsReadyForCatch Then
InstagramLastApplyingValue = If(InstagramLastApplyingValue, 0) + 10
InstagramTooManyRequestsReadyForCatch = False
MyMainLOG = $"Instagram downloading error: too many requests. Try again after {If(InstagramLastApplyingValue, 10)} minutes..."
End If
End If
Else
.ValueF = Nothing
InstagramLastApplyingValue = Nothing
InstagramTooManyRequestsReadyForCatch = True
End If
End With
End Sub
Friend ReadOnly Property RequestsWaitTimer As XMLValue(Of Integer)
Friend ReadOnly Property RequestsWaitTimerTaskCount As XMLValue(Of Integer)
Friend ReadOnly Property SleepTimerOnPostsLimit As XMLValue(Of Integer)
#End Region
Friend ReadOnly Property Temporary As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadImages As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadVideos As XMLValue(Of Boolean)
Friend ReadOnly Property GetUserMediaOnly As XMLValue(Of Boolean)
Friend ReadOnly Property SavedPostsUserName As XMLValue(Of String)
Private ReadOnly SettingsFile As SFile
Friend Sub New(ByVal s As Sites, ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean), ByRef _Vids As XMLValue(Of Boolean))
Site = s
SettingsFile = $"{SettingsFolderName}\Responser_{s}.xml"
Responser = New WEB.Response(SettingsFile)
If SettingsFile.Exists Then
Responser.LoadSettings()
Else
Select Case Site
Case Sites.Twitter
With Responser
.ContentType = "application/json"
.Accept = "*/*"
.CookiesDomain = "twitter.com"
.Decoders.Add(SymbolsConverter.Converters.Unicode)
With .Headers
.Add("sec-ch-ua", " Not;A Brand" & Chr(34) & ";v=" & Chr(34) & "99" & Chr(34) & ", " & Chr(34) &
"Google Chrome" & Chr(34) & ";v=" & Chr(34) & "91" & Chr(34) & ", " & Chr(34) & "Chromium" &
Chr(34) & ";v=" & Chr(34) & "91" & Chr(34))
.Add("sec-ch-ua-mobile", "?0")
.Add("sec-fetch-dest", "empty")
.Add("sec-fetch-mode", "cors")
.Add("sec-fetch-site", "same-origin")
.Add(Header_Twitter_Token, String.Empty)
.Add("x-twitter-active-user", "yes")
.Add("x-twitter-auth-type", "OAuth2Session")
.Add(Header_Twitter_Authorization, String.Empty)
End With
End With
Case Sites.Reddit
Responser.CookiesDomain = "reddit.com"
Responser.Decoders.Add(SymbolsConverter.Converters.Unicode)
Case Sites.Instagram : Responser.CookiesDomain = "instagram.com"
Case Sites.RedGifs : Responser.CookiesDomain = "redgifs.com"
End Select
Responser.SaveSettings()
End If
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
_Path = New XMLValue(Of SFile)("Path",, _XML, n, XMLValue(Of SFile).ToFilePath)
_XML.Remove(Site.ToString)
Temporary = New XMLValue(Of Boolean)
Temporary.SetExtended("Temporary", False, _XML, n)
Temporary.SetDefault(_Temp)
DownloadImages = New XMLValue(Of Boolean)
DownloadImages.SetExtended("DownloadImages", True, _XML, n)
DownloadImages.SetDefault(_Imgs)
DownloadVideos = New XMLValue(Of Boolean)
DownloadVideos.SetExtended("DownloadVideos", True, _XML, n)
DownloadVideos.SetDefault(_Vids)
GetUserMediaOnly = New XMLValue(Of Boolean)("GetUserMediaOnly", True, _XML, n)
_SavedPostsPath = New XMLValue(Of SFile)("SavedPostsPath",, _XML, n, XMLValue(Of SFile).ToFilePath)
CreateProp(InstaHashUpdateRequired, Sites.Instagram, "InstaHashUpdateRequired", True, _XML, n)
CreateProp(InstaHash, Sites.Instagram, "InstaHash", String.Empty, _XML, n)
If Site = Sites.Instagram AndAlso (InstaHash.IsEmptyString Or InstaHashUpdateRequired) AndAlso Responser.Cookies.ListExists Then GatherInstaHash()
CreateProp(InstaHash_SP, Sites.Instagram, "InstaHashSavedPosts", String.Empty, _XML, n)
CreateProp(InstagramLastDownloadDate, Sites.Instagram, "LastDownloadDate", Now.AddDays(-1), _XML, n)
CreateProp(InstagramLastRequestsCount, Sites.Instagram, "LastRequestsCount", 0, _XML, n)
CreateProp(RequestsWaitTimer, Sites.Instagram, "RequestsWaitTimer", 1000, _XML, n)
CreateProp(RequestsWaitTimerTaskCount, Sites.Instagram, "RequestsWaitTimerTaskCount", 1, _XML, n)
CreateProp(SleepTimerOnPostsLimit, Sites.Instagram, "SleepTimerOnPostsLimit", 60000, _XML, n)
If Site = Sites.Instagram Then
InstagramDownloadingErrorDate = New XMLValue(Of Date) With {.ToStringFunction = Function(ss, vv) AConvert(Of String)(vv, AModes.Var, Nothing)}
InstagramDownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n)
Else
InstagramDownloadingErrorDate = New XMLValue(Of Date)
End If
SavedPostsUserName = New XMLValue(Of String)("SavedPostsUserName", String.Empty, _XML, n)
End Sub
Private Sub CreateProp(Of T)(ByRef p As XMLValue(Of T), ByVal s As Sites,
ByVal p_Name As String, ByVal p_Value As T, ByRef x As XmlFile, ByVal n() As String)
If Site = s Then
p = New XMLValue(Of T)(p_Name, p_Value, x, n)
Else
p = New XMLValue(Of T)
End If
End Sub
Friend Sub Update()
Responser.SaveSettings()
End Sub
Friend Function GatherInstaHash() As Boolean
Try
Dim rs As New RParams("=""([^""]+?ConsumerLibCommons[^""]+?.js)""", Nothing, 1) With {.MatchTimeOut = 10}
Dim r$ = Responser.GetResponse("https://instagram.com",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim hStr$ = RegexReplace(r, rs)
If Not hStr.IsEmptyString Then
Do While Left(hStr, 1) = "/" : hStr = Right(hStr, hStr.Length - 1) : Loop
hStr = $"https://instagram.com/{hStr}"
r = Responser.GetResponse(hStr,, EDP.ThrowException)
If Not r.IsEmptyString Then
rs = New RParams("generatePaginationActionCreators.+?.profilePosts.byUserId.get.+?queryId:.([\d\w\S]+?)""", Nothing, 1) With {.MatchTimeOut = 10}
Dim h$ = RegexReplace(r, rs)
If Not h.IsEmptyString Then
InstaHash.Value = h
InstaHashUpdateRequired.Value = False
Return True
End If
End If
End If
End If
Return False
Catch ex As Exception
InstaHashUpdateRequired.Value = True
InstaHash.Value = String.Empty
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[SiteSettings.GaterInstaHash]", False)
End Try
End Function
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Responser.Dispose()
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

106
SCrawler/API/Base/SiteSettingsBase.vb Normal file
View File

@@ -0,0 +1,106 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base
Friend MustInherit Class SiteSettingsBase : Implements ISiteSettings, IResponserContainer
Friend ReadOnly Property Site As String Implements ISiteSettings.Site
Friend Overridable ReadOnly Property Icon As Icon = Nothing Implements ISiteSettings.Icon
Friend Overridable ReadOnly Property Image As Image = Nothing Implements ISiteSettings.Image
Friend Overridable ReadOnly Property Responser As Response Implements IResponserContainer.Responser
Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance
Friend Sub New(ByVal SiteName As String)
Site = SiteName
End Sub
Friend Sub New(ByVal SiteName As String, ByVal CookiesDomain As String)
Site = SiteName
Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml")
With Responser
If .File.Exists Then .LoadSettings() Else .CookiesDomain = CookiesDomain : .SaveSettings()
End With
End Sub
#Region "XML"
Friend Overridable Sub Load(ByVal XMLValues As IEnumerable(Of KeyValuePair(Of String, String))) Implements ISiteSettings.Load
End Sub
#End Region
#Region "Initialize"
Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit
End Sub
Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit
End Sub
Friend Overridable Sub BeginUpdate() Implements ISiteSettings.BeginUpdate
End Sub
Friend Overridable Sub EndUpdate() Implements ISiteSettings.EndUpdate
End Sub
#End Region
#Region "Before and After Download"
Friend Overridable Sub DownloadStarted(ByVal What As Download) Implements ISiteSettings.DownloadStarted
End Sub
Friend Overridable Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download) Implements ISiteSettings.BeforeStartDownload
End Sub
Friend Overridable Sub AfterDownload(ByVal User As Object, ByVal What As Download) Implements ISiteSettings.AfterDownload
End Sub
Friend Overridable Sub DownloadDone(ByVal What As Download) Implements ISiteSettings.DownloadDone
End Sub
#End Region
#Region "User info"
Protected UrlPatternUser As String = String.Empty
Protected UrlPatternChannel As String = String.Empty
Friend Overridable Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String Implements ISiteSettings.GetUserUrl
If Channel Then
If Not UrlPatternChannel.IsEmptyString Then Return String.Format(UrlPatternChannel, UserName)
Else
If Not UrlPatternUser.IsEmptyString Then Return String.Format(UrlPatternUser, UserName)
End If
Return String.Empty
End Function
Protected UserRegex As RParams = Nothing
Friend Overridable Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Implements ISiteSettings.IsMyUser
Try
If Not UserRegex Is Nothing Then
Dim s$ = RegexReplace(UserURL, UserRegex)
If Not s.IsEmptyString Then Return New ExchangeOptions(Site, s)
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Base.SiteSettingsBase.IsMyUser]")
End Try
End Function
Protected ImageVideoContains As String = String.Empty
Friend Overridable Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions Implements ISiteSettings.IsMyImageVideo
If Not ImageVideoContains.IsEmptyString AndAlso URL.Contains(ImageVideoContains) Then
Return New ExchangeOptions With {.Exists = True}
Else
Return Nothing
End If
End Function
Friend Overridable Function GetSpecialData(ByVal URL As String) As IEnumerable(Of IPluginUserMedia) Implements ISiteSettings.GetSpecialData
Return Nothing
End Function
Friend Overridable Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return Nothing
End Function
#End Region
#Region "Ready, Available"
Friend Overridable Function Available(ByVal What As Download) As Boolean Implements ISiteSettings.Available
Return True
End Function
Friend Overridable Function ReadyToDownload(ByVal What As Download) As Boolean Implements ISiteSettings.ReadyToDownload
Return True
End Function
#End Region
Friend Overridable Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Implements ISiteSettings.UserOptions
Options = Nothing
End Sub
Friend Overridable Sub OpenSettingsForm() Implements ISiteSettings.OpenSettingsForm
End Sub
End Class
End Namespace

34
SCrawler/API/Base/Structures.vb
View File

@@ -18,8 +18,8 @@ Namespace API.Base
GIF = 50
m3u8 = 100
End Enum
Friend Enum States : Unknown : Tried : Downloaded : Skipped : End Enum
Friend Type As Types
Friend Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : End Enum
Friend [Type] As Types
Friend URL_BASE As String
Friend URL As String
Friend MD5 As String
@@ -27,6 +27,11 @@ Namespace API.Base
Friend Post As UserPost
Friend PictureOption As String
Friend State As States
''' <summary>
''' SomeFolder<br/>
''' SomeFolder\SomeFolder2
''' </summary>
Friend SpecialFolder As String
Friend Sub New(ByVal _URL As String)
URL = _URL
URL_BASE = _URL
@@ -35,7 +40,18 @@ Namespace API.Base
End Sub
Friend Sub New(ByVal _URL As String, ByVal _Type As Types)
Me.New(_URL)
Type = _Type
[Type] = _Type
End Sub
Friend Sub New(ByVal m As Plugin.IPluginUserMedia)
If Not IsNothing(m) Then
[Type] = m.ContentType
URL = m.URL
MD5 = m.MD5
File = m.File
Post = New UserPost With {.ID = m.PostID, .[Date] = m.PostDate}
State = m.DownloadState
SpecialFolder = m.SpecialFolder
End If
End Sub
Public Shared Widening Operator CType(ByVal _URL As String) As UserMedia
Return New UserMedia(_URL)
@@ -46,6 +62,18 @@ Namespace API.Base
Public Overrides Function ToString() As String
Return URL
End Function
Friend Function PluginUserMedia() As Plugin.PluginUserMedia
Return New Plugin.PluginUserMedia With {
.ContentType = Type,
.DownloadState = State,
.File = File,
.MD5 = MD5,
.URL = URL,
.SpecialFolder = SpecialFolder,
.PostID = Post.ID,
.PostDate = Post.Date
}
End Function
Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals
Return URL = Other.URL
End Function

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

@@ -12,35 +12,80 @@ Imports PersonalUtilities.Forms.Toolbars
Imports System.IO
Imports System.Net
Imports System.Threading
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Hosts
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Base
Friend MustInherit Class UserDataBase : Implements IUserData
Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower
Friend Const UserFileAppender As String = "User"
Friend Event OnUserUpdated As IUserData.OnUserUpdatedEventHandler Implements IUserData.OnUserUpdated
Protected Sub Raise_OnUserUpdated()
Private ReadOnly _OnUserUpdatedHandlers As List(Of IUserData.OnUserUpdatedEventHandler)
Friend Custom Event OnUserUpdated As IUserData.OnUserUpdatedEventHandler Implements IUserData.OnUserUpdated
AddHandler(ByVal e As IUserData.OnUserUpdatedEventHandler)
If Not _OnUserUpdatedHandlers.Contains(e) Then _OnUserUpdatedHandlers.Add(e)
End AddHandler
RemoveHandler(ByVal e As IUserData.OnUserUpdatedEventHandler)
If _OnUserUpdatedHandlers.Contains(e) Then _OnUserUpdatedHandlers.Remove(e)
End RemoveHandler
RaiseEvent(ByVal User As IUserData)
If _OnUserUpdatedHandlers.Count > 0 Then
For Each e As IUserData.OnUserUpdatedEventHandler In _OnUserUpdatedHandlers
Try : e.Invoke(User) : Catch : End Try
Next
End If
End RaiseEvent
End Event
Protected Sub RaiseEvent_OnUserUpdated()
RaiseEvent OnUserUpdated(Me)
End Sub
Friend Sub RemoveUpdateHandlers()
_OnUserUpdatedHandlers.Clear()
End Sub
#Region "Collection buttons"
Private _CollectionButtonsExists As Boolean = False
Private _CollectionButtonsColorsSet As Boolean = False
Friend InternalCollectionIndex As Integer = -1
Friend WithEvents BTT_CONTEXT_DOWN As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_PATH As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_SITE As ToolStripMenuItem
Friend Sub CreateButtons(ByVal CollectionIndex As Integer)
InternalCollectionIndex = CollectionIndex
Dim tn$ = $"[{Site}] - {Name}"
Dim _tn$ = $"{Site}{Name}"
Dim tnn As Func(Of String, String) = Function(Input) $"{Input}{_tn}"
Dim i As Image = Nothing
Select Case Site
Case Sites.Reddit : i = My.Resources.RedditIcon.ToBitmap
Case Sites.Twitter : i = My.Resources.TwitterIcon.ToBitmap
End Select
With HOST.Source
If Not .Icon Is Nothing Then
i = .Icon.ToBitmap
ElseIf Not .Image Is Nothing Then
i = .Image
End If
End With
BTT_CONTEXT_DOWN = New ToolStripMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = CollectionIndex}
BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = CollectionIndex}
BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = CollectionIndex}
BTT_CONTEXT_OPEN_PATH = New ToolStripMenuItem(tn, i) With {.Name = tnn("PATH"), .Tag = CollectionIndex}
BTT_CONTEXT_OPEN_SITE = New ToolStripMenuItem(tn, i) With {.Name = tnn("SITE"), .Tag = CollectionIndex}
UpdateButtonsColor()
_CollectionButtonsExists = True
If _UserInformationLoaded Then _CollectionButtonsColorsSet = True
End Sub
Private Sub UpdateButtonsColor()
Dim cb As Color = SystemColors.Control
Dim cf As Color = SystemColors.ControlText
If Not UserExists Then
cb = ColorBttDeleteBack
cf = ColorBttDeleteFore
ElseIf UserSuspended Then
cb = ColorBttEditBack
cf = ColorBttEditFore
End If
For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE}
If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf
Next
If _UserInformationLoaded Then _CollectionButtonsColorsSet = True
End Sub
#End Region
#Region "XML Declarations"
@@ -80,21 +125,17 @@ Namespace API.Base
#End Region
#End Region
#Region "Declarations"
Friend MustOverride Property Site As Sites Implements IContentProvider.Site
Protected _Progress As MyProgress
Friend Overridable Property Progress As MyProgress
Friend ReadOnly Property Site As String Implements IContentProvider.Site
Get
If _Progress Is Nothing Then Return MainProgress Else Return _Progress
Return HOST.Name
End Get
Set(ByVal p As MyProgress)
_Progress = p
End Set
End Property
Friend Property Progress As MyProgress
Friend User As UserInfo
Friend Property IsSavedPosts As Boolean
Friend Overridable Property UserExists As Boolean = True Implements IUserData.Exists
Friend Overridable Property UserSuspended As Boolean = False Implements IUserData.Suspended
Friend Overridable Property Name As String Implements IContentProvider.Name
Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
Friend Overridable Property UserExists As Boolean = True Implements IUserData.Exists, IPluginContentProvider.UserExists
Friend Overridable Property UserSuspended As Boolean = False Implements IUserData.Suspended, IPluginContentProvider.UserSuspended
Friend Overridable Property Name As String Implements IContentProvider.Name, IPluginContentProvider.Name
Get
Return User.Name
End Get
@@ -104,10 +145,31 @@ Namespace API.Base
Settings.UpdateUsersList(User)
End Set
End Property
Friend Overridable Property ID As String = String.Empty Implements IContentProvider.ID
Friend Overridable Property ID As String = String.Empty Implements IContentProvider.ID, IPluginContentProvider.ID
Friend Overridable Property FriendlyName As String = String.Empty Implements IContentProvider.FriendlyName
Friend Property UserDescription As String = String.Empty Implements IContentProvider.Description
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly
#Region "UserDescription"
Friend Property UserDescription As String = String.Empty Implements IContentProvider.Description, IPluginContentProvider.UserDescription
Protected _DescriptionEveryTime As Boolean = False
Protected _DescriptionChecked As Boolean = False
Protected Function UserDescriptionNeedToUpdate() As Boolean
Return (UserDescription.IsEmptyString Or _DescriptionEveryTime) And Not _DescriptionChecked
End Function
Protected Sub UserDescriptionUpdate(ByVal Descr As String)
If UserDescriptionNeedToUpdate() Then
If UserDescription.IsEmptyString Then
UserDescription = Descr
ElseIf Not UserDescription.Contains(Descr) Then
UserDescription &= $"{vbNewLine}----{vbNewLine}{Descr}"
End If
_DescriptionChecked = True
End If
End Sub
Protected Sub UserDescriptionReset()
_DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
End Sub
#End Region
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly, IPluginContentProvider.ParseUserMediaOnly
Protected _Favorite As Boolean = False
Friend Overridable Property Favorite As Boolean Implements IContentProvider.Favorite
Get
@@ -178,7 +240,7 @@ BlockPictureFolder:
p = New UserImage(PicList.First, l, s, MyFile)
GoTo BlockReturn
Else
f.Delete(SFO.Path, False, False, EDP.None)
f.Delete(SFO.Path, Settings.DeleteMode, EDP.None)
DelPath = False
End If
End If
@@ -198,7 +260,7 @@ BlockDeletePictureFolder:
On Error GoTo BlockReturn
If DelPath Then
f = SFile.GetPath($"{MyFile.PathWithSeparator}Pictures")
If f.Exists(SFO.Path, False) Then f.Delete(SFO.Path, False, False)
If f.Exists(SFO.Path, False) Then f.Delete(SFO.Path, Settings.DeleteMode)
End If
BlockReturn:
On Error GoTo BlockNullPicture
@@ -298,85 +360,121 @@ BlockNullPicture:
End Property
#End Region
#Region "Information"
Protected _CountVideo As Integer = 0
Protected Property _CountPictures As Integer = 0
Friend Overridable Property LastUpdated As Date?
Friend ReadOnly Property TotalContentCount As Integer
Get
Return _CountVideo + _CountPictures
End Get
End Property
Friend Overridable Property HasError As Boolean = False Implements IUserData.HasError
Private _DownloadedPicturesTotal As Integer = 0
Private _DownloadedPicturesSession As Integer = 0
Friend Property DownloadedPictures As Integer Implements IUserData.DownloadedPictures
Friend Property DownloadedPictures(ByVal Total As Boolean) As Integer Implements IUserData.DownloadedPictures
Get
Return _DownloadedPicturesSession
Return IIf(Total, _DownloadedPicturesTotal, _DownloadedPicturesSession)
End Get
Set(ByVal NewValue As Integer)
_DownloadedPicturesSession = NewValue
If Total Then
_DownloadedPicturesTotal = NewValue
Else
_DownloadedPicturesSession = NewValue
End If
End Set
End Property
Private _DownloadedVideosTotal As Integer = 0
Private _DownloadedVideosSession As Integer = 0
Friend Property DownloadedVideos As Integer Implements IUserData.DownloadedVideos
Friend Property DownloadedVideos(ByVal Total As Boolean) As Integer Implements IUserData.DownloadedVideos
Get
Return _DownloadedVideosSession
Return IIf(Total, _DownloadedVideosTotal, _DownloadedVideosSession)
End Get
Set(ByVal NewValue As Integer)
_DownloadedVideosSession = NewValue
If Total Then
_DownloadedVideosTotal = NewValue
Else
_DownloadedVideosSession = NewValue
End If
End Set
End Property
Friend Overridable ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer Implements IUserData.DownloadedTotal
Get
If Total Then
Return _DownloadedPicturesTotal + _DownloadedVideosTotal
Else
Return _DownloadedPicturesSession + _DownloadedVideosSession
End If
Return DownloadedPictures(Total) + DownloadedVideos(Total)
End Get
End Property
Friend ReadOnly Property DownloadedInformation As String Implements IUserData.DownloadedInformation
Get
Dim luv$ = String.Empty
If LastUpdated.HasValue Then luv = $"{LastUpdated.Value.ToStringDate(ADateTime.Formats.BaseDateTime)}: "
Return $"{luv}{Name} [{Site}]{IIf(HasError, " (with errors)", String.Empty)}: P - {_DownloadedPicturesTotal}; V - {_DownloadedVideosTotal}" &
$" (P - {_CountPictures}; V - {_CountVideo})"
Return $"{luv}{Name} [{Site}]{IIf(HasError, " (with errors)", String.Empty)}: P - {DownloadedPictures(False)}; V - {DownloadedVideos(False)}" &
$" (P - {DownloadedPictures(True)}; V - {DownloadedVideos(True)})"
End Get
End Property
#End Region
#End Region
#Region "Plugins Support"
Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged
Protected Event TotalCountChanged As IPluginContentProvider.TotalCountChangedEventHandler Implements IPluginContentProvider.TotalCountChanged
Friend Property HOST As SettingsHost Implements IUserData.HOST
Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings
Get
Return HOST.Source
End Get
Set(ByVal s As ISiteSettings)
End Set
End Property
Private Property IPluginContentProvider_Thrower As IThrower Implements IPluginContentProvider.Thrower
Private Property IPluginContentProvider_LogProvider As ILogProvider Implements IPluginContentProvider.LogProvider
Friend Property ExternalPlugin As IPluginContentProvider
Private Property IPluginContentProvider_ExistingContentList As List(Of PluginUserMedia) Implements IPluginContentProvider.ExistingContentList
Private Property IPluginContentProvider_TempPostsList As List(Of String) Implements IPluginContentProvider.TempPostsList
Private Property IPluginContentProvider_TempMediaList As List(Of IPluginUserMedia) Implements IPluginContentProvider.TempMediaList
Private Property IPluginContentProvider_SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder
Private Property IPluginContentProvider_DataPath As String Implements IPluginContentProvider.DataPath
Private Sub IPluginContentProvider_XmlFieldsSet(ByVal Fields As List(Of KeyValuePair(Of String, String))) Implements IPluginContentProvider.XmlFieldsSet
End Sub
Private Function IPluginContentProvider_XmlFieldsGet() As List(Of KeyValuePair(Of String, String)) Implements IPluginContentProvider.XmlFieldsGet
Return Nothing
End Function
Private Sub IPluginContentProvider_GetMedia() Implements IPluginContentProvider.GetMedia
End Sub
Private Sub IPluginContentProvider_Download() Implements IPluginContentProvider.Download
End Sub
Friend Overridable Function ExchangeOptionsGet() As Object Implements IPluginContentProvider.ExchangeOptionsGet
Return Nothing
End Function
Friend Overridable Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet
End Sub
Private _ExternalCompatibilityToken As CancellationToken
#End Region
#Region "IIndexable Support"
Friend Property Index As Integer = 0 Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal _Index As Integer) As Object Implements IIndexable.SetIndex
DirectCast(Obj, UserDataBase).Index = _Index
Return Obj
End Function
#End Region
#Region "LVI"
Friend ReadOnly Property LVIKey As String Implements IUserData.LVIKey
Friend ReadOnly Property LVIKey As String Implements IUserData.Key
Get
If Not _IsCollection Then
Return $"{Site.ToString.ToUpper}_{Name}"
Return $"{IIf(IsChannel, "C", String.Empty)}{Site.ToString.ToUpper}_{Name}"
Else
Return $"CCCC_{CollectionName}"
End If
End Get
End Property
Private _LVIIndex As Integer = -1
Private ReadOnly Property LVIIndex As Integer Implements IUserData.LVIIndex
Get
Return _LVIIndex
End Get
End Property
Friend Function GetLVI(ByVal Destination As ListView) As ListViewItem Implements IUserData.GetLVI
_LVIIndex = Destination.Items.Count
If Settings.ViewModeIsPicture Then
Return New ListViewItem(ToString(), LVIKey, GetLVIGroup(Destination)) With {.Name = LVIKey, .Tag = LVIKey}
Return ListImagesLoader.ApplyLVIColor(Me, New ListViewItem(ToString(), LVIKey, GetLVIGroup(Destination)) With {.Name = LVIKey, .Tag = LVIKey}, True)
Else
Return New ListViewItem(ToString(), GetLVIGroup(Destination)) With {.Name = LVIKey, .Tag = LVIKey}
Return ListImagesLoader.ApplyLVIColor(Me, New ListViewItem(ToString(), GetLVIGroup(Destination)) With {.Name = LVIKey, .Tag = LVIKey}, True)
End If
End Function
Friend Overridable ReadOnly Property FitToAddParams As Boolean Implements IUserData.FitToAddParams
Get
If Settings.LastUpdatedDate.HasValue AndAlso LastUpdated.HasValue AndAlso
LastUpdated.Value.Date > Settings.LastUpdatedDate.Value.Date Then Return False
If Settings.SelectedSites.Count = 0 OrElse Settings.SelectedSites.Contains(Site) Then
Select Case Settings.ShowingMode.Value
Case ShowingModes.Regular : Return Not Temporary And Not Favorite
Case ShowingModes.Temporary : Return Temporary
Case ShowingModes.Favorite : Return Favorite
Case ShowingModes.Deleted : Return Not UserExists
Case ShowingModes.Suspended : Return UserSuspended
Case ShowingModes.Labels : Return Settings.Labels.CurrentSelection.ListContains(Labels)
Case ShowingModes.NoLabels : Return Labels.Count = 0
Case Else : Return True
@@ -393,12 +491,10 @@ BlockNullPicture:
For i% = 0 To Labels.Count - 1
If Settings.Labels.CurrentSelection.Contains(Labels(i)) Then Return Destination.Groups.Item(Labels(i))
Next
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
Else
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
End If
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
Else
Return Destination.Groups.Item(GetLviGroupName(Site, Temporary, Favorite, IsCollection, IsChannel))
Return Destination.Groups.Item(GetLviGroupName(HOST, Temporary, Favorite, IsCollection, IsChannel))
End If
Catch ex As Exception
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
@@ -407,9 +503,9 @@ BlockNullPicture:
Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name}"
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
OutStr.StringAppendLine($"Total downloaded ({TotalContentCount.NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {_CountPictures.NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {_CountVideo.NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Total downloaded ({DownloadedTotal(True).NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {DownloadedPictures(True).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(True).NumToString(ANumbers.Formats.Number, 3)}")
If Not UserDescription.IsEmptyString Then
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine(UserDescription)
@@ -418,8 +514,8 @@ BlockNullPicture:
OutStr.StringAppendLine($"Last updated at: {AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, "not yet")}")
If _DataParsed Then
OutStr.StringAppendLine("Downloaded now:")
OutStr.StringAppendLine($"Pictures: {_CountPictures.NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {_CountVideo.NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Pictures: {DownloadedTotal(False).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(False).NumToString(ANumbers.Formats.Number, 3)}")
End If
Return OutStr
End Function
@@ -434,33 +530,34 @@ BlockNullPicture:
_TempMediaList = New List(Of UserMedia)
_TempPostsList = New List(Of String)
Labels = New List(Of String)
_OnUserUpdatedHandlers = New List(Of IUserData.OnUserUpdatedEventHandler)
If InvokeImageHandler Then ImageHandler(Me)
End Sub
Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment
HOST = h
If AttachUserInfo Then
User = u
If _LoadUserInformation Then LoadUserInformation()
End If
End Sub
''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Overloads Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
Select Case u.Site
Case Sites.Reddit
If u.IsChannel Then
Return New Reddit.Channel(u, _LoadUserInformation)
Else
Return New Reddit.UserData(u, _LoadUserInformation)
End If
Case Sites.Twitter : Return New Twitter.UserData(u, _LoadUserInformation)
Case Sites.Instagram : Return New Instagram.UserData(u, _LoadUserInformation)
Case Sites.RedGifs : Return New RedGifs.UserData(u, _LoadUserInformation)
Case Else : Throw New ArgumentOutOfRangeException("Site", $"Site [{u.Site}] information does not recognized by loader")
End Select
If Not u.Plugin.IsEmptyString Then
Return Settings(u.Plugin).GetInstance(u.DownloadOption, u, _LoadUserInformation)
Else
Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader")
End If
End Function
#End Region
#Region "Information & Content data files loader and saver"
#Region "User information"
Private _UserInformationLoaded As Boolean = False
Friend Overridable Sub LoadUserInformation() Implements IUserData.LoadUserInformation
Try
If MyFile.Exists Then
FileExists = True
Using x As New XmlFile(MyFile) With {.XmlReadOnly = True}
User.Site = Site
Site = x.Value(Name_Site).FromXML(Of Integer)(0)
User.Name = x.Value(Name_UserName)
UserExists = x.Value(Name_UserExists).FromXML(Of Boolean)(True)
UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False)
@@ -475,8 +572,8 @@ BlockNullPicture:
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
DownloadImages = x.Value(Name_DownloadImages).FromXML(Of Boolean)(True)
DownloadVideos = x.Value(Name_DownloadVideos).FromXML(Of Boolean)(True)
_CountVideo = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
_CountPictures = x.Value(Name_PicturesCount).FromXML(Of Integer)(0)
DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
DownloadedPictures(True) = x.Value(Name_PicturesCount).FromXML(Of Integer)(0)
LastUpdated = AConvert(Of Date)(x.Value(Name_LastUpdated), ADateTime.Formats.BaseDateTime, Nothing)
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False)
ChangeCollectionName(x.Value(Name_CollectionName), False)
@@ -484,6 +581,8 @@ BlockNullPicture:
LoadUserInformation_OptionalFields(x, True)
End Using
UpdateDataFiles()
_UserInformationLoaded = True
If _CollectionButtonsExists And Not _CollectionButtonsColorsSet And (Not UserExists Or UserSuspended) Then UpdateButtonsColor()
End If
Catch ex As Exception
LogError(ex, "user information loading error")
@@ -493,7 +592,7 @@ BlockNullPicture:
Try
MyFile.Exists(SFO.Path)
Using x As New XmlFile With {.Name = "User"}
x.Add(Name_Site, CInt(Site))
x.Add(Name_Site, Site)
x.Add(Name_UserName, User.Name)
x.Add(Name_UserExists, UserExists.BoolToInteger)
x.Add(Name_UserSuspended, UserSuspended.BoolToInteger)
@@ -512,8 +611,8 @@ BlockNullPicture:
x.Add(Name_ReadyForDownload, ReadyForDownload.BoolToInteger)
x.Add(Name_DownloadImages, DownloadImages.BoolToInteger)
x.Add(Name_DownloadVideos, DownloadVideos.BoolToInteger)
x.Add(Name_VideoCount, _CountVideo)
x.Add(Name_PicturesCount, _CountPictures)
x.Add(Name_VideoCount, DownloadedVideos(True))
x.Add(Name_PicturesCount, DownloadedPictures(True))
x.Add(Name_LastUpdated, AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, String.Empty))
x.Add(Name_CollectionName, CollectionName)
x.Add(Name_LabelsName, Labels.ListToString(, "|", EDP.ReturnValue))
@@ -597,42 +696,43 @@ BlockNullPicture:
#End Region
#End Region
#Region "Open site, folder"
Friend Overridable Sub OpenSite() Implements IContentProvider.OpenSite
Friend Overridable Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Implements IContentProvider.OpenSite
Try
Dim URL$ = String.Empty
Select Case Site
Case Sites.Reddit : URL = $"https://www.reddit.com/{IIf(IsChannel, "r", "user")}/{Name}/"
Case Sites.Twitter : URL = $"https://twitter.com/{Name}"
Case Sites.Instagram : URL = $"https://www.instagram.com/{Name}/"
Case Sites.RedGifs : URL = $"https://www.redgifs.com/users/{Name}/"
Case Else : MsgBoxE($"Site [{Site}] opening not implemented", MsgBoxStyle.Exclamation)
End Select
Dim URL$ = HOST.Source.GetUserUrl(Name, IsChannel)
If Not URL.IsEmptyString Then Process.Start(URL)
Catch ex As Exception
MsgBoxE($"Error on trying to open [{Site}] page of user [{Name}]", MsgBoxStyle.Critical)
If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowAllMsg)
MsgBoxE($"Error on trying to open [{Site}] page of user [{Name}]", MsgBoxStyle.Critical, e)
End Try
End Sub
Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder
MyFile.CutPath.Open(SFO.Path, EDP.None)
GlobalOpenPath(MyFile.CutPath)
End Sub
#End Region
#Region "Download functions and options"
Friend Overridable Property DownloadTopCount As Integer? = Nothing Implements IUserData.DownloadTopCount
Friend Overridable Property DownloadTopCount As Integer? = Nothing Implements IUserData.DownloadTopCount, IPluginContentProvider.PostsNumberLimit
Protected Responser As PersonalUtilities.Tools.WEB.Response
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
Dim Canceled As Boolean = False
_ExternalCompatibilityToken = Token
Try
UpdateDataFiles()
UserDescriptionReset()
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New PersonalUtilities.Tools.WEB.Response
Responser.Copy(Settings(Site).Responser)
If TypeOf HOST.Source Is IResponserContainer Then
With DirectCast(HOST.Source, IResponserContainer)
If Not .Responser Is Nothing Then Responser.Copy(.Responser)
End With
End If
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(False) Is Nothing
Dim sEnvir() As Boolean = {UserExists, UserSuspended}
Dim EnvirChanged As Func(Of Boolean) = Function() Not sEnvir(0) = UserExists Or Not sEnvir(1) = UserSuspended
UserExists = True
UserSuspended = False
_DownloadedPicturesSession = 0
_DownloadedVideosSession = 0
DownloadedPictures(False) = 0
DownloadedVideos(False) = 0
_TempMediaList.Clear()
_TempPostsList.Clear()
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
@@ -641,6 +741,7 @@ BlockNullPicture:
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
ThrowAny(Token)
DownloadDataF(Token)
ThrowAny(Token)
@@ -658,28 +759,25 @@ BlockNullPicture:
DownloadContent(Token)
ThrowIfDisposed()
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UStates.Downloaded), LNC)
_CountPictures = _ContentList.LongCount(Function(c) c.Type = UTypes.Picture)
_CountVideo = _ContentList.LongCount(Function(c) c.Type = UTypes.Video)
If DownloadedPictures + DownloadedVideos > 0 Or EnvirChanged.Invoke Then
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Then
If __SaveData Then
LastUpdated = Now
DownloadedPictures(True) = SFile.GetFiles(User.File.CutPath, "*.jpg|*.jpeg|*.png|*.gif|*.webm",, EDP.ReturnValue).Count
DownloadedVideos(True) = SFile.GetFiles(User.File.CutPath, "*.mp4|*.mkv|*.mov", SearchOption.AllDirectories, EDP.ReturnValue).Count
If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser)
UpdateContentInformation()
Else
_CountVideo = 0
_CountPictures = 0
DownloadedVideos(False) = 0
DownloadedPictures(False) = 0
_ContentList.Clear()
CreatedByChannel = False
End If
If Not UserExists Then ReadyForDownload = False
UpdateUserInformation()
If _CollectionButtonsExists AndAlso EnvirChanged.Invoke Then UpdateButtonsColor()
End If
ThrowIfDisposed()
If Not CreatedByChannel Then
_DownloadedPicturesTotal += _DownloadedPicturesSession
_DownloadedVideosTotal += _DownloadedVideosSession
End If
If UpPic Or EnvirChanged.Invoke Then Raise_OnUserUpdated()
If UpPic Or EnvirChanged.Invoke Then RaiseEvent_OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested
MyMainLOG = $"{Site} - {Name}: downloading canceled"
Canceled = True
@@ -752,17 +850,22 @@ BlockNullPicture:
End Select
End If
If __isVideo And vsf Then f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then
f.Path = $"{f.PathWithSeparator}{v.SpecialFolder}\".CSFileP.Path
f.Exists(SFO.Path)
End If
If __isVideo And vsf Then
f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
End If
w.DownloadFile(v.URL_BASE, f.ToString)
If __isVideo Then
v.Type = UTypes.Video
DownloadedVideos += 1
_CountVideo += 1
DownloadedVideos(False) += 1
Else
v.Type = UTypes.Picture
DownloadedPictures += 1
_CountPictures += 1
DownloadedPictures(False) += 1
End If
v.File = ChangeFileNameByProvider(f, v)
@@ -832,7 +935,7 @@ BlockNullPicture:
End Function
Friend Function DeleteF(ByVal Instance As IUserData) As Integer
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, False, False)) Then
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
ImageHandler(Me, False)
Settings.UsersList.Remove(User)
Settings.UpdateUsersList()
@@ -878,7 +981,7 @@ BlockNullPicture:
_TurnBack = False
Return False
End If
f.Delete(SFO.Path, False, False, EDP.ThrowException)
f.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException)
End If
f.CutPath.Exists(SFO.Path)
Directory.Move(UserBefore.File.CutPath(, EDP.ThrowException).Path, f.Path)
@@ -933,7 +1036,7 @@ BlockNullPicture:
FilesMover.Invoke
If SFile.GetFiles(UserBefore.File.CutPath,, SearchOption.AllDirectories,
New ErrorsDescriber(False, False, False, New List(Of SFile))).Count = 0 Then
UserBefore.File.CutPath.Delete(SFO.Path, False, False, EDP.SendInLog)
UserBefore.File.CutPath.Delete(SFO.Path, Settings.DeleteMode, EDP.SendInLog)
End If
UpdateUserInformation()
End If
@@ -963,33 +1066,42 @@ BlockNullPicture:
Protected Sub ThrowIfDisposed()
If Disposed Then Throw New ObjectDisposedException(ToString(), "Object disposed")
End Sub
''' <inheritdoc cref="ThrowAny(CancellationToken)"/>
Private Overloads Sub ThrowAny() Implements IThrower.ThrowAny
ThrowAny(_ExternalCompatibilityToken)
End Sub
''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception>
Protected Sub ThrowAny(ByVal Token As CancellationToken)
Friend Overloads Sub ThrowAny(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
ThrowIfDisposed()
End Sub
#End Region
Public Overrides Function ToString() As String
If Settings.ViewModeIsPicture Then
If IsCollection Then
Return CollectionName
Else
Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If
If IsCollection Then
Return CollectionName
Else
Dim t$ = String.Empty
If Temporary Then
t = " (T)"
ElseIf Favorite Then
t = " (F)"
End If
If IsCollection Then
Return $"Collection [{CollectionName}]{t}"
Else
Return $"[{Site}]{t} {IIf(FriendlyName.IsEmptyString, Name, FriendlyName)}"
End If
Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If
'If Settings.ViewModeIsPicture Then
' If IsCollection Then
' Return CollectionName
' Else
' Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
' End If
'Else
' Dim t$ = String.Empty
' If Temporary Then
' t = " (T)"
' ElseIf Favorite Then
' t = " (F)"
' End If
' If IsCollection Then
' Return $"Collection [{CollectionName}]{t}"
' Else
' Return $"[{Site}]{t} {IIf(FriendlyName.IsEmptyString, Name, FriendlyName)}"
' End If
'End If
End Function
#Region "Buttons actions"
Private Sub BTT_CONTEXT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click
@@ -1012,38 +1124,25 @@ BlockNullPicture:
#End Region
#Region "IComparable Support"
Friend Overridable Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
Dim x% = CompareValue(Me)
Dim y% = CompareValue(Other)
If x.CompareTo(y) = 0 Then
Return Name.CompareTo(Other.Name)
Else
Return x.CompareTo(y)
End If
End Function
Protected Function CompareValue(ByVal x As UserDataBase) As Integer
Dim OutValue% = CInt(x.Site) * 10000
If x.IsCollection Then OutValue -= 1000
If x.Temporary Then OutValue += 2000
If x.Favorite Then OutValue -= 500
Return OutValue
Return Name.CompareTo(Other.Name)
End Function
Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If TypeOf Obj Is Reddit.Channel Then
Return CompareTo(DirectCast(DirectCast(Obj, Reddit.Channel).Instance, UserDataBase))
Else
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then
Return CompareTo(DirectCast(Obj, UserDataBase))
Else
Return False
End If
End Function
#End Region
#Region "IEquatable Support"
Friend Overridable Overloads Function Equals(ByVal Other As UserDataBase) As Boolean Implements IEquatable(Of UserDataBase).Equals
Return Site = Other.Site And Name = Other.Name And IsSavedPosts = Other.IsSavedPosts
Return LVIKey = Other.LVIKey And IsSavedPosts = Other.IsSavedPosts
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
If TypeOf Obj Is Reddit.Channel Then
Return Equals(DirectCast(DirectCast(Obj, Reddit.Channel).Instance, UserDataBase))
Else
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then
Return Equals(DirectCast(Obj, UserDataBase))
Else
Return False
End If
End Function
#End Region
@@ -1067,7 +1166,7 @@ BlockNullPicture:
If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose()
If Not BTT_CONTEXT_OPEN_PATH Is Nothing Then BTT_CONTEXT_OPEN_PATH.Dispose()
If Not BTT_CONTEXT_OPEN_SITE Is Nothing Then BTT_CONTEXT_OPEN_SITE.Dispose()
If _InvokeImageHandler Then ImageHandler(Me, False)
_OnUserUpdatedHandlers.Clear()
End If
disposedValue = True
End If
@@ -1083,17 +1182,17 @@ BlockNullPicture:
#End Region
End Class
Friend Interface IContentProvider
Property Site As Sites
ReadOnly Property Site As String
Property Name As String
Property ID As String
Property FriendlyName As String
Property Description As String
Property Favorite As Boolean
Property Temporary As Boolean
Sub OpenSite()
Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
Sub DownloadData(ByVal Token As CancellationToken)
End Interface
Friend Interface IUserData : Inherits IContentProvider, IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IDisposable
Friend Interface IUserData : Inherits IContentProvider, IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IIndexable, IDisposable
Event OnUserUpdated(ByVal User As IUserData)
Property ParseUserMediaOnly As Boolean
#Region "Images"
@@ -1110,16 +1209,16 @@ BlockNullPicture:
Property Exists As Boolean
Property Suspended As Boolean
Property ReadyForDownload As Boolean
Property HOST As SettingsHost
Property [File] As SFile
Property FileExists As Boolean
Property DownloadedPictures As Integer
Property DownloadedVideos As Integer
Property DownloadedPictures(ByVal Total As Boolean) As Integer
Property DownloadedVideos(ByVal Total As Boolean) As Integer
ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
ReadOnly Property DownloadedInformation As String
Property HasError As Boolean
ReadOnly Property FitToAddParams As Boolean
ReadOnly Property LVIKey As String
ReadOnly Property LVIIndex As Integer
ReadOnly Property Key As String
Property DownloadImages As Boolean
Property DownloadVideos As Boolean
Function GetLVI(ByVal Destination As ListView) As ListViewItem
@@ -1137,6 +1236,8 @@ BlockNullPicture:
Sub OpenFolder()
ReadOnly Property Self As IUserData
Property DownloadTopCount As Integer?
Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True)
ReadOnly Property Disposed As Boolean
End Interface
Friend Interface IChannelLimits

35
SCrawler/API/Gfycat/Envir.vb Normal file
View File

@@ -0,0 +1,35 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Imports System.Net
Imports SCrawler.API.Base
Namespace API.Gfycat
Friend NotInheritable Class Envir
Private Sub New()
End Sub
Friend Shared Function GetVideo(ByVal URL As String) As String
Try
Dim r$
Using w As New WebClient : r = w.DownloadString(URL) : End Using
If Not r.IsEmptyString Then Return RegexReplace(r, RParams.DMS("contentUrl.:.(http.?://[^""]+?\.mp4)", 1)) Else Return String.Empty
Catch ex As Exception
Dim e As EDP = EDP.ReturnValue
If TypeOf ex Is WebException Then
Dim obj As HttpWebResponse = TryCast(DirectCast(ex, WebException).Response, HttpWebResponse)
If Not If(obj?.StatusCode, HttpStatusCode.OK) = HttpStatusCode.NotFound Then e += EDP.SendInLog
End If
Return ErrorsDescriber.Execute(e, ex, $"[API.Gfycat.Envir.GetVideo({URL})]", String.Empty)
End Try
End Function
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
Dim u$ = GetVideo(URL)
Return If(u.IsEmptyString, Nothing, {New UserMedia(u, UserMedia.Types.Video)})
End Function
End Class
End Namespace

36
SCrawler/API/Instagram/AuthNullException.vb Normal file
View File

@@ -0,0 +1,36 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports Sections = SCrawler.API.Instagram.UserData.Sections
Namespace API.Instagram
Friend Class AuthNullException : Inherits ArgumentNullException
Public Overrides ReadOnly Property ParamName As String
Public Overrides ReadOnly Property Message As String
Friend Sub New(ByVal s As Sections, ByVal IsSavedPosts As Boolean)
If IsSavedPosts Then
ParamName = "HashSavedPosts"
ElseIf s = Sections.Timeline Then
ParamName = "Hash"
Else
ParamName = "IG_APP_ID, IG_WWW_CLAIM"
End If
Message = $"Instagram auth for [{s}] is not set"
End Sub
Friend Shared Sub ThrowIfNull(ByVal s As Sections, ByVal IsSavedPosts As Boolean, ByVal Host As SiteSettings)
Dim b As Boolean = False
If IsSavedPosts Then
If Not ACheck(Host.HashSavedPosts.Value) Then b = True
ElseIf s = Sections.Timeline Then
If Not ACheck(Host.Hash.Value) Then Host.HashUpdateRequired.Value = True : b = True
Else
If Not Host.StoriesAndTaggedReady Then b = True
End If
If b Then Throw New AuthNullException(s, IsSavedPosts)
End Sub
End Class
End Namespace

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

@@ -9,6 +9,7 @@
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Instagram
Friend Module Declarations
Friend Const InstagramSite As String = "Instagram"
Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
Friend ReadOnly Property DateProvider As New JsonDate
Friend Class JsonDate : Implements ICustomProvider

23
SCrawler/API/Instagram/EditorExchangeOptions.vb Normal file
View File

@@ -0,0 +1,23 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Namespace API.Instagram
Friend Class EditorExchangeOptions
Friend Property GetStories As Boolean
Friend Property GetTagged As Boolean
Private ReadOnly Property MySiteSettings As SiteSettings
Friend Sub New(ByVal h As ISiteSettings)
MySiteSettings = DirectCast(h, SiteSettings)
With MySiteSettings
GetStories = CBool(.GetStories.Value)
GetTagged = CBool(.GetTagged.Value)
End With
End Sub
End Class
End Namespace

15
SCrawler/API/Instagram/ExitException.vb Normal file
View File

@@ -0,0 +1,15 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
Friend Class ExitException : Inherits Exception
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class
End Namespace

120
SCrawler/API/Instagram/OptionsForm.Designer.vb generated Normal file
View File

@@ -0,0 +1,120 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class OptionsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_GET_STORIES = New System.Windows.Forms.CheckBox()
Me.CH_GET_TAGGED = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(260, 53)
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(260, 78)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(Me.CH_GET_STORIES, 0, 0)
TP_MAIN.Controls.Add(Me.CH_GET_TAGGED, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(260, 53)
TP_MAIN.TabIndex = 0
'
'CH_GET_STORIES
'
Me.CH_GET_STORIES.AutoSize = True
Me.CH_GET_STORIES.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_STORIES.Location = New System.Drawing.Point(4, 4)
Me.CH_GET_STORIES.Name = "CH_GET_STORIES"
Me.CH_GET_STORIES.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_STORIES.TabIndex = 0
Me.CH_GET_STORIES.Text = "Get stories"
Me.CH_GET_STORIES.UseVisualStyleBackColor = True
'
'CH_GET_TAGGED
'
Me.CH_GET_TAGGED.AutoSize = True
Me.CH_GET_TAGGED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_TAGGED.Location = New System.Drawing.Point(4, 30)
Me.CH_GET_TAGGED.Name = "CH_GET_TAGGED"
Me.CH_GET_TAGGED.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_TAGGED.TabIndex = 1
Me.CH_GET_TAGGED.Text = "Get tagged data"
Me.CH_GET_TAGGED.UseVisualStyleBackColor = True
'
'OptionsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(260, 78)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(276, 117)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(276, 117)
Me.Name = "OptionsForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Options"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_GET_STORIES As CheckBox
Private WithEvents CH_GET_TAGGED As CheckBox
End Class
End Namespace

126
SCrawler/API/Instagram/OptionsForm.resx Normal file
View File

@@ -0,0 +1,126 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

44
SCrawler/API/Instagram/OptionsForm.vb Normal file
View File

@@ -0,0 +1,44 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Namespace API.Instagram
Friend Class OptionsForm : Implements IOkCancelToolbar
Private ReadOnly MyDefs As DefaultFormProps
Private ReadOnly Property MyExchangeOptions As EditorExchangeOptions
Friend Sub New(ByRef ExchangeOptions As EditorExchangeOptions)
InitializeComponent()
MyExchangeOptions = ExchangeOptions
MyDefs = New DefaultFormProps
End Sub
Private Sub OptionsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(Me, Settings.Design, True)
.AddOkCancelToolbar()
.DelegateClosingChecker()
.AppendDetectors()
With MyExchangeOptions
CH_GET_STORIES.Checked = .GetStories
CH_GET_TAGGED.Checked = .GetTagged
End With
.EndLoaderOperations()
End With
End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
With MyExchangeOptions
.GetStories = CH_GET_STORIES.Checked
.GetTagged = CH_GET_TAGGED.Checked
End With
MyDefs.CloseForm()
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
End Class
End Namespace

44
SCrawler/API/Instagram/ProfileSaved.vb
View File

@@ -1,44 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Namespace API.Instagram
Friend NotInheritable Class ProfileSaved
Friend Shared ReadOnly Property DataPath As SFile = Settings(Sites.Instagram).SavedPostsPath
Private Sub New()
End Sub
Friend Shared Sub Download(ByRef Bar As MyProgress, ByVal Token As CancellationToken)
Try
Dim u As New UserInfo(Settings(Sites.Instagram).SavedPostsUserName.Value, Sites.Instagram) With {.SpecialPath = DataPath}
u.UpdateUserFile()
Using user As New UserData(u,, False)
DirectCast(user.Self, UserDataBase).IsSavedPosts = True
user.Progress = Bar
If Not user.FileExists Then user.UpdateUserInformation()
If Settings(Sites.Instagram).InstagramLastDownloadDate.Value < Now.AddMinutes(60) Then
user.RequestsCount = Settings(Sites.Instagram).InstagramLastRequestsCount
End If
user.DownloadData(Token)
Bar.InformationTemporary = $"Images: {user.DownloadedPictures}; Videos: {user.DownloadedVideos}"
With Settings
.BeginUpdate()
With .Site(Sites.Instagram)
.InstagramLastDownloadDate.Value = Now
.InstagramLastRequestsCount.Value = user.RequestsCount
End With
.EndUpdate()
End With
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.Instagram.ProfileSaved.Download]")
End Try
End Sub
End Class
End Namespace

314
SCrawler/API/Instagram/SiteSettings.vb Normal file
View File

@@ -0,0 +1,314 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram
<Manifest("AndyProgram_Instagram"), UseClassAsIs, SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Interface Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.InstagramIcon
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.InstagramPic76
End Get
End Property
#End Region
#Region "Providers"
Private Class TimersChecker : Implements ICustomProvider
Private ReadOnly _LowestValue As Integer
Friend Sub New(ByVal LowestValue As Integer)
_LowestValue = LowestValue
End Sub
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If ACheck(Of Integer)(Value) AndAlso CInt(Value) >= _LowestValue Then
Return Value
Else
Return Nothing
End If
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
End Function
End Class
#End Region
#Region "Authorization properties"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property Hash As PropertyValue
<PropertyOption(ControlText:="Hash 2", ControlToolTip:="Instagram session hash for saved posts", IsAuth:=True), PXML("InstaHashSavedPosts"), ControlNumber(1)>
Friend ReadOnly Property HashSavedPosts As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True), ControlNumber(2)>
Friend Property IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True), ControlNumber(3)>
Friend Property IG_WWW_CLAIM As PropertyValue
<PropertyOption(ControlText:="Saved posts user", IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(4)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend ReadOnly Property StoriesAndTaggedReady As Boolean
Get
Return ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value)
End Get
End Property
#End Region
#Region "Download properties"
Friend ReadOnly Property HashUpdateRequired As XMLValue(Of Boolean)
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(5)>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False), PXML("RequestsWaitTimerTaskCount"), ControlNumber(6)>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(7)>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(8)>
Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(9)>
Friend ReadOnly Property GetTagged As PropertyValue
#End Region
#Region "429 bypass"
Friend ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
Friend Property LastApplyingValue As Integer? = Nothing
Friend ReadOnly Property ReadyForDownload As Boolean
Get
With DownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(LastApplyingValue, 10)) < Now
Else
Return True
End If
End With
End Get
End Property
Friend ReadOnly Property LastDownloadDate As XMLValue(Of Date)
Friend ReadOnly Property LastRequestsCount As XMLValue(Of Integer)
Private TooManyRequestsReadyForCatch As Boolean = True
Friend Function GetWaitDate() As Date
With DownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(LastApplyingValue, 10))
Else
Return Now
End If
End With
End Function
Friend Sub TooManyRequests(ByVal Catched As Boolean)
With DownloadingErrorDate
If Catched Then
If Not .ValueF.Exists Then
.Value = Now
If TooManyRequestsReadyForCatch Then
LastApplyingValue = If(LastApplyingValue, 0) + 10
TooManyRequestsReadyForCatch = False
MyMainLOG = $"Instagram downloading error: too many requests. Try again after {If(LastApplyingValue, 10)} minutes..."
End If
End If
Else
.ValueF = Nothing
LastApplyingValue = Nothing
TooManyRequestsReadyForCatch = True
End If
End With
End Sub
#End Region
Friend Overrides ReadOnly Property Responser As WEB.Response
Friend Sub New(ByRef _XML As XmlFile, ByVal GlobalPath As SFile)
MyBase.New(InstagramSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
Dim app_id$ = String.Empty
Dim www_claim$ = String.Empty
With Responser
If .File.Exists Then
.LoadSettings()
With .Headers
If .ContainsKey(Header_IG_APP_ID) Then app_id = .Item(Header_IG_APP_ID)
If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM)
End With
Else
.CookiesDomain = "instagram.com"
.SaveSettings()
End If
End With
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
HashUpdateRequired = New XMLValue(Of Boolean)("InstaHashUpdateRequired", True, _XML, n)
Hash = New PropertyValue(String.Empty, GetType(String))
HashSavedPosts = New PropertyValue(String.Empty, GetType(String))
IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_APP_ID), v))
IG_WWW_CLAIM = New PropertyValue(www_claim, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v))
RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100)
RequestsWaitTimerTaskCount = New PropertyValue(1)
RequestsWaitTimerTaskCountProvider = New TimersChecker(1)
SleepTimerOnPostsLimit = New PropertyValue(6000)
SleepTimerOnPostsLimitProvider = New TimersChecker(10000)
GetStories = New PropertyValue(False)
GetTagged = New PropertyValue(False)
DownloadingErrorDate = New XMLValue(Of Date) With {
.Provider = New XMLValueConversionProvider(Function(ss, vv) AConvert(Of String)(vv, AModes.Var, Nothing))}
DownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n)
LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n)
LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n)
UrlPatternUser = "https://www.instagram.com/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
ImageVideoContains = "instagram.com"
End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
Case Download.Main : Return New UserData
Case Download.SavedPosts
Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
Return u
End Select
Return Nothing
End Function
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
Case NameOf(IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
End Select
If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
End Sub
<PropertiesDataChecker({NameOf(Hash), NameOf(HashSavedPosts)})>
Private Function CheckHashControls(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists(2) Then
Dim h$ = String.Empty
Dim hsp$ = String.Empty
For Each pp As PropertyData In p
Select Case pp.Name
Case NameOf(Hash) : h = AConvert(Of String)(pp.Value, String.Empty)
Case NameOf(HashSavedPosts) : hsp = AConvert(Of String)(pp.Value, String.Empty)
End Select
Next
If h.IsEmptyString And hsp.IsEmptyString Then
Return True
Else
If h = hsp Then
MsgBoxE({"InstaHash for saved posts must be different from InstaHash!", "InstaHash are equal"}, vbCritical)
Return False
Else
Return True
End If
End If
Else
Return False
End If
End Function
Friend Overrides Sub BeginInit()
End Sub
Friend Overrides Sub EndInit()
If (CStr(Hash.Value).IsEmptyString Or HashUpdateRequired) AndAlso Responser.Cookies.ListExists Then GatherInstaHash()
End Sub
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
Return ActiveJobs < 2 AndAlso ReadyForDownload
End Function
#Region "Downloading"
Private ActiveJobs As Integer = 0
Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Friend Overrides Sub DownloadStarted(ByVal What As Download)
If CStr(Hash.Value).IsEmptyString Or HashUpdateRequired Then GatherInstaHash()
ActiveJobs += 1
End Sub
Friend Overrides Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download)
With DirectCast(User, UserData)
If What = Download.Main Then .WaitNotificationMode = _NextWNM
If LastDownloadDate.Value.AddMinutes(60) > Now Then
.RequestsCount = LastRequestsCount
Else
LastRequestsCount.Value = 0
.RequestsCount = 0
End If
End With
End Sub
Friend Overrides Sub AfterDownload(ByVal User As Object, ByVal What As Download)
With DirectCast(User, UserData)
_NextWNM = .WaitNotificationMode
If _NextWNM = UserData.WNM.SkipTemp Or _NextWNM = UserData.WNM.SkipCurrent Then _NextWNM = UserData.WNM.Notify
LastRequestsCount.Value = .RequestsCount
End With
End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download)
_NextWNM = UserData.WNM.Notify
LastDownloadDate.Value = Now
ActiveJobs -= 1
If HashUpdateRequired Then MyMainLOG = "Check your Instagram credentials"
End Sub
#End Region
<PropertyUpdater(NameOf(Hash))>
Friend Function GatherInstaHash() As Boolean
Try
If Not Responser.Cookies.ListExists Then Throw New Exception("Instagram cookies does not set")
Dim rs As New RParams("=""([^""]+?ConsumerLibCommons[^""]+?.js)""", Nothing, 1) With {.MatchTimeOut = 10}
Dim r$ = Responser.GetResponse("https://instagram.com",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim hStr$ = RegexReplace(r, rs)
If Not hStr.IsEmptyString Then
Do While Left(hStr, 1) = "/" : hStr = Right(hStr, hStr.Length - 1) : Loop
hStr = $"https://instagram.com/{hStr}"
r = Responser.GetResponse(hStr,, EDP.ThrowException)
If Not r.IsEmptyString Then
rs = New RParams("generatePaginationActionCreators.+?.profilePosts.byUserId.get.+?queryId:.([\d\w\S]+?)""", Nothing, 1) With {.MatchTimeOut = 10}
Dim h$ = RegexReplace(r, rs)
If Not h.IsEmptyString Then
Hash.Value = h
HashUpdateRequired.Value = False
Return True
End If
End If
End If
End If
Return False
Catch ex As Exception
HashUpdateRequired.Value = True
Hash.Value = String.Empty
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[SiteSettings.GaterInstaHash]", False)
End Try
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser)
End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
If OpenForm Then
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
End Class
End Namespace

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

@@ -9,8 +9,8 @@
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.Base
Imports System.Threading
Imports System.Net
@@ -20,60 +20,83 @@ Namespace API.Instagram
Private Const MaxPostsCount As Integer = 200
Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Friend Overrides Property Site As Sites = Sites.Instagram
Friend Overrides Property Progress As MyProgress
Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked"
Private ReadOnly Property MySiteSettings As SiteSettings
Get
If Not _Progress Is Nothing Then Return _Progress Else Return MainProgressInst
Return DirectCast(HOST.Source, SiteSettings)
End Get
Set(ByVal p As MyProgress)
_Progress = p
End Set
End Property
Private ReadOnly _SavedPostsIDs As New List(Of String)
Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = True
''' <summary>Video downloader initializer</summary>
Private Sub New()
Private FirstLoadingDone As Boolean = False
Friend Property GetStories As Boolean
Friend Property GetTaggedData As Boolean
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(HOST.Source) With {.GetStories = GetStories, .GetTagged = GetTaggedData}
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
GetStories = .GetStories
GetTaggedData = .GetTagged
End With
End If
End Sub
''' <summary>Default initializer</summary>
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True, Optional ByVal InvokeImageHandler As Boolean = True)
MyBase.New(InvokeImageHandler)
User = u
If _LoadUserInformation Then LoadUserInformation()
Friend Sub New()
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
LastCursor = Container.Value(Name_LastCursor)
FirstLoadingDone = Container.Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetStories = Container.Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetTaggedData = Container.Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = Container.Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
Else
Container.Add(Name_LastCursor, LastCursor)
Container.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
Container.Add(Name_GetStories, GetStories.BoolToInteger)
Container.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
End If
End Sub
#Region "Download data"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
_InstaHash = String.Empty
HasError = False
If Not LastCursor.IsEmptyString Then
DownloadData(LastCursor, Token)
DownloadData(LastCursor, Sections.Timeline, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If Not HasError Then
DownloadData(String.Empty, Token)
DownloadData(String.Empty, Sections.Timeline, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then DownloadPosts(Token)
If IsSavedPosts Then
DownloadPosts(Token)
ElseIf MySiteSettings.StoriesAndTaggedReady Then
If GetStories Then DownloadData(String.Empty, Sections.Stories, Token)
If GetTaggedData Then DownloadData(String.Empty, Sections.Tagged, Token)
End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException
Catch ex As Exception
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF", False)
End Try
End Sub
Private _InstaHash As String = String.Empty
Friend Enum Sections
Timeline
Tagged
Stories
End Enum
#Region "429 bypass"
Friend RequestsCount As Integer = 0
Friend Property RequestsCount As Integer = 0
Friend Enum WNM As Integer
Notify = 0
SkipCurrent = 1
@@ -85,11 +108,11 @@ Namespace API.Instagram
Private ProgressTempSet As Boolean = False
Private Const InstAborted As String = "InstAborted"
Private Function Ready() As Boolean
With Settings(Sites.Instagram)
If Not .InstagramReadyForDownload Then
With MySiteSettings
If Not .ReadyForDownload Then
If WaitNotificationMode = WNM.Notify Then
Dim m As New MMessage("Instagram [too many requests] error." & vbCr &
$"The program suggests waiting {If(Settings(Sites.Instagram).InstagramLastApplyingValue, 0)} minutes." & vbCr &
$"The program suggests waiting {If(.LastApplyingValue, 0)} minutes." & vbCr &
"What do you want to do?", "Waiting for Instagram download...",
{
New MsgBoxButton("Wait") With {.ToolTip = "Wait and ask again when the error is found."},
@@ -105,7 +128,7 @@ Namespace API.Instagram
Case Else : WaitNotificationMode = WNM.SkipTemp
End Select
End If
If Not ProgressTempSet Then Progress.InformationTemporary = $"Waiting until {Settings(Sites.Instagram).GetInstaWaitDate().ToString(ParsersDataDateProvider)}"
If Not ProgressTempSet Then Progress.InformationTemporary = $"Waiting until { .GetWaitDate().ToString(ParsersDataDateProvider)}"
ProgressTempSet = True
Return False
Else
@@ -115,22 +138,28 @@ Namespace API.Instagram
End Function
Private Sub ReconfigureAwaiter()
If WaitNotificationMode = WNM.SkipTemp Then WaitNotificationMode = WNM.Notify
If Caught429 Then Caught429 = False : RequestsCount = 0
If Caught429 Then Caught429 = False ': RequestsCount = 0
ProgressTempSet = False
End Sub
Private Sub NextRequest(ByVal StartWait As Boolean)
With Settings(Sites.Instagram)
If StartWait And (RequestsCount Mod .RequestsWaitTimerTaskCount.Value) = 0 Then Thread.Sleep(.RequestsWaitTimer)
If RequestsCount >= MaxPostsCount - 5 Then Thread.Sleep(.SleepTimerOnPostsLimit)
With MySiteSettings
If StartWait And RequestsCount > 0 And (RequestsCount Mod .RequestsWaitTimerTaskCount.Value) = 0 Then Thread.Sleep(CInt(.RequestsWaitTimer.Value))
If RequestsCount >= MaxPostsCount - 5 Then Thread.Sleep(CInt(.SleepTimerOnPostsLimit.Value))
End With
End Sub
#End Region
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
Private TaggedChecked As Boolean = False
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Section As Sections, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim StoriesList As List(Of String) = Nothing
Dim StoriesRequested As Boolean = False
Dim _DownloadComplete As Boolean = False
LastCursor = Cursor
Try
Do While Not _DownloadComplete
ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
@@ -138,73 +167,131 @@ Namespace API.Instagram
Dim n As EContainer, nn As EContainer, node As EContainer
Dim HasNextPage As Boolean = False
Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TaggedCount%
Dim ENode() As Object = Nothing
NextRequest(True)
'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _
_InstaHash = If(IsSavedPosts, Settings(Sites.Instagram).InstaHash_SP, Settings(Sites.Instagram).InstaHash).Value
If _InstaHash.IsEmptyString Then Throw New ArgumentNullException(IIf(IsSavedPosts, "InstaHashSavedPosts", "InstaHash"), "Query hash is null")
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value)
AuthNullException.ThrowIfNull(Section, IsSavedPosts, MySiteSettings)
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
'Create query
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={_InstaHash}&variables={vars}"
Select Case Section
Case Sections.Timeline
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={_InstaHash}&variables={vars}"
ENode = {"data", "user", 0}
Case Sections.Tagged
URL = $"https://i.instagram.com/api/v1/usertags/{ID}/feed/?count=50&max_id={Cursor}"
ENode = {"items"}
SpecFolder = TaggedFolder
Case Sections.Stories
If Not StoriesRequested Then
StoriesList = GetStoriesList()
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
ThrowAny(Token)
End If
If StoriesList.ListExists Then
GetStoriesData(StoriesList, Token)
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
End If
If StoriesList.ListExists Then
Continue Do
Else
Throw New ExitException(_DownloadComplete)
End If
End Select
'Get response
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Settings(Sites.Instagram).InstagramTooManyRequests(False)
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
ThrowAny(Token)
'Data
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
n = j.ItemF({"data", "user", 0}).XmlIfNothing
n = j.ItemF(ENode).XmlIfNothing
If n.Count > 0 Then
If n.Contains("page_info") Then
With n("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
End If
n = n("edges").XmlIfNothing
If n.Count > 0 Then
For Each nn In n
ThrowAny(Token)
node = nn(0).XmlIfNothing
If IsSavedPosts Then
PostID = node.Value("shortcode")
If Not PostID.IsEmptyString Then
If _TempPostsList.Contains(PostID) Then Exit Sub Else _SavedPostsIDs.Add(PostID)
End If
Else
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Exit Sub
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
ObtainMedia(node, PostID, PostDate)
Select Case Section
Case Sections.Timeline
If n.Contains("page_info") Then
With n("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
End If
Next
End If
n = n("edges").XmlIfNothing
If n.Count > 0 Then
For Each nn In n
ThrowAny(Token)
node = nn(0).XmlIfNothing
If IsSavedPosts Then
PostID = node.Value("shortcode")
If Not PostID.IsEmptyString Then
If _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) Else _SavedPostsIDs.Add(PostID)
End If
Else
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
ObtainMedia(node, PostID, PostDate, SpecFolder)
End If
Next
End If
Case Sections.Tagged
HasNextPage = j.Value("more_available").FromXML(Of Boolean)(False)
EndCursor = j.Value("next_max_id")
For Each nn In n
PostID = $"Tagged_{nn.Value("id")}"
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
ObtainMedia2(nn, PostID, SpecFolder)
Next
If Not TaggedChecked Then
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0)
TaggedChecked = True
If TaggedChecked > 200 Then
Dim a% = MsgBoxE({$"The number of tagged posts is {TaggedCount.NumToString(New ANumbers With {
.FormatOptions = ANumbers.Options.GroupIntegral})}" & vbCr &
"The tagged data download operation can take a long time.", "Too much tagged data"}, vbExclamation,,,
{"Continue",
New MsgBoxButton("Disable and cancel") With {
.ToolTip = "Disable downloading tagged data and cancel downloading tagged data."},
"Cancel"})
If a > 0 Then
If a = 1 Then GetTaggedData = False
Throw New ExitException(_DownloadComplete)
End If
End If
End If
End Select
Else
If j.Value("status") = "ok" AndAlso j({"data", "user"}).XmlIfNothing.Count = 0 AndAlso _TempMediaList.Count = 0 Then
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
MySiteSettings.HashUpdateRequired.Value = True
UserExists = False
_DownloadComplete = True
Exit Sub
Throw New ExitException(_DownloadComplete)
End If
End If
End Using
Else
_DownloadComplete = True
Exit Sub
Throw New ExitException(_DownloadComplete)
End If
_DownloadComplete = True
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Token)
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token)
Catch iane As AuthNullException
ErrorsDescriber.Execute(EDP.SendInLog, iane)
Throw New ExitException(_DownloadComplete)
Catch eex As ExitException
Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
@@ -213,6 +300,8 @@ Namespace API.Instagram
If DownloadingException(ex, $"data downloading error [{URL}]") = 1 Then Continue Do Else Exit Do
End Try
Loop
Catch eex2 As ExitException
If (Section = Sections.Timeline Or Section = Sections.Tagged) And Not Cursor.IsEmptyString Then Throw eex2
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception
@@ -225,6 +314,7 @@ Namespace API.Instagram
Dim _Index% = 0
Try
Do While Not _DownloadComplete
ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
@@ -238,10 +328,10 @@ Namespace API.Instagram
_Index = i
URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1"
ThrowAny(Token)
NextRequest((i + 1 Mod 5) = 0)
NextRequest(((i + 1) Mod 5) = 0)
ThrowAny(Token)
r = Responser.GetResponse(URL,, e)
Settings(Sites.Instagram).InstagramTooManyRequests(False)
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
@@ -249,7 +339,7 @@ Namespace API.Instagram
_MediaObtained = False
If j.Contains({"graphql", "shortcode_media"}) Then
With j({"graphql", "shortcode_media"}).XmlIfNothing
If .Count > 0 Then ObtainMedia(.Self, _SavedPostsIDs(i), String.Empty) : _MediaObtained = True
If .Count > 0 Then ObtainMedia(.Self, _SavedPostsIDs(i), String.Empty, String.Empty) : _MediaObtained = True
End With
End If
If Not _MediaObtained AndAlso j.Contains("items") Then
@@ -263,8 +353,8 @@ Namespace API.Instagram
End If
End If
Next
_DownloadComplete = True
End If
_DownloadComplete = True
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
@@ -279,7 +369,9 @@ Namespace API.Instagram
ProcessException(DoEx, Token, $"downloading saved posts error [{URL}]")
End Try
End Sub
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String)
#End Region
#Region "Obtain Media"
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String, ByVal SpecFolder As String)
Dim CreateMedia As Action(Of EContainer) =
Sub(ByVal e As EContainer)
Dim t As UTypes = If(e.Value("is_video").FromXML(Of Boolean)(False), UTypes.Video, UTypes.Picture)
@@ -289,7 +381,7 @@ Namespace API.Instagram
Else
tmpValue = e.Value("video_url")
End If
If Not tmpValue.IsEmptyString Then _TempMediaList.ListAddValue(MediaFromData(t, tmpValue, PostID, PostDate), LNC)
If Not tmpValue.IsEmptyString Then _TempMediaList.ListAddValue(MediaFromData(t, tmpValue, PostID, PostDate, SpecFolder), LNC)
End Sub
If node.Contains({"edge_sidecar_to_children", "edges"}) Then
For Each edge As EContainer In node({"edge_sidecar_to_children", "edges"}) : CreateMedia(edge("node").XmlIfNothing) : Next
@@ -297,7 +389,7 @@ Namespace API.Instagram
CreateMedia(node)
End If
End Sub
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String)
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing)
Try
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
@@ -322,7 +414,7 @@ Namespace API.Instagram
l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, Nothing), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, Nothing, SpecialFolder), LNC)
l.Clear()
End If
End If
@@ -337,7 +429,7 @@ Namespace API.Instagram
l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, Nothing), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, Nothing, SpecialFolder), LNC)
l.Clear()
End If
End If
@@ -346,7 +438,7 @@ Namespace API.Instagram
Case 8
With n("carousel_media").XmlIfNothing
If .Count > 0 Then
For Each d In .Self : ObtainMedia2(d, PostID) : Next
For Each d In .Self : ObtainMedia2(d, PostID, SpecialFolder) : Next
End If
End With
End Select
@@ -354,9 +446,10 @@ Namespace API.Instagram
l.Clear()
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "API.Instagram.GetGallery")
ErrorsDescriber.Execute(EDP.SendInLog, ex, "API.Instagram.ObtainMedia2")
End Try
End Sub
#End Region
Private Sub GetUserId()
Try
Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, EDP.ThrowException)
@@ -373,6 +466,59 @@ Namespace API.Instagram
End If
End Try
End Sub
#Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
Dim tmpList As IEnumerable(Of String)
Dim qStr$, r$, sFolder$, storyID$
Dim i% = -1
Dim jj As EContainer, s As EContainer
ThrowAny(Token)
If StoriesList.ListExists Then
tmpList = StoriesList.Take(5)
If tmpList.ListExists Then
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString(, "&"))
r = Responser.GetResponse(qStr,, EDP.ThrowException)
ThrowAny(Token)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("reels") Then
For Each jj In j("reels")
i += 1
sFolder = jj.Value("title")
storyID = jj.Value("id").Replace("highlight:", String.Empty)
If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}"
If sFolder.IsEmptyString Then sFolder = $"Story_{i}"
sFolder = $"{StoriesFolder}\{sFolder}"
If Not storyID.IsEmptyString Then storyID &= ":"
With jj("items").XmlIfNothing
If .Count > 0 Then
For Each s In .Self : ThrowAny(Token) : ObtainMedia2(s, storyID & s.Value("id"), sFolder) : Next
End If
End With
Next
End If
End Using
End If
StoriesList.RemoveRange(0, tmpList.Count)
End If
End If
End Sub
Private Function GetStoriesList() As List(Of String)
Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing()("tray").XmlIfNothing
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing
End Using
End If
Return Nothing
Catch ex As Exception
DownloadingException(ex, "API.Instagram.GetStoriesList")
Return Nothing
End Try
End Function
#End Region
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
@@ -388,38 +534,40 @@ Namespace API.Instagram
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
HasError = True
MyMainLOG = "Instagram credentials have expired"
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
MySiteSettings.HashUpdateRequired.Value = True
ElseIf Responser.StatusCode = 429 Then
With Settings(Sites.Instagram)
Dim WaiterExists As Boolean = .InstagramLastApplyingValue.HasValue
.InstagramTooManyRequests(True)
If Not WaiterExists Then .InstagramLastApplyingValue = 2
With MySiteSettings
Dim WaiterExists As Boolean = .LastApplyingValue.HasValue
.TooManyRequests(True)
If Not WaiterExists Then .LastApplyingValue = 2
End With
Caught429 = True
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
Else
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
MySiteSettings.HashUpdateRequired.Value = True
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
Return 2
End Function
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String) As UserMedia
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateProvider, Nothing) Else m.Post.Date = Nothing
m.SpecialFolder = SpecialFolder
Return m
End Function
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.Contains("instagram.com") Then
Dim PID$ = RegexReplace(URL, RParams.DMS(".*?instagram.com/p/([_\w\d]+)", 1))
If Not PID.IsEmptyString Then
Using t As New UserData
t.Responser = New PersonalUtilities.Tools.WEB.Response
t.Responser.Copy(Settings(Sites.Instagram).Responser)
t.Responser = New Response
t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID)
t.DownloadPosts(Nothing)
Return ListAddList(Nothing, t._TempMediaList)

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

@@ -10,264 +10,24 @@ Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.XML
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Hosts
Imports System.Threading
Namespace API.Reddit
Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel),
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IUserData, IDisposable
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IDisposable
#Region "XML Nodes' Names"
Private Const Name_Name As String = "Name"
Private Const Name_ID As String = "ID"
Private Const Name_Date As String = "Date"
Private Const Name_PostsNode As String = "Posts"
Private Const Name_UsersAdded As String = "UsersAdded"
Private Const Name_UsersExistent As String = "UsersExistent"
Private Const Name_PostsDownloaded As String = "PostsDownloaded"
#End Region
Friend Const DefaultDownloadLimitCount As Integer = 1000
#Region "IUserData Support"
Private Event OnUserUpdated As IUserData.OnUserUpdatedEventHandler Implements IUserData.OnUserUpdated
Friend Property Instance As IUserData
Private Property IUserData_ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly
Private Property IUserData_Exists As Boolean Implements IUserData.Exists
Get
Return Instance.Exists
End Get
Set(ByVal e As Boolean)
End Set
End Property
Private Property IUserData_Suspended As Boolean Implements IUserData.Suspended
Get
Return Instance.Suspended
End Get
Set(ByVal s As Boolean)
End Set
End Property
Private ReadOnly Property IUserData_IsCollection As Boolean Implements IUserData.IsCollection
Get
Return Instance.IsCollection
End Get
End Property
Private Property IUserData_CollectionName As String Implements IUserData.CollectionName
Get
Return Instance.CollectionName
End Get
Set(ByVal NewName As String)
Instance.CollectionName = NewName
End Set
End Property
Private ReadOnly Property IUserData_IncludedInCollection As Boolean Implements IUserData.IncludedInCollection
Get
Return Instance.IncludedInCollection
End Get
End Property
Private ReadOnly Property IUserData_Labels As List(Of String) Implements IUserData.Labels
Get
Return Instance.Labels
End Get
End Property
Private ReadOnly Property IUserData_IsChannel As Boolean = True Implements IUserData.IsChannel
Private Property IUserData_ReadyForDownload As Boolean Implements IUserData.ReadyForDownload
Get
Return Instance.ReadyForDownload
End Get
Set(ByVal IsReady As Boolean)
Instance.ReadyForDownload = IsReady
End Set
End Property
Private Property IUserData_File As SFile Implements IUserData.File
Get
Return Instance.File
End Get
Set(ByVal NewFile As SFile)
Instance.File = NewFile
End Set
End Property
Private Property IUserData_FileExists As Boolean Implements IUserData.FileExists
Get
Return Instance.FileExists
End Get
Set(ByVal IsExists As Boolean)
Instance.FileExists = IsExists
End Set
End Property
Private Property IUserData_DownloadedPictures As Integer Implements IUserData.DownloadedPictures
Get
Return Instance.DownloadedPictures
End Get
Set(ByVal c As Integer)
Instance.DownloadedPictures = c
End Set
End Property
Private Property IUserData_DownloadedVideos As Integer Implements IUserData.DownloadedVideos
Get
Return Instance.DownloadedVideos
End Get
Set(ByVal c As Integer)
Instance.DownloadedVideos = c
End Set
End Property
Private ReadOnly Property IUserData_DownloadedTotal(Optional Total As Boolean = True) As Integer Implements IUserData.DownloadedTotal
Get
Return Instance.DownloadedTotal
End Get
End Property
Private ReadOnly Property IUserData_DownloadedInformation As String Implements IUserData.DownloadedInformation
Get
Return Instance.DownloadedInformation
End Get
End Property
Private Property IUserData_HasError As Boolean Implements IUserData.HasError
Get
Return Instance.HasError
End Get
Set(ByVal e As Boolean)
Instance.HasError = e
End Set
End Property
Private ReadOnly Property IUserData_FitToAddParams As Boolean Implements IUserData.FitToAddParams
Get
Return Instance.FitToAddParams
End Get
End Property
Private ReadOnly Property IUserData_LVIKey As String Implements IUserData.LVIKey
Get
Return Instance.LVIKey
End Get
End Property
Private ReadOnly Property IUserData_LVIIndex As Integer Implements IUserData.LVIIndex
Get
Return Instance.LVIIndex
End Get
End Property
Private Property IUserData_DownloadImages As Boolean Implements IUserData.DownloadImages
Get
Return Instance.DownloadImages
End Get
Set(ByVal d As Boolean)
Instance.DownloadImages = d
End Set
End Property
Private Property IUserData_DownloadVideos As Boolean Implements IUserData.DownloadVideos
Get
Return Instance.DownloadVideos
End Get
Set(ByVal d As Boolean)
Instance.DownloadVideos = d
End Set
End Property
Private ReadOnly Property IUserData_Self As IUserData Implements IUserData.Self
Get
Return Instance
End Get
End Property
Private Property IUserData_DownloadTopCount As Integer? Implements IUserData.DownloadTopCount
Get
Return Instance.DownloadTopCount
End Get
Set(ByVal c As Integer?)
Instance.DownloadTopCount = c
End Set
End Property
Friend Property Site As Sites = Sites.Reddit Implements IContentProvider.Site
Private Property IUserData_FriendlyName As String Implements IContentProvider.FriendlyName
Get
Return Instance.FriendlyName
End Get
Set(ByVal NewName As String)
Instance.FriendlyName = NewName
End Set
End Property
Private Property IUserData_Description As String Implements IContentProvider.Description
Get
Return Instance.Description
End Get
Set(ByVal d As String)
Instance.Description = d
End Set
End Property
Private Property IUserData_Favorite As Boolean Implements IContentProvider.Favorite
Get
Return Instance.Favorite
End Get
Set(ByVal f As Boolean)
Instance.Favorite = f
End Set
End Property
Private Property IUserData_Temporary As Boolean Implements IContentProvider.Temporary
Get
Return Instance.Temporary
End Get
Set(ByVal t As Boolean)
Instance.Temporary = t
End Set
End Property
Private Sub IUserData_SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Instance.SetPicture(f)
End Sub
Private Sub IUserData_LoadUserInformation() Implements IUserData.LoadUserInformation
Instance.LoadUserInformation()
End Sub
Private Sub IUserData_UpdateUserInformation() Implements IUserData.UpdateUserInformation
Instance.UpdateUserInformation()
End Sub
Private Sub IUserData_OpenFolder() Implements IUserData.OpenFolder
Instance.OpenFolder()
End Sub
Private Sub IUserData_OpenSite() Implements IContentProvider.OpenSite
Instance.OpenSite()
End Sub
Private Sub IUserData_DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
DownloadData(Token, False, Nothing)
End Sub
Private Function IUserData_GetPicture() As Image Implements IUserData.GetPicture
Return Instance.GetPicture()
End Function
Private Function IUserData_GetLVI(ByVal Destination As ListView) As ListViewItem Implements IUserData.GetLVI
Return Instance.GetLVI(Destination)
End Function
Private Function IUserData_GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Implements IUserData.GetLVIGroup
Return Instance.GetLVIGroup(Destination)
End Function
Private Function IUserData_Delete() As Integer Implements IUserData.Delete
Return DirectCast(Instance, UserDataBase).DeleteF(Me)
End Function
Private Function IUserData_MoveFiles(ByVal CollectionName As String) As Boolean Implements IUserData.MoveFiles
Return DirectCast(Instance, UserDataBase).MoveFilesF(Me, CollectionName)
End Function
#End Region
Private _Name As String = String.Empty
Friend Property Name As String Implements IUserData.Name
Get
If IsRegularChannel Then
Return Instance.Name
Else
Return _Name
End If
End Get
Set(ByVal NewName As String)
If IsRegularChannel Then
Instance.Name = NewName
Else
_Name = NewName
End If
End Set
End Property
Private _ID As String = String.Empty
Friend Property ID As String Implements IUserData.ID
Get
If IsRegularChannel Then
Return Instance.ID
Else
Return _ID
End If
End Get
Set(ByVal NewID As String)
If IsRegularChannel Then
Instance.ID = NewID
Else
_ID = NewID
End If
End Set
End Property
Friend ReadOnly Property Site As String = RedditSite
Friend Property Name As String
Friend Property ID As String
Friend ReadOnly Property CUser As UserInfo
Get
Return New UserInfo(Me)
@@ -313,17 +73,30 @@ Namespace API.Reddit
End Get
End Property
Private ReadOnly Property Range As RangeSwitcher(Of UserPost)
Friend ReadOnly Property CountOfAddedUsers As List(Of Integer)
Friend ReadOnly Property CountOfLoadedPostsPerSession As List(Of Integer)
#Region "Statistics support"
Private ReadOnly CountOfAddedUsers As List(Of Integer)
Private ReadOnly CountOfLoadedPostsPerSession As List(Of Integer)
Friend ReadOnly Property ChannelExistentUserNames As List(Of String)
Private _FirstUserAdded As Boolean = False
Friend Sub UserAdded(Optional ByVal IsAdded As Boolean = True)
Friend Sub UserAdded(ByVal UserName As String, Optional ByVal IsAdded As Boolean = True)
If Not _FirstUserAdded Then CountOfAddedUsers.Add(0) : _FirstUserAdded = True
Dim v% = CountOfAddedUsers.Last
v += IIf(IsAdded, 1, -1)
If v < 0 Then v = 0
CountOfAddedUsers(CountOfAddedUsers.Count - 1) = v
If Not ChannelExistentUserNames.Contains(UserName) Then ChannelExistentUserNames.Add(UserName)
End Sub
Friend Sub UpdateUsersStats()
If Posts.Count > 0 Or PostsLatest.Count > 0 Then
ChannelExistentUserNames.ListAddList((From p As UserPost In PostsAll
Where Not p.UserID.IsEmptyString AndAlso
Settings.UsersList.Exists(Function(u) u.Site = Site And u.Name = p.UserID)
Select p.UserID), LAP.NotContainsOnly)
ChannelExistentUserNames.RemoveAll(Function(u) Not Settings.UsersList.Exists(Function(uu) uu.Site = Site And uu.Name = u))
End If
End Sub
Friend Function GetChannelStats(ByVal Extended As Boolean) As String
UpdateUsersStats()
Dim s$ = String.Empty
Dim p As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
If Extended Then
@@ -332,12 +105,15 @@ Namespace API.Reddit
s.StringAppendLine($"Users added from this channel (session): {CountOfAddedUsers.LastOrDefault.NumToString(p)}")
s.StringAppendLine($"Posts downloaded (avg): {CountOfLoadedPostsPerSession.DefaultIfEmpty(0).Average.RoundUp.NumToString(p)}")
s.StringAppendLine($"Posts downloaded (session): {CountOfLoadedPostsPerSession.LastOrDefault.NumToString(p)}")
s.StringAppendLine($"My users in this channel: {ChannelExistentUserNames.Count.NumToString(p)}")
Else
s.StringAppend($"Users: {CountOfAddedUsers.Sum.NumToString(p)} (avg: {CountOfAddedUsers.DefaultIfEmpty(0).Average.RoundDown.NumToString(p)}; s: {CountOfAddedUsers.LastOrDefault.NumToString(p)})")
s.StringAppend($"Posts: {CountOfLoadedPostsPerSession.DefaultIfEmpty(0).Average.RoundUp.NumToString(p)} (s: {CountOfLoadedPostsPerSession.LastOrDefault.NumToString(p)})", "; ")
s.StringAppend($"My users: {ChannelExistentUserNames.Count.NumToString(p)}", "; ")
End If
Return s
End Function
#End Region
#Region "Limits Support"
Private _DownloadLimitCount As Integer? = Nothing
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
@@ -401,31 +177,23 @@ Namespace API.Reddit
End Sub
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
#End Region
Friend ReadOnly IsRegularChannel As Boolean = False
Friend ReadOnly Property HOST As SettingsHost
Friend Sub New()
Posts = New List(Of UserPost)
PostsLatest = New List(Of UserPost)
Range = New RangeSwitcher(Of UserPost)(Me)
CountOfAddedUsers = New List(Of Integer)
CountOfLoadedPostsPerSession = New List(Of Integer)
ChannelExistentUserNames = New List(Of String)
HOST = Settings(RedditSiteKey)
End Sub
Friend Sub New(ByVal f As SFile)
Me.New
LoadData(f, False)
End Sub
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
Me.New
Instance = New UserData(u, _LoadUserInformation) With {.SaveToCache = False, .SkipExistsUsers = False, .ChannelInfo = Me}
AutoGetLimits = True
DirectCast(Instance, UserData).SetLimit(Me)
IsRegularChannel = True
End Sub
Public Shared Widening Operator CType(ByVal f As SFile) As Channel
Return New Channel(f)
End Operator
Public Shared Widening Operator CType(ByVal c As Channel) As UserDataBase
Return DirectCast(c.Instance, UserDataBase)
End Operator
Public Overrides Function ToString() As String
If Not Name.IsEmptyString Then
Return Name
@@ -434,30 +202,29 @@ Namespace API.Reddit
End If
End Function
Friend Sub Delete()
If File.Exists Then File.Delete()
File.Delete(, SFODelete.DeleteToRecycleBin)
End Sub
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
Optional ByVal p As MyProgress = Nothing)
Try
_Downloading = True
If Not Instance Is Nothing Then
Instance.DownloadData(Token)
Else
Using d As New UserData(CUser, False, False) With {
.Progress = p,
.SaveToCache = True,
.SkipExistsUsers = SkipExists,
.ChannelInfo = Me
}
d.SetLimit(Me)
d.DownloadData(Token)
Dim b% = Posts.Count
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
If Posts.Count - b > 0 Then CountOfLoadedPostsPerSession.Add(Posts.Count - b)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
End Using
End If
Using d As New UserData With {
.Progress = p,
.SaveToCache = True,
.SkipExistsUsers = SkipExists,
.ChannelInfo = Me
}
d.SetEnvironment(HOST, CUser, False)
d.RemoveUpdateHandlers()
d.SetLimit(Me)
d.DownloadData(Token)
Dim b% = Posts.Count
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
If Posts.Count - b > 0 Then CountOfLoadedPostsPerSession.Add(Posts.Count - b)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
UpdateUsersStats()
End Using
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Finally
_Downloading = False
@@ -498,21 +265,12 @@ Namespace API.Reddit
Friend Overloads Function Equals(ByVal Other As Channel) As Boolean Implements IEquatable(Of Channel).Equals
Return ID = Other.ID
End Function
Private Overloads Function Equals(ByVal Other As UserDataBase) As Boolean Implements IEquatable(Of UserDataBase).Equals
If Not Instance Is Nothing Then
Return Instance.Equals(Other)
Else
Return False
End If
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not Obj Is Nothing Then
If TypeOf Obj Is String Then
Return ID = CStr(Obj)
ElseIf TypeOf Obj Is Channel Then
Return Equals(DirectCast(Obj, Channel))
ElseIf TypeOf Obj Is UserDataBase Then
Return Equals(DirectCast(Obj, UserDataBase))
End If
End If
Return False
@@ -526,22 +284,6 @@ Namespace API.Reddit
Return ID.CompareTo(Other.ID)
End If
End Function
Private Overloads Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
If Not Instance Is Nothing Then
Return Instance.CompareTo(Other)
Else
Return 0
End If
End Function
Private Overloads Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If TypeOf Obj Is Channel Then
Return CompareTo(DirectCast(Obj, Channel))
ElseIf TypeOf Obj Is UserDataBase And Not Instance Is Nothing Then
Return Instance.CompareTo(Obj)
Else
Return 0
End If
End Function
#End Region
#Region "ILoaderSaver Support"
Friend Overloads Function LoadData(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Load
@@ -553,11 +295,13 @@ Namespace API.Reddit
x.LoadData()
If x.Count > 0 Then
Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Dim lc As New ListAddParams(LAP.ClearBeforeAdd)
Name = x.Value(Name_Name)
ID = x.Value(Name_ID)
LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), XMLDateProvider, Nothing)
CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), LAP.ClearBeforeAdd)
CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), LAP.ClearBeforeAdd)
CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), lc)
CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), lc)
ChannelExistentUserNames.ListAddList(x.Value(Name_UsersExistent).StringToList(Of String)("|"), LNC)
If Not PartialLoad Then
With x(Name_PostsNode).XmlIfNothing
If .Count > 0 Then .ForEach(Sub(ee) PostsLatest.Add(New UserPost With {
@@ -572,6 +316,7 @@ Namespace API.Reddit
End Function
Friend Overloads Function Save(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Save
Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
UpdateUsersStats()
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}
x.Add(Name_Name, Name)
x.Add(Name_ID, ID)
@@ -584,6 +329,7 @@ Namespace API.Reddit
x.Add(Name_PostsNode, String.Empty)
x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString(, "|"))
x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString(, "|"))
x.Add(Name_UsersExistent, ChannelExistentUserNames.ListToString(, "|"))
With x(Name_PostsNode)
tmpPostList.Take(200).ToList.ForEach(Sub(p) .Add(New EContainer("Post",
String.Empty,
@@ -603,11 +349,6 @@ Namespace API.Reddit
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Friend ReadOnly Property Disposed As Boolean Implements IUserData.Disposed
Get
Return disposedValue
End Get
End Property
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
@@ -616,8 +357,8 @@ Namespace API.Reddit
CountOfAddedUsers.Clear()
CountOfLoadedPostsPerSession.Clear()
Range.Dispose()
If Not Instance Is Nothing Then Instance.Dispose()
If CachePath.Exists(SFO.Path, False) Then CachePath.Delete(SFO.Path, False, False, EDP.SendInLog)
ChannelExistentUserNames.Clear()
CachePath.Delete(SFO.Path, SFODelete.None, EDP.SendInLog)
End If
disposedValue = True
End If

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

@@ -15,15 +15,39 @@ Namespace API.Reddit
Friend Shared ReadOnly Property ChannelsPath As SFile = $"{SettingsFolderName}\Channels\"
Friend Shared ReadOnly Property ChannelsPathCache As SFile = $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\"
Private ReadOnly Channels As List(Of Channel)
Friend Structure ChannelImage : Implements IEquatable(Of ChannelImage)
Friend File As SFile
Friend Channel As String
Friend Sub New(ByVal ChannelName As String, ByVal f As SFile)
Channel = ChannelName
File = f
End Sub
Friend Overloads Function Equals(ByVal Other As ChannelImage) As Boolean Implements IEquatable(Of ChannelImage).Equals
Return Channel = Other.Channel And File.File = Other.File.File
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
Return Equals(DirectCast(Obj, ChannelImage))
End Function
End Structure
Friend ReadOnly Property Downloading As Boolean
Get
If Count > 0 Then
Return Channels.Exists(Function(c) c.Downloading)
Else
Return False
End If
Return Count > 0 AndAlso Channels.Exists(Function(c) c.Downloading)
End Get
End Property
Friend Function GetUserFiles(ByVal UserName As String) As IEnumerable(Of ChannelImage)
Try
If Settings.ChannelsAddUserImagesFromAllChannels.Value And Count > 0 Then
Return Channels.SelectMany(Function(c) From p As UserPost In c.Posts Where p.UserID = UserName Select New ChannelImage(c.Name, p.CachedFile))
Else
Return Nothing
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex)
End Try
End Function
Friend Sub UpdateUsersStats()
If Channels.Count > 0 Then Channels.ForEach(Sub(c) c.UpdateUsersStats())
End Sub
#Region "Limits Support"
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
<Obsolete("This property cannot be used in collections", True)> Private Property DownloadLimitPost As String Implements IChannelLimits.DownloadLimitPost

2
SCrawler/API/Reddit/Declarations.vb
View File

@@ -10,6 +10,8 @@ Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Reddit
Friend Module Declarations
Friend Const RedditSite As String = "Reddit"
Friend Const RedditSiteKey As String = "AndyProgram_Reddit"
Friend ReadOnly JsonNodesJson() As NodeParams = {New NodeParams("posts", True, True, True, True, 3)}
Friend ReadOnly ChannelJsonNodes() As NodeParams = {New NodeParams("data", True, True, True, True, 1),
New NodeParams("children", True, True, True)}

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

@@ -96,7 +96,7 @@ Namespace API.Reddit
Catch ex As Exception
Return ErrorsDescriber.Execute(DPED, ex, "[M3U8.Save]", New SFile)
Finally
If Not CachePath.IsEmptyString AndAlso CachePath.Exists(SFO.Path, False) Then CachePath.Delete(SFO.Path, False, False, DPED)
CachePath.Delete(SFO.Path, SFODelete.None, DPED)
End Try
End Function
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile) As SFile

33
SCrawler/API/Reddit/ProfileSaved.vb
View File

@@ -1,33 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Namespace API.Reddit
Friend NotInheritable Class ProfileSaved
Friend Shared ReadOnly Property DataPath As SFile = Settings(Sites.Reddit).SavedPostsPath
Private Sub New()
End Sub
Friend Shared Sub Download(ByRef Bar As MyProgress, ByVal Token As CancellationToken)
Try
Dim u As New UserInfo(Settings(Sites.Reddit).SavedPostsUserName.Value, Sites.Reddit) With {.IsChannel = True, .SpecialPath = DataPath}
u.UpdateUserFile()
Using user As New UserData(u,, False)
DirectCast(user.Self, UserDataBase).IsSavedPosts = True
user.Progress = Bar
If Not user.FileExists Then user.UpdateUserInformation()
user.DownloadData(Token)
Bar.InformationTemporary = $"Images: {user.DownloadedPictures}; Videos: {user.DownloadedVideos}"
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.Reddit.ProfileSaved.Download]")
End Try
End Sub
End Class
End Namespace

97
SCrawler/API/Reddit/SiteSettings.vb Normal file
View File

@@ -0,0 +1,97 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.RegularExpressions
Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit
<Manifest(RedditSiteKey), UseClassAsIs, SavedPosts>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.RedditIcon
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.RedditPic512
End Get
End Property
<PropertyOption(ControlText:="Saved posts user"), PXML("SavedPostsUserName")>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend Overrides ReadOnly Property Responser As WEB.Response
Friend Sub New()
MyBase.New(RedditSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
With Responser
If .File.Exists Then
.LoadSettings()
Else
.CookiesDomain = "reddit.com"
.Decoders.Add(SymbolsConverter.Converters.Unicode)
.SaveSettings()
End If
End With
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UrlPatternUser = "https://www.reddit.com/user/{0}/"
UrlPatternChannel = "https://www.reddit.com/r/{0}/"
ImageVideoContains = "redgifs"
End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
Case Download.Main : Return New UserData
Case Download.Channel : Return New UserData With {.SaveToCache = False, .SkipExistsUsers = False, .AutoGetLimits = True}
Case Download.SavedPosts
Dim u As New UserData With {.IsSavedPosts = True}
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
Return u
End Select
Return Nothing
End Function
Private ReadOnly RedditRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/user/([^/]+)", 1)
Private ReadOnly RedditRegEx2 As RParams = RParams.DMS(".?u/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/r/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx2 As RParams = RParams.DMS(".?r/([^/]+)", 1)
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim s$
Dim c% = 0
For Each r As RParams In {RedditRegEx1, RedditRegEx2, RedditChannelRegEx1, RedditChannelRegEx2}
s = RegexReplace(UserURL, r)
If Not s.IsEmptyString Then Return New ExchangeOptions(Site, s, c > 1)
c += 1
Next
Return Nothing
End Function
Friend Overrides Function Available(ByVal What As Download) As Boolean
Try
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit")
If dl.ListExists Then
dl = dl.Take(4).ToList
Dim avg% = dl.Average(Function(d) d.Value)
If avg > 100 Then
Return 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
End If
End If
Return True
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
End Try
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser)
End Function
End Class
End Namespace

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

@@ -9,6 +9,7 @@
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net
Imports System.Threading
@@ -17,7 +18,11 @@ Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Reddit
Friend Class UserData : Inherits UserDataBase : Implements IChannelData
Friend Overrides Property Site As Sites = Sites.Reddit
Private ReadOnly Property MySiteSettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
#Region "Channels Support"
#Region "IChannelLimits Support"
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
@@ -50,22 +55,12 @@ Namespace API.Reddit
Select c.Post) Else Return Nothing
End Function
#End Region
#Region "Initializers"
''' <summary>Video downloader initializer</summary>
Private Sub New()
#Region "Initializer"
Friend Sub New()
ChannelPostsNames = New List(Of String)
_ExistsUsersNames = New List(Of String)
_CrossPosts = New List(Of String)
End Sub
''' <summary>Default initializer</summary>
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True, Optional ByVal InvokeImageHandler As Boolean = True)
MyBase.New(InvokeImageHandler)
ChannelPostsNames = New List(Of String)
_ExistsUsersNames = New List(Of String)
_CrossPosts = New List(Of String)
User = u
If _LoadUserInformation Then LoadUserInformation()
End Sub
#End Region
#Region "Load and Update user info"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -73,11 +68,12 @@ Namespace API.Reddit
#End Region
#Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
UserDescriptionReset()
_CrossPosts.Clear()
If Not IsSavedPosts AndAlso (IsChannel AndAlso Not ChannelInfo.IsRegularChannel) Then
If Not IsSavedPosts AndAlso (IsChannel AndAlso Not ChannelInfo Is Nothing) Then
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New PersonalUtilities.Tools.WEB.Response
Responser.Copy(Settings(Sites.Reddit).Responser)
Responser = New Response
Responser.Copy(MySiteSettings.Responser)
ChannelPostsNames.ListAddList(ChannelInfo.PostsAll.Select(Function(p) p.ID), LNC)
If SkipExistsUsers Then _ExistsUsersNames.ListAddList(Settings.UsersList.Select(Function(p) p.Name), LNC)
DownloadDataF(Token)
@@ -93,7 +89,7 @@ Namespace API.Reddit
If IsSavedPosts Then
DownloadDataChannel(String.Empty, Token)
ElseIf IsChannel Then
If ChannelInfo.IsRegularChannel Then
If ChannelInfo Is Nothing Then
ChannelPostsNames.ListAddList(_TempPostsList, LNC)
If ChannelPostsNames.Count > 0 Then
DownloadLimitCount = Nothing
@@ -104,7 +100,7 @@ Namespace API.Reddit
If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount
End If
DownloadDataChannel(String.Empty, Token)
If ChannelInfo.IsRegularChannel Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
If ChannelInfo Is Nothing Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
Else
DownloadDataUser(String.Empty, Token)
End If
@@ -138,6 +134,7 @@ Namespace API.Reddit
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then
If UserDescriptionNeedToUpdate() Then UserDescriptionUpdate(w.ItemF({"subredditAboutInfo", 0, "publicDescription"}).XmlIfNothingValue)
n = w.GetNode(JsonNodesJson)
If Not n Is Nothing AndAlso n.Count > 0 Then
For Each nn In n
@@ -170,7 +167,7 @@ Namespace API.Reddit
_ItemsBefore = _TempMediaList.Count
added = True
s = nn.ItemF({"source", "url"})
If s.XmlIfNothingValue("/").Contains("redgifs.com") Then
If s.XmlIfNothingValue("/").StringContains({"redgifs.com", "gfycat.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, _PostID(), PostDate,, IsChannel), LNC)
ElseIf Not CreateImgurMedia(s.XmlIfNothingValue, _PostID(), PostDate,, IsChannel) Then
s = nn.ItemF({"media"}).XmlIfNothing
@@ -199,7 +196,7 @@ Namespace API.Reddit
If Not s.IsEmptyString AndAlso TryFile(s.Value) Then
With s.Value.ToLower
Select Case True
Case .Contains("redgifs") : tmpType = UTypes.VideoPre
Case .Contains("redgifs"), .Contains("gfycat") : tmpType = UTypes.VideoPre
Case .Contains("m3u8") : If Settings.UseM3U8 Then tmpType = UTypes.m3u8
Case .Contains(".gif") And TryFile(s.Value) : tmpType = UTypes.GIF
Case TryFile(s.Value) : tmpType = UTypes.Picture
@@ -264,13 +261,28 @@ Namespace API.Reddit
End With
If lDate.HasValue AndAlso lDate.Value <= DownloadLimitDate.Value Then Exit Sub
End If
NewPostDetected = True
If IsSavedPosts Then
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
Else
ExistsDetected = True
Continue For
End If
Else
NewPostDetected = True
End If
If s.Contains("created") Then PostDate = s("created").Value Else PostDate = String.Empty
_UserID = s.Value("author")
If SkipExistsUsers AndAlso _ExistsUsersNames.Count > 0 AndAlso
Not _UserID.IsEmptyString AndAlso _ExistsUsersNames.Contains(_UserID) Then Continue For
Not _UserID.IsEmptyString AndAlso _ExistsUsersNames.Contains(_UserID) Then
If Not IsSavedPosts AndAlso Not ChannelInfo Is Nothing Then _
ChannelInfo.ChannelExistentUserNames.ListAddValue(_UserID, LNC)
Continue For
End If
tmpUrl = s.Value("url")
If Not tmpUrl.IsEmptyString AndAlso tmpUrl.Contains("redgifs.com") Then
@@ -393,7 +405,15 @@ Namespace API.Reddit
ThrowAny(Token)
If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then
m = _TempMediaList(i)
If _TempMediaList(i).Type = UTypes.VideoPre Then r = Responser.GetResponse(m.URL,, e) Else r = m.URL
If _TempMediaList(i).Type = UTypes.VideoPre Then
If m.URL.Contains("gfycat.com") Then
r = Gfycat.Envir.GetVideo(m.URL)
Else
r = Responser.GetResponse(m.URL,, e)
End If
Else
r = m.URL
End If
_TempMediaList(i) = New UserMedia
If Not r.IsEmptyString Then
v = RegexReplace(r, VideoRegEx)
@@ -410,13 +430,13 @@ Namespace API.Reddit
ProcessException(ex, Token, "video reparsing error", False)
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.Contains("redgifs") Then
Using r As New UserData
r._TempMediaList.Add(MediaFromData(UTypes.VideoPre, URL, String.Empty, String.Empty,, False))
r.Responser = New PersonalUtilities.Tools.WEB.Response
r.Responser.Copy(Settings(Sites.Reddit).Responser)
r.Responser = New Response
r.Responser.Copy(resp)
r.ReparseVideo(Nothing)
If r._TempMediaList.ListExists Then Return {r._TempMediaList(0)}
End Using
@@ -465,7 +485,7 @@ Namespace API.Reddit
If _ContentNew.Count > 0 Then
MyFile.Exists(SFO.Path)
Dim MyDir$
If Not IsSavedPosts AndAlso (IsChannel And SaveToCache) Then
If Not IsSavedPosts AndAlso (IsChannel And SaveToCache And Not ChannelInfo Is Nothing) Then
MyDir = ChannelInfo.CachePath.PathNoSeparator
Else
MyDir = MyFile.CutPath.PathNoSeparator
@@ -584,8 +604,8 @@ Namespace API.Reddit
End If
If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then
Select Case v.Type
Case UTypes.Picture : DownloadedPictures += 1 : _CountPictures += 1
Case UTypes.Video, UTypes.m3u8 : DownloadedVideos += 1 : _CountVideo += 1
Case UTypes.Picture : DownloadedPictures(False) += 1
Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1
End Select
If Not IsChannel Or Not SaveToCache Then
v.File = ChangeFileNameByProvider(f, v)

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

@@ -8,6 +8,7 @@
' but WITHOUT ANY WARRANTY
Namespace API.RedGifs
Friend Module Declarations
Friend Const RedGifsSite As String = "RedGifs"
Friend ReadOnly DateProvider As New JsonDate
Friend Class JsonDate : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,

29
SCrawler/API/Redgifs/SiteSettings.vb Normal file
View File

@@ -0,0 +1,29 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.RedGifs
<Manifest("AndyProgram_RedGifs"), UseClassAsIs>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Sub New()
MyBase.New(RedGifsSite, "redgifs.com")
UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs"
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return Reddit.UserData.GetVideoInfo(URL, Nothing)
End Function
End Class
End Namespace

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

@@ -15,10 +15,7 @@ Imports SCrawler.API.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.RedGifs
Friend Class UserData : Inherits UserDataBase
Friend Overrides Property Site As Sites = Sites.RedGifs
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
User = u
If _LoadUserInformation Then LoadUserInformation()
Friend Sub New()
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub

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

@@ -10,6 +10,7 @@ Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Twitter
Friend Module Declarations
Friend Const TwitterSite As String = "Twitter"
Friend DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Friend ReadOnly VideoNode As NodeParams() = {New NodeParams("video_info", True, True, True, True, 10)}
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)

99
SCrawler/API/Twitter/SiteSettings.vb Normal file
View File

@@ -0,0 +1,99 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.RegularExpressions
Imports SCrawler.API.Base
Namespace API.Twitter
<Manifest("AndyProgram_Twitter"), UseClassAsIs>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Const Header_Authorization As String = "authorization"
Friend Const Header_Token As String = "x-csrf-token"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.TwitterIcon
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.TwitterPic400
End Get
End Property
<PropertyOption(AllowNull:=False, ControlText:="Authorization",
ControlToolTip:="Set authorization from [authorization] response header. This field must start from [Bearer] key word")>
Private ReadOnly Property Auth As PropertyValue
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")>
Private ReadOnly Property Token As PropertyValue
Friend Overrides ReadOnly Property Responser As WEB.Response
Friend Sub New()
MyBase.New(TwitterSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
Dim a$ = String.Empty
Dim t$ = String.Empty
With Responser
If .File.Exists Then
.LoadSettings()
With .Headers
If .ContainsKey(Header_Authorization) Then a = .Item(Header_Authorization)
If .ContainsKey(Header_Token) Then t = .Item(Header_Token)
End With
Else
.ContentType = "application/json"
.Accept = "*/*"
.CookiesDomain = "twitter.com"
.Decoders.Add(SymbolsConverter.Converters.Unicode)
With .Headers
.Add("sec-ch-ua", " Not;A Brand" & Chr(34) & ";v=" & Chr(34) & "99" & Chr(34) & ", " & Chr(34) &
"Google Chrome" & Chr(34) & ";v=" & Chr(34) & "91" & Chr(34) & ", " & Chr(34) & "Chromium" &
Chr(34) & ";v=" & Chr(34) & "91" & Chr(34))
.Add("sec-ch-ua-mobile", "?0")
.Add("sec-fetch-dest", "empty")
.Add("sec-fetch-mode", "cors")
.Add("sec-fetch-site", "same-origin")
.Add(Header_Token, String.Empty)
.Add("x-twitter-active-user", "yes")
.Add("x-twitter-auth-type", "OAuth2Session")
.Add(Header_Authorization, String.Empty)
End With
.SaveSettings()
End If
End With
Auth = New PropertyValue(a, GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v))
Token = New PropertyValue(t, GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
UserRegex = RParams.DMS("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1)
UrlPatternUser = "https://twitter.com/{0}"
ImageVideoContains = "twitter"
End Sub
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(Auth) : f = Header_Authorization
Case NameOf(Token) : f = Header_Token
End Select
If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser)
End Function
End Class
End Namespace

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

@@ -16,27 +16,25 @@ Imports SCrawler.API.Base
Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase
#Region "Declarations"
Friend Overrides Property Site As Sites = Sites.Twitter
Private ReadOnly _DataNames As List(Of String)
#End Region
#Region "Initializer"
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
User = u
If _LoadUserInformation Then LoadUserInformation()
Friend Sub New()
_DataNames = New List(Of String)
End Sub
#End Region
#Region "Load and Update user info"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData(String.Empty, Token)
End Sub
Private Overloads Sub DownloadData(ByVal POST As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim PostID$ = String.Empty
Dim PostDate$
Dim PostDate$, dName$
Dim m As EContainer, nn As EContainer, s As EContainer
Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False
@@ -61,6 +59,8 @@ Namespace API.Twitter
If Not ID.IsEmptyString Then UpdateUserInformation()
End If
If UserDescriptionNeedToUpdate() AndAlso nn.Value({"user"}, "screen_name") = Name Then UserDescriptionUpdate(nn.Value({"user"}, "description"))
'Date Pattern:
'Sat Jan 01 01:10:15 +0000 2000
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
@@ -81,8 +81,12 @@ Namespace API.Twitter
If Not s Is Nothing AndAlso s.Count > 0 Then
For Each m In s
If m.Count > 0 AndAlso m.Contains("media_url") Then
_TempMediaList.ListAddValue(MediaFromData(m("media_url").Value,
PostID, PostDate, GetPictureOption(m)), LNC)
dName = UrlFile(m("media_url").Value)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(m("media_url").Value,
PostID, PostDate, GetPictureOption(m)), LNC)
End If
End If
Next
End If
@@ -99,12 +103,12 @@ Namespace API.Twitter
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
Try
If URL.Contains("twitter") Then
Dim PostID$ = RegexReplace(URL, RParams.DM("(?<=/)\d+", 0))
If Not PostID.IsEmptyString Then
Dim r$ = DirectCast(Settings(Sites.Twitter).Responser.Copy(), Response).
Dim r$ = DirectCast(resp.Copy(), Response).
GetResponse($"https://api.twitter.com/1.1/statuses/show.json?id={PostID}",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
@@ -147,7 +151,14 @@ Namespace API.Twitter
Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String) As Boolean
Try
Dim URL$ = GetVideoNodeURL(w)
If Not URL.IsEmptyString Then _TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate), LNC) : Return True
If Not URL.IsEmptyString Then
Dim f$ = UrlFile(URL)
If Not f.IsEmptyString AndAlso Not _DataNames.Contains(f) Then
_DataNames.Add(f)
_TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate), LNC)
End If
Return True
End If
Return False
Catch ex As Exception
LogError(ex, "[API.Twitter.UserData.CheckVideoNode]")
@@ -177,6 +188,14 @@ Namespace API.Twitter
End Function
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Private Function UrlFile(ByVal URL As String) As String
Try
Dim f As SFile = CStr(RegexReplace(LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern)), FilesPattern))
If Not f.IsEmptyString Then Return f.File Else Return String.Empty
Catch ex As Exception
Return String.Empty
End Try
End Function
#End Region
Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _PictureOption As String = "") As UserMedia
@@ -206,5 +225,9 @@ Namespace API.Twitter
End If
Return 1
End Function
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _DataNames.Clear()
MyBase.Dispose(disposing)
End Sub
End Class
End Namespace

161
SCrawler/API/UserDataBind.vb
View File

@@ -8,13 +8,14 @@
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.Messaging
Imports System.Threading
Imports SCrawler.API.Base
Namespace API
Friend Class UserDataBind : Inherits UserDataBase : Implements ICollection(Of IUserData), IMyEnumerator(Of IUserData)
Friend Event OnCollectionSelfRemoved()
Friend Event OnCollectionSelfRemoved(ByVal Collection As IUserData)
Friend Event OnUserRemoved(ByVal User As IUserData)
#Region "Declarations"
Friend Overrides Property Site As Sites = Sites.Undefined
Friend ReadOnly Property Collections As List(Of IUserData)
Private _CollectionName As String = String.Empty
Friend Overrides Property CollectionName As String
@@ -121,7 +122,7 @@ Namespace API
Friend Overrides Property DataMerging As Boolean
Get
If Count > 0 Then
Return DirectCast(Collections(0).Self, UserDataBase).DataMerging
Return DirectCast(Collections(0), UserDataBase).DataMerging
Else
Return False
End If
@@ -184,15 +185,15 @@ Namespace API
End Property
Friend Overrides Function GetUserInformation() As String
Dim OutStr$ = String.Empty
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c.Self, UserDataBase).GetUserInformation(), $"{vbCrLf}{vbCrLf}"))
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), $"{vbCrLf}{vbCrLf}"))
Return OutStr
End Function
Friend Overrides Property LastUpdated As Date?
Get
If Count > 0 Then
With If((From c In Collections
Where DirectCast(c.Self, UserDataBase).LastUpdated.HasValue
Select DirectCast(c.Self, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
With If((From c As IUserData In Collections
Where DirectCast(c, UserDataBase).LastUpdated.HasValue
Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
If .Count > 0 Then Return .Max
End With
End If
@@ -210,7 +211,7 @@ Namespace API
Friend ReadOnly Property ContextDown As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_DOWN).ToArray
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DOWN).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -219,7 +220,7 @@ Namespace API
Friend ReadOnly Property ContextEdit As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_EDIT).ToArray
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_EDIT).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -228,7 +229,7 @@ Namespace API
Friend ReadOnly Property ContextDelete As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_DELETE).ToArray
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DELETE).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -237,7 +238,7 @@ Namespace API
Friend ReadOnly Property ContextPath As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_OPEN_PATH).ToArray
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_PATH).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -246,7 +247,7 @@ Namespace API
Friend ReadOnly Property ContextSite As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_OPEN_SITE).ToArray
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_SITE).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -270,7 +271,7 @@ Namespace API
If Count > 0 Then Collections.ForEach(Sub(c) c.UpdateUserInformation())
End Sub
Friend Overrides Sub LoadContentInformation()
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c.Self, UserDataBase).LoadContentInformation())
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation())
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
@@ -299,14 +300,15 @@ Namespace API
Return 0
End Function
Private Sub User_OnUserUpdated(ByVal User As IUserData)
Raise_OnUserUpdated()
RaiseEvent_OnUserUpdated()
End Sub
Friend Overrides Sub OpenSite()
If Count > 0 Then Collections(0).OpenSite()
Friend Overrides Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
If Not e.Exists Then e = New ErrorsDescriber(EDP.SendInLog)
If Count > 0 Then Collections.ForEach(Sub(c) c.OpenSite(e))
End Sub
Friend Overrides Sub OpenFolder()
Try
If Count > 0 Then Collections(0).File.CutPath(2).Open(SFO.Path, EDP.None)
If Count > 0 Then GlobalOpenPath(Collections(0).File.CutPath(2))
Catch ex As Exception
End Try
End Sub
@@ -328,17 +330,20 @@ Namespace API
If DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
Collections.Add(_Item)
With Collections.Last
If Collections.Count - 1 > 0 Then
If Count > 1 Then
If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
.Temporary = Temporary
.Favorite = Favorite
.ReadyForDownload = ReadyForDownload
ConsolidateLabels()
.UpdateUserInformation()
End If
ImageHandler(_Item, False)
AddRemoveBttDeleteHandler(.Self, True)
AddHandler .Self.OnUserUpdated, AddressOf User_OnUserUpdated
DirectCast(.Self, UserDataBase).CreateButtons(Count - 1)
End With
Else
Throw New InvalidOperationException("User data doe not move to the collection folder")
Throw New InvalidOperationException("User data was not moved to the collection folder")
End If
End With
End Sub
@@ -346,22 +351,43 @@ Namespace API
Friend Overloads Sub Add(ByVal u As UserInfo, Optional ByVal _LoadData As Boolean = True)
Collections.Add(GetInstance(u, _LoadData))
If Not Collections.Last Is Nothing Then
With DirectCast(Collections.Last.Self, UserDataBase)
.CreateButtons(Count - 1)
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf BTT_CONTEXT_DELETE_Click
With Collections.Last
If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
AddRemoveBttDeleteHandler(.Self, True)
AddHandler .OnUserUpdated, AddressOf User_OnUserUpdated
End With
AddHandler Collections.Last.OnUserUpdated, AddressOf User_OnUserUpdated
Else
Collections.RemoveAt(Count - 1)
End If
End Sub
Private Sub AddRemoveBttDeleteHandler(ByRef User As IUserData, ByVal IsAdd As Boolean)
Try
With DirectCast(User, UserDataBase)
If IsAdd Then
.CreateButtons(Count - 1)
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf DeleteRemoveUserFromCollection
Else
RemoveHandler .BTT_CONTEXT_DELETE.Click, AddressOf DeleteRemoveUserFromCollection
End If
End With
Catch ex As Exception
End Try
End Sub
Private Sub ConsolidateLabels()
If Count > 1 Then
Dim l As New List(Of String)
Dim lp As New ListAddParams(LAP.ClearBeforeAdd)
l.ListAddList(Collections.SelectMany(Function(c) c.Labels), LNC)
Collections.ForEach(Sub(c) c.Labels.ListAddList(l, lp))
End If
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If Not _Items Is Nothing AndAlso _Items.Count > 0 Then
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
End If
End Sub
Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean
Throw New NotImplementedException("Files moving does not available if collection context")
Throw New NotImplementedException("Move files is not available in the collection context")
End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
If Count > 0 Then
@@ -370,7 +396,7 @@ Namespace API
MsgBoxE($"Collection [{CollectionName}] data already merged")
Else
If Collections.Count > 1 Then
Collections.ForEach(Sub(c) DirectCast(c.Self, UserDataBase).MergeData())
Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).MergeData())
MsgBoxE($"Collection [{CollectionName}] data merged")
Else
MsgBoxE($"Collection [{CollectionName}] contains only one user profile" & vbCr &
@@ -403,8 +429,10 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical)
Return False
Else
DirectCast(_Item.Self, UserDataBase).MoveFiles(String.Empty)
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty)
ImageHandler(_Item)
AddRemoveBttDeleteHandler(_Item, False)
RaiseEvent OnUserRemoved(_Item)
Return Collections.Remove(_Item)
End If
End Function
@@ -420,14 +448,16 @@ Namespace API
ImageHandler(Me, False)
Collections.ListClearDispose
Dispose(False)
If f.Exists(SFO.Path, False) Then f.Delete(SFO.Path, True, False, EDP.SendInLog)
f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
Return 2
Else
If DataMerging Then
MsgBoxE($"Collection [{CollectionName}] data are already merged{vbCr}Cannot split merged collection{vbCr}Operation canceled", MsgBoxStyle.Exclamation)
Return 0
End If
If MsgBoxE({$"Do you want to delete collection only?{vbCr}Users will not be deleted", "Collection deleting"},
If MsgBoxE({"Do you want to delete only the collection and split users' profiles??" & vbCr &
"Users will be removed from the collection and split by sites." & vbCr &
"All user data will remain.", "Collection deleting"},
MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
f = Collections(0).File.CutPath(2)
Settings.Users.Remove(Me)
@@ -436,7 +466,7 @@ Namespace API
ImageHandler(c)
End Sub)
Collections.Clear()
f.Delete(SFO.Path,,, EDP.SendInLog)
f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
Downloader.UserRemove(Me)
ImageHandler(Me, False)
Dispose(False)
@@ -448,28 +478,45 @@ Namespace API
End If
Return 0
End Function
Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs)
Private Sub DeleteRemoveUserFromCollection(sender As Object, e As EventArgs)
With DirectCast(sender, ToolStripMenuItem)
Dim i% = AConvert(Of Integer)(.Tag, -1)
If i >= 0 Then
Dim n$ = Collections(i).Name
Dim s$ = Collections(i).Site.ToString
If MsgBoxE({$"Do you really want to delete user profile [{n}] of site [{s}]?" & vbCr &
"This profile will be removed from collection and all data will be erased",
"Profile removing"}, MsgBoxStyle.Exclamation,,, {"Process", "Cancel"}) = 0 Then
Collections(i).Delete()
Collections(i).Dispose()
Collections.RemoveAt(i)
MsgBoxE($"User profile [{n}] of site [{s}] has been removed")
If Count = 0 Then
Settings.Users.Remove(Me)
ImageHandler(Me, False)
RaiseEvent OnCollectionSelfRemoved()
Dispose(False)
End If
Else
MsgBoxE("Operation canceled")
End If
Dim RemoveMeIfNull As Action = Sub()
If Count = 0 Then
Settings.Users.Remove(Me)
ImageHandler(Me, False)
RaiseEvent OnCollectionSelfRemoved(Me)
Dispose(False)
End If
End Sub
Select Case MsgBoxE({$"Are you sure you want to remove user profile [{n}] of site [{s}] from collection [{Name}]?" & vbCr &
"You can remove a user from the collection while keeping data (Remove) or deleting the data (Delete)" & vbCr &
"Deleting this profile will remove it from the collection and all its data will be erased." & vbCr &
"Removing this profile will remove it from the collection and all its data will remain." &
"This user will still appear in the program, but not in the collection.",
"Deleting a user"}, vbExclamation,,,
{
New MsgBoxButton("Remove") With {
.ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program."},
New MsgBoxButton("Delete") With {
.ToolTip = "Delete a user from the collection and erase their data."},
"Cancel"
}).Index
Case 0
Remove(Collections(i))
MsgBoxE($"User [{s} - {n}] has been removed from the collection. Now it should be displayed in the program.")
RemoveMeIfNull.Invoke
Case 1
Collections(i).Delete()
Collections(i).Dispose()
Collections.RemoveAt(i)
MsgBoxE($"User profile [{n}] of site [{s}] has been deleted")
RemoveMeIfNull.Invoke
Case Else : MsgBoxE("Operation canceled")
End Select
End If
End With
End Sub
@@ -482,26 +529,6 @@ Namespace API
End Function
#End Region
#End Region
Friend Overrides Function CompareTo(ByVal Other As UserDataBase) As Integer
If TypeOf Other Is UserDataBind Then
Dim x% = CompareValue(Me)
Dim y% = CompareValue(Other)
If x.CompareTo(y) = 0 Then
Return CollectionName.CompareTo(Other.CollectionName)
Else
Return x.CompareTo(y)
End If
Else
Return -1
End If
End Function
Friend Overrides Function CompareTo(ByVal Obj As Object) As Integer
If TypeOf Obj Is UserDataBind Then
Return CompareTo(DirectCast(Obj, UserDataBind))
Else
Return -1
End If
End Function
Friend Overrides Function Equals(ByVal Other As UserDataBase) As Boolean
If Other.IsCollection Then
Return CollectionName = Other.CollectionName

53
SCrawler/Channels/ChannelViewForm.vb
View File

@@ -15,6 +15,7 @@ Imports System.ComponentModel
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit
Imports SCrawler.Plugin.Hosts
Imports CmbDefaultButtons = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Imports RButton = PersonalUtilities.Tools.RangeSwitcherButton.Types
Friend Class ChannelViewForm : Implements IChannelLimits
@@ -37,7 +38,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Return u.ToString
End Operator
Friend Sub ChannelUserAdded(Optional ByVal IsAdded As Boolean = True)
If Not Channel Is Nothing Then Channel.UserAdded(IsAdded)
If Not Channel Is Nothing Then Channel.UserAdded(ID, IsAdded)
End Sub
Public Overrides Function ToString() As String
Return ID
@@ -121,6 +122,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Private Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit
End Sub
#End Region
Private ReadOnly HOST As SettingsHost
Private ReadOnly PendingUsers As List(Of PendingUser)
Private ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)
Private WithEvents MyRange As RangeSwitcher(Of UserPost)
@@ -144,6 +146,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
CProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
LimitProvider = New ADateTime("dd.MM.yyyy HH:mm")
PendingUsers = New List(Of PendingUser)
HOST = Settings(RedditSiteKey)
CMB_CHANNELS = New ComboBoxExtended With {
.CaptionMode = ICaptionControl.Modes.CheckBox,
@@ -323,7 +326,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Private Async Sub BTT_DOWNLOAD_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD.Click
Try
AppendPendingUsers()
If Not TokenSource Is Nothing Then Exit Sub
If Not TokenSource Is Nothing OrElse Not HOST.Source.Available(Plugin.ISiteSettings.Download.Channel) Then Exit Sub
Dim InvokeToken As Action = Sub()
If TokenSource Is Nothing Then
CProgress.TotalCount = 0
@@ -353,6 +356,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
_CollectionDownloading = True
Settings.Channels.SetLimit(Me)
Await Task.Run(Sub() Settings.Channels.DownloadData(Token, CH_HIDE_EXISTS_USERS.Checked, CProgress))
Settings.Channels.UpdateUsersStats()
RaiseEvent OnDownloadDone("All channels downloaded")
Token.ThrowIfCancellationRequested()
c = GetCurrentChannel()
@@ -362,6 +366,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
InvokeToken.Invoke()
c.SetLimit(Me)
Await Task.Run(Sub() c.DownloadData(Token, CH_HIDE_EXISTS_USERS.Checked, CProgress))
c.UpdateUsersStats()
RaiseEvent OnDownloadDone($"Channel [{c.Name}] downloaded")
Token.ThrowIfCancellationRequested()
End If
@@ -433,25 +438,34 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Dim Added% = 0, Skipped% = 0
Dim StartIndex% = Settings.Users.Count
Dim f As SFile
Dim umo As Boolean = HOST.GetUserMediaOnly
Settings.Labels.Add(CannelsLabelName)
Settings.Labels.Add(LabelsKeeper.NoParsedUser)
Dim rUsers$() = UserBanned(PendingUsers.Select(Function(u) u.ID).ToArray)
If rUsers.ListExists Then PendingUsers.RemoveAll(Function(u) rUsers.Contains(u))
If PendingUsers.Count > 0 Then
With PendingUsers.Select(Function(u) New UserInfo(u, Sites.Reddit))
Dim c As New ListAddParams(LAP.NotContainsOnly)
Dim cn$
Dim tmpUser As IUserData
With PendingUsers.Select(Function(u) New UserInfo(u, HOST))
For i = 0 To .Count - 1
If Not Settings.UsersList.Contains(.ElementAt(i)) Then
f = PendingUsers(i).File
cn = If(PendingUsers(i).Channel?.Name, String.Empty)
Settings.UpdateUsersList(.ElementAt(i))
Settings.Users.Add(New UserData(.ElementAt(i), False) With {
.Temporary = Settings.ChannelsDefaultTemporary,
.CreatedByChannel = True,
.ReadyForDownload = Settings.ChannelsDefaultReadyForDownload
})
tmpUser = HOST.GetInstance(Plugin.ISiteSettings.Download.Main, .ElementAt(i), False)
With DirectCast(tmpUser, UserData)
.Temporary = Settings.ChannelsDefaultTemporary
.CreatedByChannel = True
.ReadyForDownload = Settings.ChannelsDefaultReadyForDownload
.ParseUserMediaOnly = umo
End With
Settings.Users.Add(tmpUser)
With Settings.Users.Last
.Labels.Add(CannelsLabelName)
.UpdateUserInformation()
If Settings.FromChannelCopyImageToUser And Not f.IsEmptyString And Not .File.IsEmptyString Then CopyFile(f, .File)
If Settings.FromChannelCopyImageToUser And Not f.IsEmptyString And Not .File.IsEmptyString Then _
CopyFile(ListAddValue(Nothing, New ChannelsCollection.ChannelImage(cn, f)).ListAddList(Settings.Channels.GetUserFiles(.Name), c), .File)
End With
Added += 1
Else
@@ -464,17 +478,26 @@ Friend Class ChannelViewForm : Implements IChannelLimits
BTT_ADD_USERS.Text = "Add"
MsgBoxE($"Added users: {Added.ToString(CProvider)}{vbCr}Skipped users: {Skipped.ToString(CProvider)}{vbCr}Total: {PendingUsers.Count.ToString(CProvider)}")
RaiseEvent OnUsersAdded(StartIndex)
Settings.Channels.UpdateUsersStats()
Else
MsgBoxE("No one users selected for add to collection")
End If
End Sub
Private Sub CopyFile(ByVal Source As SFile, ByVal Destination As SFile)
Private Sub CopyFile(ByVal Source As IEnumerable(Of ChannelsCollection.ChannelImage), ByVal Destination As SFile)
Try
If Not Source.IsEmptyString And Not Destination.IsEmptyString Then
If Source.ListExists And Not Destination.IsEmptyString Then
Destination = Destination.CutPath.PathWithSeparator & "ChannelImage\"
Destination.Name = Source.Name
Destination.Extension = Source.Extension
If Source.Exists AndAlso Destination.Exists(SFO.Path) Then IO.File.Copy(Source, Destination)
Dim f As SFile
Dim i% = 0
If Destination.Exists(SFO.Path) Then
For Each ff As ChannelsCollection.ChannelImage In Source
f = Destination
f.Extension = ff.File.Extension
f.Name = $"{IIf(i = 0, "!", String.Empty)}{ff.Channel}_{ff.File.Name}"
If ff.File.Exists Then IO.File.Copy(ff.File, f)
i += 1
Next
End If
End If
Catch ex As Exception
End Try
@@ -660,7 +683,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End Sub
Private Sub BTT_C_OPEN_FOLDER_Click(sender As Object, e As EventArgs) Handles BTT_C_OPEN_FOLDER.Click
Dim f As SFile = GetPostBySelected().CachedFile
If Not f.IsEmptyString Then f.Open(SFO.Path)
If Not f.IsEmptyString Then GlobalOpenPath(f, EDP.LogMessageValue)
End Sub
Private Sub BTT_C_REMOVE_FROM_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_C_REMOVE_FROM_SELECTED.Click
Try

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 29 KiB

61
SCrawler/Download/ActiveDownloadingProgress.Designer.vb generated Normal file
View File

@@ -0,0 +1,61 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class ActiveDownloadingProgress : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ActiveDownloadingProgress))
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.SuspendLayout()
'
'TP_MAIN
'
Me.TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.TP_MAIN.ColumnCount = 1
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 1
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 62.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 62.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(434, 61)
Me.TP_MAIN.TabIndex = 0
'
'ActiveDownloadingProgress
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(434, 61)
Me.Controls.Add(Me.TP_MAIN)
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(450, 100)
Me.Name = "ActiveDownloadingProgress"
Me.Text = "Active downloading progress"
Me.ResumeLayout(False)
End Sub
Private WithEvents TP_MAIN As TableLayoutPanel
End Class
End Namespace

624
SCrawler/Download/ActiveDownloadingProgress.resx Normal file
View File

@@ -0,0 +1,624 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAABAAwAMDAQAAEABABoBgAAxgAAACAgEAABAAQA6AIAAC4HAAAYGBAAAQAEAOgBAAAWCgAAEBAQAAEA
BAAoAQAA/gsAADAwAAABAAgAqA4AACYNAAAgIAAAAQAIAKgIAADOGwAAGBgAAAEACADIBgAAdiQAABAQ
AAABAAgAaAUAAD4rAAAwMAAAAQAgAKglAACmMAAAICAAAAEAIACoEAAATlYAABgYAAABACAAiAkAAPZm
AAAQEAAAAQAgAGgEAAB+cAAAKAAAADAAAABgAAAAAQAEAAAAAACABAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAIAAAIAAAACAgACAAAAAgACAAICAAACAgIAAwMDAAAAA/wAA/wAAAP//AP8AAAD/AP8A//8AAP//
/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4YAAAAAAAAAAAAAAAAAAAAAAAAAAAAAjsjgAAAAAAAAAAAA
AAAAAAAAAAAAAAAIbOh4AAAAAAAAAAAAAAAAAAAAAAAAAAAH5mfsgAAAAAAAAAAAAAAAAAAAAAAAAAB+
xs54YAAAAAAAAAAAAAAAAAAAAAAAAAfsbmxo5wAAAAAAAAAAAAAAAAAAAAAAAIbObObOeMAAAAAAAAAA
AAAAAAAAAAAACG5+zmzsaOgAAAAAAAAAAAAAAAAAAAAABn7ObOZmbneAAAAAAAAAAAAAAAAAAAAAfs5s
5+zs7I7AAAAAAAAAAAAAAAAAAAAH7Ofm7G7GbGiOAAAAAAAAAAAAAAAAAAB+fs7Ofs5+zmzngAAAAAAA
AAAAAAAAAAhn7Ojs5uzm7OZ4yAAAAAAAAAAAAAAAAAaOfm7Obsfsbs7OjnAAAAAAAAAAAAAAAH7Ojs7n
7O7ObOZs54AAAAAAAAAAAAAABn6Ozuduzn5uznzmyOcAAAAAAAAAAAAAfn7I6M7s5+zn7Obs5oyAAAAA
AAAAAAAIZ+jujuzo7Obs5uxubOjnAAAAAAAAAAAG586M5+js7n7OfOfs5s54cAAAAAAAAABnzo7o5+zu
fs5+5uzmzmzowAAAAAAAAAdujn5+fu7Ozuzs7Ofs5+bI6AAAAAAAAHzn7OjOjI5+5+jufs5uzs5ueOAA
AAAAAG6M6O6O7n7Ofs7Ozo7Ofmzs53gAAAAAB+zo7IznyOzuzufufs6Ofo6Ofn4AAAAACEdsZ2Z87o5+
js7O7O5cjHx8jIgAAAAAAAAAAAAAfOfs7Ojs6OfgAAAAAAAAAAAAAAAAAAAAbo7O6O7O7OfAAAAAAAAA
AAAAAAAAAAAAfsjm7Obo7s6AAAAAAAAAAAAAAAAAAAAAaO5+zo7OyO5wAAAAAAAAAAAAAAAAAAAAzn7O
js7n7sjAAAAAAAAAAAAAAAAAAAAAaM6Ozuzuzu5wAAAAAAAAAAAAAAAAAAAAbn7Obn5+jshgAAAAAAAA
AAAAAAAAAAAAbOjn7Ozs7O5wAAAAAAAAAAAAAAAAAAAAfnzn5+bn7n7AAAAAAAAAAAAAAAAAAAAAbOjs
7OzuzshgAAAAAAAAAAAAAAAAAAAAaOyOfn7I5+5wAAAAAAAAAAAAAAAAAAAAbOfs7Ozm7OfAAAAAAAAA
AAAAAAAAAAAAbnzn5+bs5u5wAAAAAAAAAAAAAAAAAAAAfOfsjOx+zn7AAAAAAAAAAAAAAAAAAAAAbnzn
5o7OfshgAAAAAAAAAAAAAAAAAAAAx+Z+zs5uzm5gAAAAAAAAAAAAAAAAAAAAbs7H5+fObsjAAAAAAAAA
AAAAAAAAAAAAZ2js585s7O5wAAAAAAAAAAAAAAAAAAAAjOyH5+jn53aAAAAAAAAAAAAAAAAAAAAACGZs
bHxsfGgAAAAAAAAAAAD///////8AAP///////wAA////////AAD///j///8AAP//8H///wAA///gP///
AAD//+Af//8AAP//wB///wAA//+AD///AAD//wAH//8AAP/+AAP//wAA//4AAf//AAD//AAB//8AAP/4
AAD//wAA//AAAH//AAD/4AAAP/8AAP/gAAAf/wAA/8AAAB//AAD/gAAAD/8AAP8AAAAH/wAA/gAAAAP/
AAD+AAAAAf8AAPwAAAAB/wAA+AAAAAD/AADwAAAAAH8AAPAAAAAAPwAA4AAAAAA/AADgAAAAAD8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//
AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//4AA///AAAoAAAAIAAAAEAAAAABAAQAAAAAAAAC
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAICAgADAwMAAAAD/AAD/
AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5+AAAAAAAAAAAAAAAAAA
BoyHAAAAAAAAAAAAAAAAAOfn7AAAAAAAAAAAAAAAAAjIzn6AAAAAAAAAAAAAAAAO5uxo7AAAAAAAAAAA
AAAAaM7ObI6AAAAAAAAAAAAADn5ubOboyAAAAAAAAAAAAH7Ozs5sbo4AAAAAAAAAAAjI5+fn7saM4AAA
AAAAAAAO7n7Ozsbs6OcAAAAAAAAAaH7O5+bn5s6MgAAAAAAABo7o5+zs7Ozm6OAAAAAAAH7I7Ozufn5u
zsfsAAAAAAjOjn6Ofs7s5+bsjnAAAAAG6Ozo7O7n5+zs5ujnAAAAaOyOjo587Ozo6I7IjIAAAGxmxsZ+
7o7uzsbG7O4AAAAAAAAM587OyOhgAAAAAAAAAAAABo7n5+7OYAAAAAAAAAAAAAzozuzujsAAAAAAAAAA
AAAGjufuzs5wAAAAAAAAAAAADOfOyOfowAAAAAAAAAAAAAaOfm7O7mAAAAAAAAAAAAAM7Ofs5sjAAAAA
AAAAAAAABn585+7oYAAAAAAAAAAAAAyM6Oxs58AAAAAAAAAAAAAG5+zm5+5gAAAAAAAAAAAABOx+fs7I
wAAAAAAAAAAAAAZ+Z8hs7kAAAAAAAAAAAAAMjOjm52fAAAAAAAAAAAAAAGbExsbOAAAAAAAA///////8
f///+D////A////gH///4A///8AH//+AA///AAP//gAB//4AAP/8AAB/+AAAf/AAAD/gAAAf4AAAD8AA
AAfAAAAP/4AH//+AB///gAf//4AH//+AB///gAf//4AH//+AB///gAf//4AH//+AB///gAf//4AH///A
D/8oAAAAGAAAADAAAAABAAQAAAAAACABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAA
AACAAIAAgIAAAICAgADAwMAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAA
AAAABgAAAAAAAAAAAAAAeOAAAAAAAAAAAAAG7IcAAAAAAAAAAAB+fujgAAAAAAAAAAbs7OyHAAAAAAAA
AGjufm7oYAAAAAAABo7OzsfOhwAAAAAAaO5+5+7s6GAAAAAG5+zs7Ozn7PYAAABo6Ojo7n6IjojgAAAM
bGzs7OyOx+wAAAAAAAfo7o7nAAAAAAAAAAaM7OyGAAAAAAAAAAbufu6MAAAAAAAAAAd+zn6GAAAAAAAA
AAzn7OznAAAAAAAAAAaOzuiGAAAAAAAAAAbn587sAAAAAAAAAAZ87m6GAAAAAAAAAAzozs6MAAAAAAAA
AAaOh+eGAAAAAAAAAABsbGxgAAAAAAAAAAAAAAAAAAAAAP///wD/7/8A/8f/AP+D/wD/Af8A/gD/APwA
fwD4AD8A8AAfAOAADwDAAAcA4AAPAP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A
/wD/Af8A////ACgAAAAQAAAAIAAAAAEABAAAAAAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAACA
AAAAgIAAgAAAAIAAgACAgAAAgICAAMDAwAAAAP8AAP8AAAD//wD/AAAA/wD/AP//AAD///8AAAAABgAA
AAAAAABoYAAAAAAABo6MAAAAAABozshgAAAABo5uboYAAABo7OfOeGAABo5+fn6OhgB2xs7O6MfHgAAA
aOfIYAAAAABuzujgAAAAAGjn6MAAAAAAzs5+cAAAAABo5+jAAAAAAG7OyOAAAAAAaI6OcAAAAAAMbGYA
AAD+/wAA/H8AAPg/AADwHwAA4A8AAMAHAACAAwAAAAEAAPAfAADwHwAA8B8AAPAfAADwHwAA8B8AAPAf
AAD4PwAAKAAAADAAAABgAAAAAQAIAAAAAAAACQAAAAAAAAAAAAAAAQAAAAEAAAAAAACjaB0ApmsgAKlt
IwCrcCYArXMqALF1LACzeC4ArHYwALR6MQC4fTQAt385AMh1AADJdwQAy3gAAM17AADOfQEAy3oHAM5/
CQDMfA0A0H4BAMt/GQC7gDcAvoI6ALmBPADRgAIA0oIEANSDBADVhQUA1ogGANaMBwDZiQYA3I0GANKE
CgDWhwkA0YIMANaMCwDZiggA2o0JANyOCQDbkgsA3pAKAN6UCwDekg0A3ZQNAM+EGgDRhhUA1YkSANiN
EgDajhcA2pISANqSHgDalh4A3ZgaAOGUCgDgkg0A4ZUOAOSWDgDhmA4A5ZgPAOicDgDklxAA45cVAOGY
EADlmRAA5ZwRAOSdFwDonRIA550YAOmfGwDpoBIA6qEUAO2iFADrpBQA7qUWAO6mGADvqBgA8KUXAPCm
GADxqRgA9KsZAPKsGgD0rBoA9a0cAPiuGgD1sBsA+bEbAPixHADOhycAzo0lAMqKKwDRjCIA0Y8lANSP
JgDTji0A05ImANiRIwDdnScA1JQpANmVKwDXmCoA25stAMGJNQDAhj0A0I84AM2VPwDTmTYA3JwyANKR
OQDSlDgA2Js6AOGeIADknS8A3qAxANyiPwDopCAA7qogAOKiLQDtqykA8asjAPOxJwD6syAA+LMkAPq1
JwD2tSoA+rYsAPq4LgDiozEA6qUzAOepNQDpqTEA66wyAOmrNwDtqjUA6qw2AO2vNQDjpjoA6aw4AOir
PwDwrDgA67A3AO2xOQDssT8A8rIwAPazMwD2tzEA8bE2APq7NgDytDoA+Lc6APW5PAD5uToA+bw7APi7
PQD5vD0A/L49APzAPgCxgEMAv4VAALaFSAC5h0sAvJZmALyacgC5mnYAxYlBAMOLRgDHi0QAyY1GAMaO
SgDJj0oAyZBEAMyQSgDPlEkAypFNAM6TTADNlE4A0pVHANebQwDUnUUA0JRNANaaSgDDkVUAzpZWAM2X
WwDOmVsAzZpdANGZVgDUmlcA0ppaANOcWwDQnF4A16BHANqiSADapUkA3adLAN2lTQDbo1QA1KFeANql
WwDgpkMA4KtOAO6sSwDxrUYA8rdAAPGxRQD1uUAA+r1AAPSySADirl0Ax5ljAMOYZgDFmWUAz51gAM+f
ZADBnG4AxJ1uANGeYgDQnmUA0aBjANalYwDVoWQA2KRgAN+sYwDbqWYA3aplAN2sZwDRo2sA1KdrANWl
bADZqmoA3q5qAMWhcgDNpHMAzKV1AMmmeQDUqXAA1Kp5ANuwcADhrWAA569jAOCvaQDismgA5LRoAOGy
bADitGwA+8BDALGchQCxnokAxa2OAMqwkQDPs5MA1LiXAN3AngDjwJYAAAAAAP///wAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADc2b4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAOy6sLjRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAA+7oVbN2+ogAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAulgR
DLTFuvYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAC6aCMREQzGvroAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAALisLxsUERET4Nm4AAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAA6awxJhsbGxERLuC+0QAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAD6rGArJiYdGxsREV7gvqIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACoYz4+NyYm
GxsbERGx3Lr2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKhsREM3PjcpJh8bGxQRw9y6AAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAtapFSEhGOzc3KSYfGxsbE+DauAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAADXpYJIT0hIRkY3NzcmJhsbGS7w2dEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
APqeipBPT01IRkZGPjc3JiYbGxFg8L6iAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJ5yzZdPT09NSEZG
Ozc3NyYmGxsZbvC49gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGnLzpd5T09PTk1GRkZDNzcmJh0bEcHj
ugAAAAAAAAAAAAAAAAAAAAAAAAAAAACgnsuX9fV5V1dPT05NRkZGNzc3Jh8fGyPu47cAAAAAAAAAAAAA
AAAAAAAAAAAAAKELjs719fV+V09XT05OTkhGRjdDNyYmHxsv8dnRAAAAAAAAAAAAAAAAAAAAAAAA+AmI
l/X1l/WTV1dXV09PTk5IRkY3NzcpJh0bYPG+ogAAAAAAAAAAAAAAAAAAAAAACGrLl8719fWXeVdXT1RX
Tk5NSEZGRjc3KSYdG27tvvcAAAAAAAAAAAAAAAAAAAAIZo7Ll87OzvX1fldXVFRTT1dOTUhGRjs+NyYm
JhvC67YAAAAAAAAAAAAAAAAAAJ0JgZDLy8uczs7Ofld5eVdPVE9PTk1IRkY7NzcpJh8i0Ou4AAAAAAAA
AAAAAAAA1whxjI6Qy5PLl/XOl3l5V3l5eVdPV05NTUZGRjs3KSYfMPHj6QAAAAAAAAAAAAAABGOBjIyU
k8uXnJf1l3l5eXl5V1dXT1dOTU1GRjw7NzYfHzPxvvwAAAAAAAAAAACfWnFwf4CAgoyLy4yXznlPeVR5
V1dXV05XTneLz8/Pz8/Pz8/J79wAAAAAAAAAAADqAQECAgMDAwQEBAaXznx5VHl5V1dXV1dPV5WkpKam
pqarp6ezs/0AAAAAAAAAAAAAAAAAAAAAAAAAAASXy5NQVXlUeXlXV1dXTpWkAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAASXy5NPVVVUeXlXV1dXV5dnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAASQy8t4UFVVeVR5eVdXV5dnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOQjst8TFBV
VVR5eXlXeZeeAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKMjJCOUFBQT1V5VHl5eZcWAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKCjI6MdEhPVU95VXlUeZwKAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAKCgoKOdkh0UE9VVXlUeZwKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAJ/f4KCgkhITExPT1VVeZwJAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAF/f4GMjHNG
SExPVU95VZwJAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAF1cXF/iHVGRkh0UFBQT5wJAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFlZXF/f4FDQ0ZGSExPVZcGAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAFlZWVxdX9vLENGRnRQT5cJAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAFvY2VlcXFxKT9BRkZMTMsEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFjY2RlZXFx
NSwsRkZGTJMEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFgY2NkZWVxYSksPz9GRssEAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFgWVlkY2RxcTIoLCxGRowEAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAFZWWRZZGRkcTQdLCw/Q4wDAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAFYWVljWWRjZGQyHSgogYECAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOcBv7+/wcHB
wsjHZXFxdQHnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADnAQEBAQEBAQEBAQEBAecAAAAA
AAAAAAAAAAAAAAAAAAD///////8AAP///////wAA////////AAD///j///8AAP//8H///wAA///gP///
AAD//+Af//8AAP//wB///wAA//+AD///AAD//wAH//8AAP/+AAP//wAA//4AAf//AAD//AAB//8AAP/4
AAD//wAA//AAAH//AAD/4AAAP/8AAP/gAAAf/wAA/8AAAB//AAD/gAAAD/8AAP8AAAAH/wAA/gAAAAP/
AAD+AAAAAf8AAPwAAAAB/wAA+AAAAAD/AADwAAAAAH8AAPAAAAAAPwAA4AAAAAA/AADgAAAAAD8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//
AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//wAAf//AAD//AAB//8AAP/8
AAH//wAA//wAAf//AAD//AAB//8AAP/8AAH//wAA//4AA///AAAoAAAAIAAAAEAAAAABAAgAAAAAAAAE
AAAAAAAAAAAAAAABAAAAAQAAAAAAAKdIAACpSgAArU0AALBSAACxVQAAtFYAALdYAAC5WwAAuVwAALxe
AAC/YQAAvGgNALllFwC5Zx8AtWUpAMJkAADFaAAAyGsAAMxuAgDOcQYA0nYJANR5DQDFdREAz34aANd8
EADafxMA0IAGANSDBQDThAYA1YUFANiJBwDThg8A2YoIANqNCQDcjQoA25AKAN2QCgDekQ0A35UNAN2A
FgDXjxAA2Y4UAN6DGQDWjBsA3ZEQAN6UFgDdmBgA4JMKAOCSDQDhlQ4A5ZcPAOSZDgDghhsA44geAOSW
EADjmxEA5ZoQAOScEQDnnxQA6Z0SAOWcGgDpoBIA6aEUAO2iFADtpBYA5qAZAO+oGgDwphcA8acYAPGp
GAD0qxkA86waAPSsGgD1rhwA9rAbAPawHAD4sBoA+LEcAMyAIADXhSMA0IUnAN+NKgDRkScA2pYhAN2b
IwDcmyUA05MoANWWKQDali8A2ZksANucLQDcnS4A3Z0xAN2TOwDblT8A1po7ANKYPADVmj0A154+AOaO
JADjkCoA5ZIuAOqTKgDtkysA7ZQrAOiTLQDulSwA4pIxAOmWMQDrlzUA6J02AOOaOQDgnTwA6pw5APCa
NADynj0A36AvAN6hMADdoDgA2aE/AOSgIQDioSYA7KchAO2oJgDgoCkA6agrAPewIAD5tCIA+bQnAPOx
KAD5tigA+bcvAOOmMgDjpjQA5KU0AOepNQDnrD8A6Ko4AOyvOADprj8A86A/AO+zOgDysjAA8LE3APe4
NgD7ujEA8rY7APCzPQDytj4A9Lg6APW6PQD7vDoA+b0+AMWARADPkEUA3ZlEANmbTQDPnF8A0phUAOqe
QgDdoEEA2aJGAN2kRADep0kA3aVOANuiUADdplQA4ahGAO2qRwDooEgA4alKAOOtTQDzoUAA869EAPap
TgDsskAA77JGAOewTgDusUoA6rBMAPC1QwD0ukUA9rxGAPm9QQDwskkA8rVNAPe+SAD1uk8A+L5IAPWp
UADyqlQA6rRRAO22UgDuuFQA47BbAPCyUQD0vFAA8r5WAPC2XAD4sV0AyZ5nAMSlfwDfr3MA2K19AOWt
YgDltmcA67NgAOm5YQDsu2oA77ptAPW+awDwvm0A+bhpAOizcQDiu34A7Lt9APS9cAD7wEIA+8FGAPnA
SAD4wk4A+MNZAPnEWgD6w2AA/ctkAMOnhQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAABta58AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAbc2/a8oAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKpvpabIawAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADWcqgdHaa/awAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAG2JLR8dIM6tXgAAAAAAAAAAAAAAAAAAAAAAAAAAAABlsT0xIx8dLNJzngAAAAAA
AAAAAAAAAAAAAAAAAAAAUq58PDMxIyMdWdVr4gAAAAAAAAAAAAAAAAAAAAAAAJypj0REMzMxJSMdochr
AAAAAAAAAAAAAAAAAAAAAADLcN9KRURERDMxJSMjw69lAAAAAAAAAAAAAAAAAAAAAFDhuH9KSkQzRDMx
JSMq0o1fAAAAAAAAAAAAAAAAAAAY4Nu4gUdHQ0VEM0QlJSNU2XPJAAAAAAAAAAAAAAAAT8TcuNuSTUpK
R0REMzsxJSNd1WsAAAAAAAAAAAAAAJtw3bi425hNTUpKSkRERDMzMSOryGsAAAAAAAAAAADMUd2Vl7i4
mIFNTU1KSkRERDMzMSXQr2wAAAAAAAAAABfBsJOXmLi4g01NTU1KSkRERDk5MS3ZdJ0AAAAAAAAMz7S0
urrFxbiETYFNTU1KSo+xlbq6tMfTa9gAAAAAAJoGBgYGCQkL35FLTU2BTU1KthkZKys1NmSgAAAAAAAA
AAAAAAAAAAnfl0pLTU1NgU29FgAAAAAAAAAAAAAAAAAAAAAAAAAABt2VgkpNgU1NTdwVAAAAAAAAAAAA
AAAAAAAAAAAAAAAGxrGPSkpKTU2B2xQAAAAAAAAAAAAAAAAAAAAAAAAAAAbCi5BDREpLTU3cEwAAAAAA
AAAAAAAAAAAAAAAAAAAABMGIi3xAR0pLTdwTAAAAAAAAAAAAAAAAAAAAAAAAAAADsoWKjzlEQ0pL3BEA
AAAAAAAAAAAAAAAAAAAAAAAAAAOrhYWFOztEREq7EQAAAAAAAAAAAAAAAAAAAAAAAAAAA6tdXIV5OTtE
Q7YLAAAAAAAAAAAAAAAAAAAAAAAAAAABpVxcdn0nMztEtgkAAAAAAAAAAAAAAAAAAAAAAAAAAAGhWFpd
di8nMzu1CQAAAAAAAAAAAAAAAAAAAAAAAAAAAaVTWFxdViUnJ7EGAAAAAAAAAAAAAAAAAAAAAAAAAAAB
YFNYWFhcKSQnsAYAAAAAAAAAAAAAAAAAAAAAAAAAAA/XYWBjoaF3VFZWDQAAAAAAAAAAAAAAAAAAAAAA
AAAAAA8BAQEBAQEEBA4AAAAAAAAAAAAAAAD///////x////4P///8D///+Af///gD///wAf//4AD//8A
A//+AAH//gAA//wAAH/4AAB/8AAAP+AAAB/gAAAPwAAAB8AAAA//gAf//4AH//+AB///gAf//4AH//+A
B///gAf//4AH//+AB///gAf//4AH//+AB///gAf//8AP/ygAAAAYAAAAMAAAAAEACAAAAAAAQAIAAAAA
AAAAAAAAAAEAAAABAAAAAAAApWYWAKhpGQCqbBsAqm0dAKxuHgCucCEAsHMjALJ2JgC2eioAuH4uALyC
MgC9gzQAvoU1AN+YEwDklw8A5ZkQAOmdEgDooBIA6aEUAO2hFQDtpRYA8KYXAPGqFwDxpxgA8qoZAPSr
GgD0rRoA86wcAPauHAD3sBoA97AcAPmwGgD4sRwAwIY3AMGJOQDDizwAxIs8AMWNPgDjnSUA5J4nAN6g
MADnoyAA5aAnAOSjKQDgoi8A7awpAPCsIwD6syIA+rcrAOKlMwDqqzIA6Kk3AOSpOgDpqz0A+rozAPq6
NADytjsA97s+APe8PAD5uzgA36VCAN+sVADgqUQA5axHAOmuQADkrUoA6bNKAO63TgDws0EA9btDAPS6
RQD6vkEA9LxMAPm+SADhrlUA5LJZAPK7UAD7wEMA+8NOAPbBUAD6xFIA+8VUAPDDaQD0xmwA9shtAPjK
bgD6zW8A8cmCAPPMhAD0zoYA99CHAPDPmQDw0JkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAD///8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAmAAAAAAAA
AAAAAAAAAAAAAAAAAAAAACZcJgAAAAAAAAAAAAAAAAAAAAAAAAAAJjYnXSYAAAAAAAAAAAAAAAAAAAAA
AAAiRREPJ10mAAAAAAAAAAAAAAAAAAAAAAtHFhYQECddJgAAAAAAAAAAAAAAAAAACkobGxYRERAnXSYA
AAAAAAAAAAAAAAAJUjAbGxgbFhEQKF0mAAAAAAAAAAAAAAhSTjEgGxsbFhYRECtdJgAAAAAAAAAABjpI
SDggICAbGBgWERAnXSYAAAAAAAAFOVBSUk84IDAgGxtUW1paWlwmAAAAAAAABQUGBgg8IDAgMBtWCwsL
IiIAAAAAAAAAAAAAAAY6HiAgMCBXCgAAAAAAAAAAAAAAAAAAAAVHGx4wICBXCgAAAAAAAAAAAAAAAAAA
AAVJGxseMCBXCQAAAAAAAAAAAAAAAAAAAAVJLxsbHjBXCAAAAAAAAAAAAAAAAAAAAAFELhYcGx5XCAAA
AAAAAAAAAAAAAAAAAAFDMxMVGxtXBgAAAAAAAAAAAAAAAAAAAAFANCsWFhxVBgAAAAAAAAAAAAAAAAAA
AAE/MisOEBZVBQAAAAAAAAAAAAAAAAAAAAE9KS0OEBNUAwAAAAAAAAAAAAAAAAAAAAE+S0xAND9TAwAA
AAAAAAAAAAAAAAAAAAABAQEBAwEBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA////AP/v
/wD/x/8A/4P/AP8B/wD+AP8A/AB/APgAPwDwAB8A4AAPAMAABwDgAA8A/gD/AP4A/wD+AP8A/gD/AP4A
/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP8B/wD///8AKAAAABAAAAAgAAAAAQAIAAAAAAAAAQAAAAAAAAAA
AAAAAQAAAAEAAAAAAAClZhYAsnYmALN4KQC4fi8A1Y0XANWOGADXkBkA2pUbANuVHADclhwA3poeAOCc
HwDgmyAA46EiAOaiIwDmpiMA56cnAOilIwDppiUA66omAO2rJwDuricA46YsAOyrKADurikA7q4sAPCv
KQDvsS4A8LAqAO2vMQDkpjgA5q8+AOqwOADwszIA4qtBAOi0TwDyvEoA7LlSAOSyXADnt18Aw5ljAMui
bQDqumEA5LhoAOa7cADpv3MA78FlAPDFdgDyyXkA88x6APXNegD20IAA6MeQAOnIkQDpyZcAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAP///wAAAAAAAAAAAwAAAAAAAAAAAAAAAAAAAzcCAAAAAAAAAAAAAAAAAycFNQIAAAAA
AAAAAAAAAysLCAY1BAAAAAAAAAAAAy8SDg0IBjUEAAAAAAAAAzMaFBIODQgINQQAAAAAAzQlIhQaEg4f
Li01BAAAKQEBAQEbGhQUMAQEBAQqAAAAAAABGxsbFDMEAAAAAAAAAAAAARwbGxszBAAAAAAAAAAAAAEe
FBsbMwQAAAAAAAAAAAABIRQcHDMEAAAAAAAAAAAAASARFBQzBAAAAAAAAAAAAAEjFw4WMwQAAAAAAAAA
AAABLCgkJjMDAAAAAAAAAAAAAAEBAQEBAAAAAAAA/v8AAPx/AAD4PwAA8B8AAOAPAADABwAAgAMAAAAB
AADwHwAA8B8AAPAfAADwHwAA8B8AAPAfAADwHwAA+D8AACgAAAAwAAAAYAAAAAEAIAAAAAAAgCUAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAADAAAABgAAAAgAAAAGAAAAAwAA
AAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAMAAAAFgAA
ABsAAAAWAAAACwAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAA
AAwAAAAfAAAAMwAAADwAAAAyAAAAHQAAAAsAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAACAAAACSccDyHPllLiypFQ4M2UUesdFQtZAAAANQAAABoAAAAJAAAAAgAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAEAAAAHAAAAF8aOTb/RlU3z0pVH/82UU/K/iUvcAAAAUAAAADAAAAAWAAAABgAA
AAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUAAAATs4BGjtOXUfXLfxn/0pE5/9ikYP7Rl1T3pXdBvQAA
AEoAAAAqAAAAEgAAAAUAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAA+RaDhc0ZdR+M6HJv3Legf/yHUA/9aa
Sv/Tn1v51JlU+nxZMZcAAABDAAAAJAAAAA4AAAADAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAADFg/ITLPlE/1z4wz+NGC
DP/NewD/y3gA/8l3BP/apVv/zZdV89OYU/hHMxxzAAAAPAAAAB8AAAALAAAAAgAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAAAJJxwOIMiO
SuHNj0Dy1YkR/9ODBf/QfwH/zXsA/8t4AP/MfA3/3apl/8yXV/DLklDuHBQLXQAAADYAAAAaAAAACAAA
AAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAA
AAcAAAAXu4VEvMuPRvPajhf/2osK/9aIBv/UgwX/0YAD/819Af/LeQD/z4Qa/92sZ//OmFfyvYhL2QAA
AE8AAAAvAAAAFQAAAAYAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAABAAAABQAAABOodjyMyY5H9tuTH//ekg7/3Y4K/9qLCP/Whwb/1IMF/9GAA//PfQD/y3kA/9OO
Lf/bqWX90plW96R2QbsAAABJAAAAKQAAABEAAAAFAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAEAAAAD4hfL1rHjEb42ZUq/eOXFf/jlQ7/35IN/92OCv/aiwn/14gG/9SE
Bf/SgQT/z34B/8t6AP/Xm0P/1qNg+dKYU/p6WDCVAAAAQgAAACMAAAAOAAAAAwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAAALUzkcMsSJQvPRkTL3550Y/+ecEf/lmBD/45UP/+CS
Df/djgr/24sJ/9eIB//VhAb/0oED/9B+Af/NfAP/26NU/9CcXPPSllP4RzMccwAAADsAAAAeAAAACgAA
AAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAAkUDgYeu4I938eLO/Lpnxv/7qIU/+qg
E//onRL/5pkR/+SWDv/gkw3/3o8L/9uMCf/ZiQf/1YUG/9OBBP/QfwP/zn8J/9+sY//Nmlvwy5JQ7RYQ
CVoAAAA0AAAAGQAAAAgAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAABwAAABaueDe4wYY98+qq
Mf/vphb/8KYX/+2iFf/roBP/6J0S/+aZEf/klw//4JQO/96QCv/bjQn/2YoI/9WFBv/TgwT/0H8D/9GG
Ff/gr2n/z5pb87qHSdYAAABOAAAALgAAABQAAAAGAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAFAAAAEpxr
MIe9gjr36Ks///azM//zqRj/8agY//CkF//uoxX/66AU/+mdEv/mmhD/5JcP/+GUDf/ekAr/240K/9mJ
B//Whwb/04IE/9B/Af/Ujyb/3q5p/dKZV/ifcj62AAAARwAAACgAAAARAAAABAAAAAEAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAMAAAAOfVUkV7p/N/jcoT389rlB//m4Of/1rBv/86oZ//GoGP/wphf/7qMV/+ugE//pnhL/55oR/+SX
EP/hlQ7/3pIL/9yNCf/aiwf/1ocF/9ODBP/RgAP/2Js6/9ioZvjTmFT6dlYukQAAAEEAAAAjAAAADQAA
AAMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAgAAAAtGMBQvtXsz8sySOPb1uUD/+75B//q8Pf/4sB//9Kwa//OrGv/yqRn/8KYX/+6j
Ff/roBT/6Z4T/+ecEf/kmBD/4ZUO/9+SC//djgn/2ooI/9aHBv/UgwT/0YAC/9ylT//So2Tzz5VR90Mw
GnAAAAA6AAAAHQAAAAoAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAACAAAACRIMBR2udS/cvYI08/K3QP/7v0H/+79B//u+Qf/4syX/9q0a//Ws
G//zqxr/8akZ//GmGP/uoxX/7aEU/+qeE//nnBH/5ZgP/+GVDv/fkg3/3I4K/9qLB//WiAf/1IQF/9KE
Cv/hrWD/z55i8MmPTusPCwZXAAAAMwAAABgAAAAIAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAHAAAAFqJtKba0eTDz7LE///q+Qf/7v0H/+79B//vA
Q//6tiz/+K4a//auG//1rRr/9Ksa//KpGf/wpxj/76MX/+2hFP/pnxP/6JwS/+WYD//hlQ//35IN/92O
Cv/aiwn/14gH/9SEBf/ViRP/4rJo/8+cXfS4hEjVAAAATQAAAC0AAAAUAAAABgAAAAEAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUAAAASjl8jgq91LPfjpjr/+Ls///q+
Qf/7v0H/+79B//vAQ//7vDb/+bEc//iwHP/2rhz/9a0b//SrGv/yqhn/8agY/++kF//toRT/6p8T/+ic
Ev/lmRD/45YO/9+TDf/djwv/2owI/9eJB//UhQT/2JEj/+Gya/zRmVf5mm48sQAAAEYAAAAnAAAAEAAA
AAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAA5zTBtTrXIp+NOY
NPzytz3/+bw+//q9QP/6vkH/+79B//u/Qf/7vj7/+rMg//mxHP/4sBz/9q4c//WsG//0rBr/86oZ//Go
GP/vpBf/7aEV/+qfE//onRH/5ZkQ/+OWD//gkw7/3Y8J/9uMCP/XiQf/1YQG/9uaNv/armz30phU+nJR
LI0AAABAAAAAIgAAAAwAAAADAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAACzom
DSyobyXxv4Ut9e2wOv/1ujz/+Ls9//m8QP/6vUD/+r5B//u/Qf/7v0L/+rUn//mxG//5sR3/+LAc//au
HP/1rRv/9Kwa//OqGf/xqBj/76QX/+6iFf/roBP/6JwS/+aZEP/klg//4JMN/96OC//bjQn/2YkI/9WF
Bv/fpkz/06Zp8s2TUPY/LRhtAAAAOQAAABwAAAAJAAAAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAEGRAFFKRqI9mwdibx56o3//G0Ov/ztjv/9bo8//a7Pv/5vED/+r1A//q+Qf/7wEP/+rgu//mx
G//5sh3/+bId//ixHP/2sBz/9a0b//SrGv/yqhn/8agY//CmF//uoxX/6qAT/+mdEf/mmRD/5JYP/+CT
Dv/ejwr/3IwK/9mJB//Whwn/4q5d/9GiZ+7Hj0znEg0HSAAAACcAAAAPAAAAAwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAGoGcgpaluIvLdoDP/6q03/++yOf/xtDr/87Y7//S4PP/2uz3/+bw+//m9
QP/6vkL/+rs3//myHP/5sh3/+bId//myHf/5sR3/+LAc//WtHP/0rRv/9KsZ//KpGP/wphf/7qMV/+ug
E//onhL/55oR/+SXD//hlA3/3pAL/9yNCf/Zigf/2I0S/+S0aP/ToGPwvolJxAAAACcAAAARAAAABQAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiaB9ppmsg9dKVL//nqjX/67A3/+6yOP/wtDr/87Y7//W4
PP/4uz3/+b0+//m9QP/5vUD/+rw7//myHv/5sh3/+bId//myHf/5sh3/+LEd//iwHP/2rhv/9awb//Or
Gv/xqBn/8KYY/+6jFf/roBP/6p4Q/+icDv/llw3/4ZQK/9+QCf/cjQb/2okF/9mRHf/ismj40ZVQ9MGK
SogAAAALAAAAAwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACmaR7PyYgn+uSdL//loDD/56Iy/+qk
M//rpjT/7qk3//CrOP/xrTn/8a05//CxOP/4vD7/+bxA//izJP/4sRz/+bId//myHf/5sh3/+bId//mx
Hf/4sBz/9q4c//WsG//zqxr/8qkY//GrI//xsDr/8bFF//W0Sf/2s0n/9LJI//OwSP/yr0f/8a1G//Cs
R//urEv/5ahV6dGVT+AAAAAEAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACkaR2XpGoe/6Vq
H/+mayD/pmwh/6hsIv+pbSP/qW4k/6twJf+scCf/rXIn/65zKf/6vDz/+LxA//a1Kv/2sBr/+bEd//my
Hf/5sh3/+bId//myHf/5sR3/+LAc//auHP/1rRv/9Ksa//a3Ov/EiED/xYlB/8aKQ//Hi0T/yY1G/8qO
R//Lj0n/zJBK/82RS//Ok0z/0JRN/9GVTpcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAK1yJ//5uzv/9rs+//a3
Mf/1rhr/9rAc//iyHf/5sh3/+bId//myHf/5sh3/+bEd//iwHP/2rhz/9a0b//m5Ov/Chj//AAAAKwAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKtw
Jf/4tzr/9Lg9//W3OP/0rRz/9a4b//awHP/4sh3/+bId//myHf/5sh3/+bId//mxHf/4sBz/9q4c//q8
O//AhT3/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKpvJP/0tTn/8rU8//O2Pf/zsSf/86wZ//WuG//2sBz/+LEd//myHf/5sh3/+bId//my
Hf/5sh3/+LEc//u9PP+/gzv/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKluI//yszf/77M6//K1Pf/ysjD/8aoY//SsGv/1rhz/9rAc//ix
Hf/5sh3/+bId//myHf/5sh3/+bId//y+Pf+9gTn/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKdtIv/wsDb/7bA5//CzO//xszj/8Kkb//Gq
Gf/yqxr/9a4b//awHP/4sR3/+bId//myHf/5sh3/+bId//y/Pv+7gDf/AAAAKwAAAA4AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKZrIf/tqzT/6qw3/+2w
OP/vsjr/7qog/+6nFf/xqhn/86wa//StG//2sBz/+LEd//myHf/5sh3/+bId//zAPv+5fjX/AAAAKwAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKZq
IP/pqTL/56k0/+qsN//tsDn/7asp/+2jFP/vqBj/8aoZ//KsGv/1rhv/9rAc//ixHP/5sh3/+bId//zA
Pv+4fDT/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKRqHv/mpC//5KYz/+epNP/pqzf/66wy/+mhFf/rpBT/7qcY//CqGf/zrBr/9K0b//Ww
HP/2sRz/+LId//zAPv+2ezL/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKRoHf/koi//4KIx/+SmMv/nqDb/6aw4/+ikIP/ooBL/7aQV/+6n
F//xqRn/8qwa//StG//1rhz/9rAc//zAPv+1eTD/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/goC3/36Aw/+CiMP/kpDP/56k2/+en
Lv/mnRL/6KAT/+ujFf/uphj/8KkY//KrGv/0rRv/9a4c//y+Pf+zeC7/AAAAKwAAAA4AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/enSz/3J0v/96f
L//goTD/5KYy/+anM//knRf/5Z0R/+igE//qoxX/7qYX//CpGP/yqxn/86wb//q9Pf+ydi3/AAAAKwAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNo
Hf/dnCr/25wt/9ydLv/eny//4KIw/+OmM//hniD/4ZgO/+WdEv/ooBP/6qIU/+6mF//wqBj/8qsa//m9
O/+wdCv/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKNoHf/bmCj/2Zgs/9qaLf/bnC7/3p8v/+CiMf/goCn/3pUO/+GZD//lnRL/6KAT/+qi
Ff/uphf/8KgY//a5O/+ucyn/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/XlSf/1ZYq/9mYLP/ami3/25wu/92eL//goTH/3Zga/96U
C//hmBD/5ZwS/+efE//qohX/7aYX//W4Ov+tcij/AAAAKwAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/WlCb/1JQo/9WVKf/XmCr/2pot/9uc
Lv/enzH/3Z0n/9uSC//elQ3/4ZgQ/+ScEf/nnxP/6qIU//K1OP+rcCb/AAAAJwAAAA0AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHf/TkiX/0pIo/9OU
KP/VlSj/15cq/9qaLf/bnC//3Z4v/9qSEv/ajwn/3ZUO/+CXD//knBH/558S//GyNv+qbyX/AAAAHwAA
AAkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNo
Hf/SjyT/0I8m/9KSJ//TlCj/1JUp/9eXKv/ZmS3/250w/9qWHv/WjAf/25IL/92UDf/hmBD/5JwR/+2v
Nf+pbiP/AAAAEwAAAAUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAKNoHf/RjCL/zY0l/8+OJv/RkCf/05Mo/9SUKf/Wlyn/2pkt/9qaLP/WjQ//1owI/9qP
Cv/dlA7/5aYz/+qsNP+obCL/AAAACAAAAAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKNoHZ6jaB3/1J1G/9SeRf/XoEf/2qJI/9qlSf/bpkn/3adL/+Cr
Tv/gpkP/25wr/92eLP/goi//46Uv/6ZqIP+jaR+gAAAAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACjaB2eo2gd/6NoHf+jaB3/o2gd/6No
Hf+jaB3/o2gd/6NoHf+jaB3/o2gd/6NoHf+jaB7/pWke/6RpHp4AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAD///Af//8AAP//
8B///wAA///gD///AAD//8AH//8AAP//gAP//wAA//8AAf//AAD//wAB//8AAP/+AAD//wAA//wAAH//
AAD/+AAAP/8AAP/wAAAf/wAA//AAAB//AAD/4AAAD/8AAP/AAAAH/wAA/4AAAAP/AAD/AAAAAf8AAP8A
AAAB/wAA/gAAAAD/AAD8AAAAAH8AAPgAAAAAPwAA8AAAAAA/AADwAAAAAB8AAOAAAAAADwAA4AAAAAAP
AADgAAAAAA8AAOAAAAAADwAA4AAAAAAPAADgAAAAAD8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8
AAB//wAA//wAAH//AAD//AAAf/8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8AAB//wAA//wAAH//
AAD//AAAf/8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8AAB//wAA//wAAH//AAD//AAAf/8AAP/8
AAD//wAA//4AA///AAAoAAAAIAAAAEAAAAABACAAAAAAAIAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJCKQwWOiQLMQAA
ADAAAAAfAAAACgAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACyHwmPemQ
KPPulSz/w3YbvwAAADgAAAAcAAAABwAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAatq
Hh3qkirx5a1i//KqVP/vly7/klgQiAAAADMAAAAXAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AABOMA0J5I4l1eidNv/dpU7/26JQ//iyXv/ulCz+SisDXQAAAC0AAAARAAAAAwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAABNyJIaPqmzb64ahG/9OEBv/QgAb/3aZU//WpUP/okCj4EgoARAAAACcAAAANAAAAAgAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAALOfhxj6JUt+eesP//dkRD/2IkH/9SDBf/Thg//5bZn//OhQP/ZhSHgAAAAPQAA
ACEAAAAKAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAACsWgUMeONJPjvskb/5Zwa/+CSDf/djgr/2IkH/9WEBf/WjBv/77pt//Ca
NP+6cRiwAAAAOAAAABsAAAAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAY5RDBfdhRrt869E/+2oJv/onRL/5ZgQ/+GUDf/djgv/2ooI/9WF
Bv/ali//+Lhp/++XLv+IUQyAAAAAMgAAABUAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG1YAVy+2pRfvzsjD/76UX/+yhFP/onRP/5ZkQ/+GU
Dv/dkAr/2osI/9aGBv/doEH/+bJd/+2TK/4rGQBQAAAALAAAABAAAAACAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABMl2D5TjmTb7+sVa//WsHP/yqRj/8KYX/+2i
FP/pnhL/5pkR/+KVDv/dkQv/24sI/9iJCv/jsFv/9qlO/+SOJfQAAABAAAAAJgAAAA0AAAACAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAK7bAtd14Qg+/3LZP/6vkH/97Ag//Sr
Gf/yqhn/8KYX/+2iFf/qnhP/5psR/+KWDv/fkQv/24wJ/9mOFP/su2r/86A//9WCHdgAAAA8AAAAIAAA
AAkAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABl1EBKc56Evb6w2D/+8FG//u/
Q//5tCf/9q0Z//SsGv/yqRr/8KYX/+6iFf/qnxP/55sR/+KWD//ekQz/24wJ/9uVIf/0vXD/8Jo0/6xo
EqMAAAA3AAAAGgAAAAYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAVIrAA7Hcwjm8LJR//rB
S//7v0H/+8BD//u6Mf/4sBr/9q4c//WsG//zqhn/8acY/+6jFf/qnxP/55sR/+OXDv/fkg3/240J/96e
Mv/6uGn/7ZUs/2Y+BWoAAAAxAAAAFQAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFv2sHv+Cd
PP74wk7/+r1A//q+Qf/7wEL/+7w6//mxHf/5sRz/964c//StGv/0qxr/8agY/+6iFv/rnxP/6JwR/+SW
EP/gkg3/3I0J/+KoSv/4sFz/6pIo/DokA1MAAAArAAAAEAAAAAIAAAAAAAAAAAAAAAAAAAAAAAAAA7Zj
CYbQhCT7879V//S4O//2uz7/+bxA//q+Qv/7vj//+bQi//mxG//5sh3/968c//WtG//zqhn/8agY/++l
Fv/roBP/6JwR/+WXD//gkg3/3pAP/+m5Yf/2qU7/4Ioi7QAAAD8AAAAlAAAADAAAAAIAAAAAAAAAAAAA
AACtWQRFxXMO++22Uv/vszr/8rY7//W5PP/4vD3/+r5B//q+Qf/5tij/+bEb//myHf/5sR3/97Ac//Wu
G//0qxr/8akZ/++kFv/roRT/6J0Q/+WYDf/gkwr/3pQW//C+bf/ynj3/z38axgAAACkAAAASAAAAAwAA
AAAAAAAAvWoGQrpiA/Trs2D/6rBL/e2ySv3xtEz987dN/fW6Tv30vE/9+L1A//m3L//4sRv/+bId//my
Hf/5sh3/+LAc//atHP/zqxv/87Iw//G1Q/7ws0f987VL/fGySv3vsEn98LZc/vW+a/7tlCv/4I0mmAAA
AAkAAAACAAAAAAAAAACtTgBIsVQCvLNXAP+xVQD/tFcA/7dYAP+5WwD/vF4A/71fAP/5wlLz97g2//aw
G//5sR3/+bId//myHf/5sh3/+LAc//auHP/3vEb/13wQ/9p/E//dgBb/3oMZ/+CGG//jiB7/5o4k/+eO
ItrnjiVwAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAulwA//jA
UfL1uTr/9K8e//awG//5sh3/+bId//myHf/5sh3/+LAd//i+SP/UeQ3/AAAALgAAAA0AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAC3WgD/87xP8vK2Pv/zsSj/9KwZ//awHP/4sR3/+bId//myHf/5sh3/+cBI/9J2Cf8AAAAuAAAADQAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAALRXAP/xuU3y8LM9//KyMv/xqhj/9K0b//avHP/4sh3/+bId//myHf/6wUj/znEG/wAA
AC4AAAANAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAsVQA/+61S/Lsrzn/8LE3/++oGv/xqhj/9K0a//awHP/4sR3/+bId//rB
SP/MbgL/AAAALgAAAA0AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwUgD/6bBI8ueqNv/srzj/7Kch/+2lFP/wqhn/9K0b//av
HP/4shz/+sFI/8hrAP8AAAAuAAAADQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAK9PAP/mrEXy46Yy/+iqOP/pqCv/6aET/+2m
Fv/xqRn/86wa//SuHP/5wEj/xWgA/wAAAC4AAAANAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAArUwA/+KpRPLfoTD/5KU0/+ep
Nf/moBn/6aAS/+2lF//wqRj/86wa//e+SP/CZAD/AAAALgAAAA0AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACqSwD/4KZC8tyd
L//foC//46Y0/+SgIf/kmw//6KEU/+ykFv/wqRj/9bxH/79hAP8AAAAuAAAADQAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKdJ
AP/do0Dy2Zot/9ydLv/fojL/4KAp/9+WD//knBH/6KAT/+2lFv/0ukX/vF8A/wAAAC4AAAANAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAp0gA/9mfPvLWliv/2Zos/9ydL//eoDD/3ZgY/9+VDP/kmxL/558U//C2Q/+5XAD/AAAALgAA
AA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAACnSAD/2J498tOTKP/Wlin/2Zks/9ydMf/cmyX/25AK/9+WDv/jmxH/7LJA/7dY
AP8AAAAsAAAADAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAKdIAP/Wmjr90ZEn/9OTKP/Vlin/2Zkt/9ucLf/XjxD/2Y8J/9+V
Dv/prj//tFUA/wAAAB4AAAAHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAp0gA1tWcRK/SmDz/1Zo9/9eePv/ZoT//3aRE/92g
OP/alyH/3Zsj/+KhJv+zVgHoAAAACwAAAAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACnSABLp0gA1qdIAP+nSAD/p0gA/6dI
AP+nSQD/qUkA/6pLAP+sTgD/sFIA4KJGAE0AAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAP/4D///8Af//+AH///gA///wAH//4AA//8AAP/+AAB//gAAP/wAAB/4AAAP8AAAD+AA
AAfgAAADwAAAAcAAAAGAAAABgAAAA/+AAf//gAH//4AB//+AAf//gAH//4AB//+AAf//gAH//4AB//+A
Af//gAH//4AB//+AAf//gAP/KAAAABgAAAAwAAAAAQAgAAAAAABgCQAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAADGjj9nxo4//8aOP2cAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMSMPGfFjD7/8M+Z/8aO
P//Gjj9nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAwok5Z8OKO//pqz3/450m//DQmf/Gjj//xo4/ZwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAC+hTZnwIY3//Cz
Qf/onBH/5JcP/+OdJf/w0Jn/xY4+/8aOP2cAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAALuBMme8gzP/9LpF/++mFv/soRT/6JwS/+WYEP/jnyb/8dCZ/8WN
Pv/Gjj9nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAuH0tZ7l/
L//5vkj/9Kwa//KpGf/wphf/7aEV/+meEv/lmRD/5J4n//DQmv/FjT3/xY0/ZwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAC0eClntnoq//vFU//6syL/964a//WsG//yqhr/8acY/+2i
Ff/qnhP/5ZkQ/+SfJ//x0Jr/xY09/8WOPmcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAALF0
JGeydib/+8ZU//vAQ//6tyv/+bAa//evHP/1rRv/86sZ//GnGP/tohb/6p8T/+aaEP/loCf/8dGZ/8SM
Pf/FjT5nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAArXAgZ69xIv/3uz7/+r1A//q/Q//6ujP/+bEb//my
Hf/3sBz/9a0b//OqGv/xpxj/7qMV/+qfE//nmhD/5Z8n//HQmv/Dizz/xY09ZwAAAAAAAAAAAAAAAAAA
AAAAAAAAq24e//K2O//2wVD/+sRS//vFVf/7w07/+ro0//myHf/5sh3/+LAc//WuHP/0qxr/9shs//fQ
h//0zob/88yE//HJgv/x0Zj/xIs8/wAAAAAAAAAAAAAAAAAAAAAAAAAAqWscdaptHf+sbx7/rnAg/69y
Iv+wcyP/+bs4//mxHP/5sh3/+bId//mxHf/2rhz/+Mpu/7yCMv+9gzT/voU1/8CGN//AiDj/wok6dQAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACucCH/97w8//ewGv/5sh3/+bId//my
Hf/5sRz/+cxv/7l/L/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAACsbh7/9btD//WtGf/3sRz/+bId//myHf/5sh3/+81v/7h8Lf8AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACqbB3/9LxM//Os
HP/1rRr/97Ed//myHf/5sh3/+85v/7Z6Kv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACpahr/8rtQ//CsI//xqhf/9K4b//exHf/5sh3/+85v/7N3
J/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACoaRn/7rdO/+2sKf/uphX/8qsa//StG//3sBz/+85v/7F1Jf8AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACmZxf/6bNK/+qrMv/qohX/7qYW//Kr
Gv/0rRv/+c1v/69yIv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAClZhb/5axH/+ipN//noyD/6aAR/+2lF//xqhn/98pu/61wIP8AAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/4KlE/+Kl
M//koyn/5JsQ/+igFP/tpRb/9sht/6ttHv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/36VC/96gMP/goi//35gT/+SbEP/ooBP/9MZs/6ps
G/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAClZhb/36xU/+GuVf/ksln/5K1K/+SpOv/prkD/8MNp/6hqGv8AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhZ1pWYW/6VmFv+lZhb/pWYW/6Vm
Fv+lZhb/pmcX/6doGHUAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAP///wD/x/8A/4P/AP8B/wD+AP8A/AB/APgAPwDwAB8A4AAPAMAA
BwDAAAcAwAAHAP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A/wD+AP8A/gD/AP4A/wD+AP8A////ACgA
AAAQAAAAIAAAAAEAIAAAAAAAQAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACxcSJds3gp/76DM18AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACycSJds3gp/+nJl/+ydib/voMzXwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACxcSJds3gp/+SyXP/VjRf/6MeQ/7J2Jv++gzNfAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACxciJds3gp/+q6Yf/emh7/2pUb/9WOGP/ox5H/uH4v/76DNF0AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AACycyNfs3gp/+/BZf/opSP/46Ei/+CbIP/blRz/1Y8Z/+jHkf+4fi//voM0XQAAAAAAAAAAAAAAAAAA
AACxciJes3gp//TNe//uriz/66om/+mmJf/moiP/4Jwf/9yWHP/XkBn/6ceR/7h+L/++gzRdAAAAAAAA
AACwcSJes3gp//bQgP/yvEr/8LMy/+6uJ//sqyj/6acm/+aiI//kpjj/6b9z/+a7cP/pyJH/uH4v/76D
NF0AAAAApWYWqqVmFv+lZhb/pWYW/6VmFv/wryj/764p/+yrKP/qpyX/8MV2/7h+L/+4fi//uH4v/7h+
L/+xdCWqAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/8LAr//CwKf/vryr/7asn//LJef+4fi//AAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAApWYW/++xLv/wryn/8LAq//CvKv/0zHr/uH4v/wAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKVmFv/trzH/7q4n//CwKv/wsCr/9s17/7h+
L/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/6rA4/+urJv/urin/768q//bO
e/+4fi//AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAApWYW/+avPv/npyf/66om/+6u
KP/2z3r/uH4v/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKVmFv/iq0H/46Ys/+am
I//rqyf/9M16/7h+L/8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAClZhb/5Lho/+e3
X//otE//7LlS//PMev+4fi//AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAu4Eyd6Vm
Fv+lZhb/pWYW/6VmFv+lZhb/wIc5dwAAAAAAAAAAAAAAAAAAAAAAAAAA/H8AAPg/AADwHwAA4A8AAMAH
AACAAwAAAAEAAAABAADwHwAA8B8AAPAfAADwHwAA8B8AAPAfAADwHwAA8B8AAA==
</value>
</data>
</root>

72
SCrawler/Download/ActiveDownloadingProgress.vb Normal file
View File

@@ -0,0 +1,72 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Namespace DownloadObjects
Friend Class ActiveDownloadingProgress
Private Const MinWidth As Integer = 450
Private MyView As FormsView
Friend Property Opened As Boolean = False
Private ReadOnly JobsList As List(Of DownloadProgress)
Friend Sub New()
InitializeComponent()
JobsList = New List(Of DownloadProgress)
AddHandler Downloader.OnReconfigured, AddressOf Downloader_OnReconfigured
Downloader_OnReconfigured()
End Sub
Private Sub ActiveDownloadingProgress_Load(sender As Object, e As EventArgs) Handles Me.Load
MyView = New FormsView(Me)
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
Opened = True
End Sub
Private Sub ActiveDownloadingProgress_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
MyView.ExportToXML(Settings.Design)
e.Cancel = True
Hide()
End Sub
Private Sub Downloader_OnReconfigured()
Const RowHeight% = 30
With TP_MAIN
If .Controls.Count > 0 Then
For Each c As Control In .Controls
If Not c Is Nothing Then c.Dispose()
Next
.Controls.Clear()
End If
.RowStyles.Clear()
.RowCount = 0
End With
JobsList.ListClearDispose
With Downloader
If .Pool.Count > 0 Then
For Each j As TDownloader.Job In .Pool
With TP_MAIN
.RowStyles.Add(New RowStyle(SizeType.Absolute, RowHeight))
.RowCount += 1
JobsList.Add(New DownloadProgress(j))
AddHandler JobsList.Last.OnTotalCountChange, AddressOf Jobs_OnTotalCountChange
.Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1)
End With
Next
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Percent, 100))
TP_MAIN.RowCount += 1
End If
Dim s As Size = Size
s.Height = TP_MAIN.RowStyles.Count * RowHeight + PaddingE.GetOf({TP_MAIN}).Vertical(TP_MAIN.RowStyles.Count) - TP_MAIN.RowStyles.Count * 2
MinimumSize = New Size(MinWidth, s.Height)
Size = s
End With
TP_MAIN.Refresh()
End Sub
Private Sub Jobs_OnTotalCountChange()
If JobsList.Count > 0 Then MainProgress.TotalCount = JobsList.Sum(Function(j) CLng(j.Job.Progress.TotalCount))
End Sub
End Class
End Namespace

190
SCrawler/Download/DownloadProgress.vb Normal file
View File

@@ -0,0 +1,190 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms.Toolbars
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Imports TDJob = SCrawler.DownloadObjects.TDownloader.Job
Namespace DownloadObjects
Friend Class DownloadProgress : Implements IDisposable
Friend Event OnDownloadDone(ByVal Message As String)
Friend Event OnTotalCountChange()
Private ReadOnly TP_MAIN As TableLayoutPanel
Private ReadOnly TP_CONTROLS As TableLayoutPanel
Private WithEvents BTT_START As Button
Private WithEvents BTT_STOP As Button
Private WithEvents BTT_OPEN As Button
Private ReadOnly PR_MAIN As ProgressBar
Private ReadOnly LBL_INFO As Label
Private ReadOnly Property Instance As API.Base.ProfileSaved
Friend ReadOnly Property Job As TDJob
#Region "Initializer"
Friend Sub New(ByVal _Job As TDJob)
Job = _Job
TP_MAIN = New TableLayoutPanel With {.Margin = New Padding(0), .Dock = DockStyle.Fill}
TP_MAIN.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100))
TP_MAIN.ColumnCount = 1
TP_CONTROLS = New TableLayoutPanel With {.Margin = New Padding(0), .Dock = DockStyle.Fill}
PR_MAIN = New ProgressBar With {.Dock = DockStyle.Fill}
LBL_INFO = New Label With {.Text = String.Empty, .Dock = DockStyle.Fill}
CreateButton(BTT_STOP, My.Resources.Delete)
If Job.Type = Download.Main Then
LBL_INFO.Margin = New Padding(3)
LBL_INFO.TextAlign = ContentAlignment.MiddleLeft
With TP_MAIN
.RowStyles.Add(New RowStyle(SizeType.Percent, 100))
.RowCount = 1
End With
With TP_CONTROLS
.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 30))
.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 150))
.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100))
.ColumnCount = .ColumnStyles.Count
.RowStyles.Add(New RowStyle(SizeType.Percent, 100))
.RowCount = 1
With .Controls
.Add(BTT_STOP, 0, 0)
.Add(PR_MAIN, 1, 0)
.Add(LBL_INFO, 2, 0)
End With
End With
TP_MAIN.Controls.Add(TP_CONTROLS, 0, 0)
Else
LBL_INFO.Padding = New Padding(3, 0, 3, 0)
LBL_INFO.TextAlign = ContentAlignment.TopCenter
CreateButton(BTT_START, My.Resources.StartPic_01_Green_16)
CreateButton(BTT_OPEN, PersonalUtilities.My.Resources.OpenFolderPic)
With TP_CONTROLS
With .ColumnStyles
.Add(New ColumnStyle(SizeType.Absolute, 30))
.Add(New ColumnStyle(SizeType.Absolute, 30))
.Add(New ColumnStyle(SizeType.Absolute, 30))
.Add(New ColumnStyle(SizeType.Percent, 100))
End With
.ColumnCount = 4
.RowStyles.Add(New RowStyle(SizeType.Percent, 50))
.RowCount = 1
With .Controls
.Add(BTT_START, 0, 0)
.Add(BTT_STOP, 1, 0)
.Add(BTT_OPEN, 2, 0)
.Add(PR_MAIN, 3, 0)
End With
End With
With TP_MAIN
With .RowStyles
.Add(New RowStyle(SizeType.Absolute, 30))
.Add(New RowStyle(SizeType.Percent, 100))
End With
.RowCount = 2
End With
TP_MAIN.Controls.Add(TP_CONTROLS, 0, 0)
TP_MAIN.Controls.Add(LBL_INFO, 0, 1)
End If
With Job
.Progress = New MyProgress(PR_MAIN, LBL_INFO) With {.DropCurrentProgressOnTotalChange = False}
With .Progress
AddHandler .OnProgressChange, AddressOf JobProgress_OnProgressChange
AddHandler .OnTotalCountChange, AddressOf JobProgress_OnTotalCountChange
End With
End With
If Job.Type = Download.SavedPosts And Not Job.Progress Is Nothing Then Job.Progress.InformationTemporary = Job.Host.Name
Instance = New API.Base.ProfileSaved(Job.Host, Job.Progress)
End Sub
Private Sub CreateButton(ByRef BTT As Button, ByVal Img As Image)
BTT = New Button With {
.BackgroundImage = Img,
.BackgroundImageLayout = ImageLayout.Zoom,
.Text = String.Empty,
.Dock = DockStyle.Fill
}
End Sub
#End Region
Friend Function [Get]() As TableLayoutPanel
Return TP_MAIN
End Function
#Region "Buttons"
Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click
Start()
End Sub
Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click
[Stop]()
End Sub
Private Sub BTT_OPEN_Click(sender As Object, e As EventArgs) Handles BTT_OPEN.Click
GlobalOpenPath(Job.Host.SavedPostsPath)
End Sub
#End Region
#Region "Start, Stop"
Friend Sub Start()
Job.Start(AddressOf DownloadData)
End Sub
Friend Sub [Stop]()
Job.Stop()
End Sub
#End Region
#Region "SavedPosts downloading"
Private Sub DownloadData()
Dim btte As Action(Of Button, Boolean) = Sub(b, e) If b.InvokeRequired Then b.Invoke(Sub() b.Enabled = e) Else b.Enabled = e
Try
btte.Invoke(BTT_START, False)
btte.Invoke(BTT_STOP, True)
Job.Progress.InformationTemporary = $"{Job.Host.Name} downloading started"
Job.Start()
Instance.Download(Job.Token)
RaiseEvent OnDownloadDone($"Downloading saved {Job.Host.Name} posts is completed")
Catch ex As Exception
Job.Progress.InformationTemporary = $"{Job.Host.Name} downloading error"
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, {$"{Job.Host.Name} saved posts downloading error", "Saved posts"})
Finally
btte.Invoke(BTT_START, True)
btte.Invoke(BTT_STOP, False)
Job.Stopped()
If Job.Type = Download.SavedPosts Then Job.Progress.TotalCount = 0 : Job.Progress.CurrentCounter = 0
End Try
End Sub
#End Region
#Region "Progress, Jobs count"
Private Sub JobProgress_OnTotalCountChange(ByVal Source As IMyProgress, ByVal Index As Integer)
RaiseEvent OnTotalCountChange()
End Sub
Private Sub JobProgress_OnProgressChange(ByVal Source As IMyProgress, ByVal Index As Integer)
MainProgress.Perform()
End Sub
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
If Not BTT_START Is Nothing Then BTT_START.Dispose()
If Not BTT_STOP Is Nothing Then BTT_STOP.Dispose()
If Not BTT_OPEN Is Nothing Then BTT_OPEN.Dispose()
PR_MAIN.Dispose()
LBL_INFO.Dispose()
TP_CONTROLS.Controls.Clear()
TP_CONTROLS.Dispose()
TP_MAIN.Controls.Clear()
TP_MAIN.Dispose()
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

110
SCrawler/Download/DownloadSavedPostsForm.Designer.vb generated Normal file
View File

@@ -0,0 +1,110 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class DownloadSavedPostsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim TP_BUTTONS As System.Windows.Forms.TableLayoutPanel
Dim TT_MAIN As System.Windows.Forms.ToolTip
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadSavedPostsForm))
Me.BTT_DOWN_ALL = New System.Windows.Forms.Button()
Me.BTT_STOP_ALL = New System.Windows.Forms.Button()
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_BUTTONS = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
TP_BUTTONS.SuspendLayout()
Me.TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'TP_BUTTONS
'
TP_BUTTONS.ColumnCount = 2
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_BUTTONS.Controls.Add(Me.BTT_DOWN_ALL, 0, 0)
TP_BUTTONS.Controls.Add(Me.BTT_STOP_ALL, 1, 0)
TP_BUTTONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_BUTTONS.Location = New System.Drawing.Point(2, 2)
TP_BUTTONS.Margin = New System.Windows.Forms.Padding(0)
TP_BUTTONS.Name = "TP_BUTTONS"
TP_BUTTONS.RowCount = 1
TP_BUTTONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BUTTONS.Size = New System.Drawing.Size(480, 37)
TP_BUTTONS.TabIndex = 0
'
'BTT_DOWN_ALL
'
Me.BTT_DOWN_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_DOWN_ALL.Location = New System.Drawing.Point(3, 3)
Me.BTT_DOWN_ALL.Name = "BTT_DOWN_ALL"
Me.BTT_DOWN_ALL.Size = New System.Drawing.Size(234, 31)
Me.BTT_DOWN_ALL.TabIndex = 0
Me.BTT_DOWN_ALL.Text = "Download ALL"
Me.BTT_DOWN_ALL.UseVisualStyleBackColor = True
'
'BTT_STOP_ALL
'
Me.BTT_STOP_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_STOP_ALL.Location = New System.Drawing.Point(243, 3)
Me.BTT_STOP_ALL.Name = "BTT_STOP_ALL"
Me.BTT_STOP_ALL.Size = New System.Drawing.Size(234, 31)
Me.BTT_STOP_ALL.TabIndex = 1
Me.BTT_STOP_ALL.Text = "Stop ALL"
Me.BTT_STOP_ALL.UseVisualStyleBackColor = True
'
'TP_MAIN
'
Me.TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.Inset
Me.TP_MAIN.ColumnCount = 1
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Controls.Add(TP_BUTTONS, 0, 0)
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 1
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(484, 41)
Me.TP_MAIN.TabIndex = 0
'
'DownloadSavedPostsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(484, 41)
Me.Controls.Add(Me.TP_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(500, 80)
Me.MinimumSize = New System.Drawing.Size(500, 80)
Me.Name = "DownloadSavedPostsForm"
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Saved posts"
TP_BUTTONS.ResumeLayout(False)
Me.TP_MAIN.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
Private WithEvents BTT_DOWN_ALL As Button
Private WithEvents BTT_STOP_ALL As Button
Private WithEvents TP_MAIN As TableLayoutPanel
End Class

52
SCrawler/DownloadSavedPostsForm.resx → SCrawler/Download/DownloadSavedPostsForm.resx
View File

@@ -117,62 +117,16 @@
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_BUTTONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_REDDIT.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_REDDIT_PR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_INST.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_INST_PR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="BTT_INST_OPEN.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<metadata name="TP_REDDIT_PR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="BTT_REDDIT_OPEN.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAABAAUAEBAAAAEAIABoBAAAVgAAABgYAAABACAAiAkAAL4EAAAgIAAAAQAgAKgQAABGDgAAMDAAAAEA

77
SCrawler/Download/DownloadSavedPostsForm.vb Normal file
View File

@@ -0,0 +1,77 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports SCrawler.DownloadObjects
Imports SCrawler.Plugin.Hosts
Friend Class DownloadSavedPostsForm
Friend Event OnDownloadDone(ByVal Message As String)
Private MyView As FormsView
Private ReadOnly JobsList As List(Of DownloadProgress)
Friend ReadOnly Property Working As Boolean
Get
Return JobsList.Count > 0 AndAlso JobsList.Exists(Function(j) j.Job.Working)
End Get
End Property
Friend Sub [Stop]()
If JobsList.Count > 0 Then JobsList.ForEach(Sub(j) j.Stop())
End Sub
Private Sub [Start]()
If JobsList.Count > 0 Then JobsList.ForEach(Sub(j) j.Start())
End Sub
Friend Sub New()
InitializeComponent()
JobsList = New List(Of DownloadProgress)
If Settings.Plugins.Count > 0 Then
Dim j As TDownloader.Job
For Each p As PluginHost In Settings.Plugins
If p.Settings.IsSavedPostsCompatible Then
j = New TDownloader.Job(Plugin.ISiteSettings.Download.SavedPosts)
j.AddHost(p.Settings)
JobsList.Add(New DownloadProgress(j))
End If
Next
End If
End Sub
Private Sub DownloadSavedPostsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
MyView = New FormsView(Me) With {.LocationOnly = True}
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
If JobsList.Count > 0 Then
For Each j As DownloadProgress In JobsList
AddHandler j.OnDownloadDone, AddressOf Jobs_OnDownloadDone
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Absolute, 60))
TP_MAIN.RowCount += 1
TP_MAIN.Controls.Add(j.Get, 0, TP_MAIN.RowStyles.Count - 1)
Next
Dim s As Size = Size
s.Height += (60 * JobsList.Count + JobsList.Count)
MinimumSize = s
Size = s
MaximumSize = s
End If
End Sub
Private Sub DownloadSavedPostsForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub DownloadSavedPostsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
[Stop]()
MyView.Dispose(Settings.Design)
End Sub
Private Sub Jobs_OnDownloadDone(ByVal Message As String)
RaiseEvent OnDownloadDone(Message)
End Sub
Private Sub BTT_DOWN_ALL_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_ALL.Click
Start()
End Sub
Private Sub BTT_STOP_ALL_Click(sender As Object, e As EventArgs) Handles BTT_STOP_ALL.Click
[Stop]()
End Sub
End Class

179
SCrawler/Download/DownloadedInfoForm.Designer.vb generated Normal file
View File

@@ -0,0 +1,179 @@
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class DownloadedInfoForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadedInfoForm))
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
Me.MENU_VIEW_SESSION = New System.Windows.Forms.ToolStripMenuItem()
Me.MENU_VIEW_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_UP = New System.Windows.Forms.ToolStripButton()
Me.BTT_DOWN = New System.Windows.Forms.ToolStripButton()
Me.BTT_FIND = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
Me.ToolbarBOTTOM = New System.Windows.Forms.StatusStrip()
Me.LIST_DOWN = New System.Windows.Forms.ListBox()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout()
'
'SEP_1
'
SEP_1.Name = "SEP_1"
SEP_1.Size = New System.Drawing.Size(6, 25)
'
'SEP_2
'
SEP_2.Name = "SEP_2"
SEP_2.Size = New System.Drawing.Size(6, 25)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_VIEW, Me.BTT_REFRESH, SEP_1, Me.BTT_UP, Me.BTT_DOWN, Me.BTT_FIND, SEP_2, Me.BTT_CLEAR})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(554, 25)
Me.ToolbarTOP.TabIndex = 0
'
'MENU_VIEW
'
Me.MENU_VIEW.AutoToolTip = False
Me.MENU_VIEW.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_VIEW_SESSION, Me.MENU_VIEW_ALL})
Me.MENU_VIEW.Image = CType(resources.GetObject("MENU_VIEW.Image"), System.Drawing.Image)
Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_VIEW.Name = "MENU_VIEW"
Me.MENU_VIEW.Size = New System.Drawing.Size(45, 22)
Me.MENU_VIEW.Text = "View"
'
'MENU_VIEW_SESSION
'
Me.MENU_VIEW_SESSION.AutoToolTip = True
Me.MENU_VIEW_SESSION.Name = "MENU_VIEW_SESSION"
Me.MENU_VIEW_SESSION.Size = New System.Drawing.Size(113, 22)
Me.MENU_VIEW_SESSION.Text = "Session"
Me.MENU_VIEW_SESSION.ToolTipText = "Show downloaded users by this session"
'
'MENU_VIEW_ALL
'
Me.MENU_VIEW_ALL.AutoToolTip = True
Me.MENU_VIEW_ALL.Name = "MENU_VIEW_ALL"
Me.MENU_VIEW_ALL.Size = New System.Drawing.Size(113, 22)
Me.MENU_VIEW_ALL.Text = "All"
Me.MENU_VIEW_ALL.ToolTipText = "Show all users (sorted by latest download)"
'
'BTT_REFRESH
'
Me.BTT_REFRESH.Image = Global.SCrawler.My.Resources.Resources.Refresh
Me.BTT_REFRESH.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_REFRESH.Name = "BTT_REFRESH"
Me.BTT_REFRESH.Size = New System.Drawing.Size(89, 22)
Me.BTT_REFRESH.Text = "Refresh (F5)"
Me.BTT_REFRESH.ToolTipText = "Force list refresh"
'
'BTT_UP
'
Me.BTT_UP.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.BTT_UP.Image = CType(resources.GetObject("BTT_UP.Image"), System.Drawing.Image)
Me.BTT_UP.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_UP.Name = "BTT_UP"
Me.BTT_UP.Size = New System.Drawing.Size(23, 22)
Me.BTT_UP.Text = "Up"
Me.BTT_UP.ToolTipText = "Up (F3)"
'
'BTT_DOWN
'
Me.BTT_DOWN.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.BTT_DOWN.Image = CType(resources.GetObject("BTT_DOWN.Image"), System.Drawing.Image)
Me.BTT_DOWN.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DOWN.Name = "BTT_DOWN"
Me.BTT_DOWN.Size = New System.Drawing.Size(23, 22)
Me.BTT_DOWN.Text = "Down"
Me.BTT_DOWN.ToolTipText = "Down (F2)"
'
'BTT_FIND
'
Me.BTT_FIND.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.BTT_FIND.Image = CType(resources.GetObject("BTT_FIND.Image"), System.Drawing.Image)
Me.BTT_FIND.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_FIND.Name = "BTT_FIND"
Me.BTT_FIND.Size = New System.Drawing.Size(57, 22)
Me.BTT_FIND.Text = "Find (F4)"
Me.BTT_FIND.ToolTipText = "Find in the main window"
'
'BTT_CLEAR
'
Me.BTT_CLEAR.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.BTT_CLEAR.Image = CType(resources.GetObject("BTT_CLEAR.Image"), System.Drawing.Image)
Me.BTT_CLEAR.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR.Name = "BTT_CLEAR"
Me.BTT_CLEAR.Size = New System.Drawing.Size(38, 22)
Me.BTT_CLEAR.Text = "Clear"
Me.BTT_CLEAR.ToolTipText = "Clear info list"
'
'ToolbarBOTTOM
'
Me.ToolbarBOTTOM.Location = New System.Drawing.Point(0, 389)
Me.ToolbarBOTTOM.Name = "ToolbarBOTTOM"
Me.ToolbarBOTTOM.Size = New System.Drawing.Size(554, 22)
Me.ToolbarBOTTOM.TabIndex = 1
'
'LIST_DOWN
'
Me.LIST_DOWN.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_DOWN.FormattingEnabled = True
Me.LIST_DOWN.Location = New System.Drawing.Point(0, 25)
Me.LIST_DOWN.Name = "LIST_DOWN"
Me.LIST_DOWN.Size = New System.Drawing.Size(554, 364)
Me.LIST_DOWN.TabIndex = 2
'
'DownloadedInfoForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(554, 411)
Me.Controls.Add(Me.LIST_DOWN)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(570, 450)
Me.Name = "DownloadedInfoForm"
Me.ShowIcon = False
Me.Text = "Downloaded items"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private WithEvents ToolbarTOP As ToolStrip
Private WithEvents MENU_VIEW As ToolStripDropDownButton
Private WithEvents MENU_VIEW_SESSION As ToolStripMenuItem
Private WithEvents MENU_VIEW_ALL As ToolStripMenuItem
Private WithEvents BTT_REFRESH As ToolStripButton
Private WithEvents ToolbarBOTTOM As StatusStrip
Private WithEvents LIST_DOWN As ListBox
Private WithEvents BTT_CLEAR As ToolStripButton
Private WithEvents BTT_FIND As ToolStripButton
Private WithEvents BTT_UP As ToolStripButton
Private WithEvents BTT_DOWN As ToolStripButton
End Class
End Namespace

47
SCrawler/DownloadedInfoForm.resx → SCrawler/Download/DownloadedInfoForm.resx
View File

@@ -117,6 +117,12 @@
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
@@ -136,9 +142,44 @@
TgDQASA1MVpwzwAAAABJRU5ErkJggg==
</value>
</data>
<metadata name="SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="BTT_UP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAEuSURBVDhPpZM9S8NQFIajg1b9BW6CoOLiV6Uu/gcF/RH+
gYa6dBQXQQyNttXNL3DUSRehxUEouLSjm2MzSCJ+lMdzaGggTWiiF1443POeh/fAvQZvDbjYgKstuN5O
JvVebvLz+oihBfYSHC+nUzmLkx8SgNL04mQlncqrOIURAWikvwJ2MwMAR7PSk/WiegMB1hzc7kgtPXux
vx8L0PpwGh4K8PkOjdNukjAkEqBxdfjehO8PeufZFsiMQBbEl40B6LAaavv+VOg0b6C6FiTpA+jw2Tqd
l3Pcuo1XswLVS7hPFbySAKz5borIFeRxdA6mcIvjeCG5xQm8vUnfGwfwIVRz8er54gBJFQD+85RHBaCf
yd8plSo5HHMYQ79kO58RmkgiJZJ42+YYX607fgE+Y9hMRvWbWAAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_DOWN.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAFASURBVDhPrZO7SgNBFEDXBxp/wVZNERRf0TT+gwr6B9aW
WSIolja+VpbERFsfiJAiCiIigrWdRmzsrDSLElA2Mcd7JSFCNrpRFw47M3vvmTuzMwYPV7AzAXtTsD/t
D43dnaR4f4GhDeKDkBhqjGQYJ9okArXpwOZwYyRHcGJtItCSfiuYC/y7QN5WD6x31WJ1S9yAxITrCOL9
sD0G1wdwm4abwypZ6d9lZOfHwe6tI0jIn1DJ5RJeT/58heeFTkp2nyRLFZ5LUImWe2pC4bWcKsnH8zzO
tuAuyzIk8Zs9UIm0VXIWg7cX8ieLkmzgrgVhK1KNqyuoYId4T8/wZLZSWJWZvyYrPwqEkhWkuBGC1Gjt
dz+CTypr9hgvC/5ylNtFoJdJD4fO1AipCI7ZjKFXMhcNiE2QknwhsTmzAzd7xAdy1dicvhZiDAAAAABJ
RU5ErkJggg==
</value>
</data>
<data name="BTT_FIND.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAIDSURBVDhPpZLrS5NhGMb3j4SWh0oRQVExD4gonkDpg4hG
YKxG6WBogkMZKgPNCEVJFBGdGETEvgwyO9DJE5syZw3PIlPEE9pgBCLZ5XvdMB8Ew8gXbl54nuf63dd9
0OGSnwCahxbPRNPAPMw9Xpg6ZmF46kZZ0xSKzJPIrhpDWsVnpBhGkKx3nAX8Pv7z1zg8OoY/cITdn4fw
bf/C0kYAN3Ma/w3gWfZL5kzTKBxjWyK2DftwI9tyMYCZKXbNHaD91bLYJrDXsYbrWfUKwJrPE9M2M1Oc
VzOOpHI7Jr376Hi9ogHqFIANO0/MmmmbmSmm9a8ze+I4MrNWAdjtoJgWcx+PSzg166yZZ8xM8XvXDix9
c4jIqFYAjoriBV9AhEPv1mH/sonogha0afbZMMZz+yreTGyhpusHwtNNCsA5U1zS4BLxzJIfg299qO32
Ir7UJtZfftyATqeT+8o2D8JSjQrAJblrncYL7ZJ2+bfaFnC/1S1NjL3diRat7qrO7wLRP3HjWsojBeCo
mDEo5mNjuweFGvjWg2EBhCbpkW78htSHHwRyNdmgAFzPEee2iFkzayy2OLXzT4gr6UdUnlXrullsxxQ+
kx0g8BTA3aZlButjSTyjODq/WcQcW/B/Je4OQhLvKQDnzN1mp0nnkvAhR8VuMzNrpm1mpjgkoVwB/v8D
TgDQASA1MVpwzwAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_CLEAR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8

191
SCrawler/Download/DownloadedInfoForm.vb Normal file
View File

@@ -0,0 +1,191 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports SCrawler.API.Base
Namespace DownloadObjects
Friend Class DownloadedInfoForm
Friend Event OnUserLooking(ByVal Key As String)
Private MyView As FormsView
Private ReadOnly LParams As New ListAddParams(LAP.IgnoreICopier) With {.e = EDP.None}
Friend Enum ViewModes As Integer
Session = 0
All = 1
End Enum
Friend Property ViewMode As ViewModes
Get
Return IIf(MENU_VIEW_ALL.Checked, ViewModes.All, ViewModes.Session)
End Get
Set(ByVal SMode As ViewModes)
Settings.InfoViewMode.Value = CInt(SMode)
End Set
End Property
Private ReadOnly _TempUsersList As List(Of IUserData)
Friend Sub New()
InitializeComponent()
_TempUsersList = New List(Of IUserData)
If Settings.InfoViewMode.Value = CInt(ViewModes.All) Then
MENU_VIEW_SESSION.Checked = False
MENU_VIEW_ALL.Checked = True
Else
MENU_VIEW_SESSION.Checked = True
MENU_VIEW_ALL.Checked = False
End If
Settings.InfoViewMode.Value = ViewMode
RefillList()
End Sub
Private Sub DownloadedInfoForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
If MyView Is Nothing Then
MyView = New FormsView(Me)
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
End If
BTT_CLEAR.Visible = ViewMode = ViewModes.Session
RefillList()
Catch ex As Exception
End Try
End Sub
Private Sub DownloadedInfoForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub DownloadedInfoForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MyView Is Nothing Then MyView.Dispose(Settings.Design)
_TempUsersList.Clear()
End Sub
Private Sub DownloadedInfoForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Dim b As Boolean = True
Select Case e.KeyCode
Case Keys.F5 : RefillList()
Case Keys.F2 : UpdateNavigationButtons(1)
Case Keys.F3 : UpdateNavigationButtons(-1)
Case Keys.F4 : BTT_FIND.PerformClick()
Case Keys.Enter : LIST_DOWN_MouseDoubleClick(Nothing, Nothing)
Case Else : b = False
End Select
If b Then e.Handled = True
End Sub
Private Class UsersDateOrder : Implements IComparer(Of IUserData)
Friend Function Compare(ByVal x As IUserData, ByVal y As IUserData) As Integer Implements IComparer(Of IUserData).Compare
Dim xv& = If(DirectCast(x, UserDataBase).LastUpdated.HasValue, DirectCast(x, UserDataBase).LastUpdated.Value.Ticks, 0)
Dim yv& = If(DirectCast(y, UserDataBase).LastUpdated.HasValue, DirectCast(y, UserDataBase).LastUpdated.Value.Ticks, 0)
Return xv.CompareTo(yv) * -1
End Function
End Class
Private Sub RefillList()
Try
_TempUsersList.Clear()
Dim lClear As Action = Sub() LIST_DOWN.Items.Clear()
If LIST_DOWN.InvokeRequired Then LIST_DOWN.Invoke(lClear) Else lClear.Invoke
If ViewMode = ViewModes.Session Then
_TempUsersList.ListAddList(Downloader.Downloaded, LParams)
Else
_TempUsersList.ListAddList(Settings.Users.SelectMany(Of IUserData) _
(Function(u) If(u.IsCollection, DirectCast(u, API.UserDataBind).Collections, {u})), LParams)
End If
If _TempUsersList.Count > 0 Then
_TempUsersList.Sort(New UsersDateOrder)
For Each user As IUserData In _TempUsersList
If LIST_DOWN.InvokeRequired Then
LIST_DOWN.Invoke(Sub() LIST_DOWN.Items.Add(user.DownloadedInformation))
Else
LIST_DOWN.Items.Add(user.DownloadedInformation)
End If
Next
If _LatestSelected >= 0 AndAlso _LatestSelected <= LIST_DOWN.Items.Count - 1 Then
Dim aSel As Action = Sub() LIST_DOWN.SelectedIndex = _LatestSelected
If LIST_DOWN.InvokeRequired Then LIST_DOWN.Invoke(aSel) Else aSel.Invoke
Else
_LatestSelected = -1
End If
Else
_LatestSelected = -1
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadedInfoForm.RefillList]")
Finally
UpdateNavigationButtons(Nothing)
End Try
End Sub
Private Sub MENU_VIEW_SESSION_Click(sender As Object, e As EventArgs) Handles MENU_VIEW_SESSION.Click
MENU_VIEW_SESSION.Checked = True
MENU_VIEW_ALL.Checked = False
ViewMode = ViewModes.Session
BTT_CLEAR.Visible = True
RefillList()
End Sub
Private Sub MENU_VIEW_ALL_Click(sender As Object, e As EventArgs) Handles MENU_VIEW_ALL.Click
MENU_VIEW_SESSION.Checked = False
MENU_VIEW_ALL.Checked = True
ViewMode = ViewModes.All
BTT_CLEAR.Visible = False
RefillList()
End Sub
Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click
RefillList()
End Sub
Private Sub BTT_FIND_Click(sender As Object, e As EventArgs) Handles BTT_FIND.Click
Try
If _LatestSelected.ValueBetween(0, LIST_DOWN.Items.Count - 1) AndAlso _LatestSelected.ValueBetween(0, Downloader.Downloaded.Count - 1) Then
Dim i% = Settings.Users.IndexOf(_TempUsersList(_LatestSelected))
If i >= 0 Then RaiseEvent OnUserLooking(Settings.Users(i).Key)
End If
Catch ex As Exception
End Try
End Sub
Private Sub BTT_CLEAR_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR.Click
If LIST_DOWN.Items.Count > 0 Then
Downloader.Downloaded.Clear()
RefillList()
End If
End Sub
Private _LatestSelected As Integer = -1
Private Sub LIST_DOWN_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_DOWN.SelectedIndexChanged
_LatestSelected = LIST_DOWN.SelectedIndex
UpdateNavigationButtons(Nothing)
End Sub
Private Sub LIST_DOWN_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_DOWN.MouseDoubleClick
Try
If _LatestSelected >= 0 AndAlso _LatestSelected <= _TempUsersList.Count - 1 AndAlso
Not DirectCast(_TempUsersList(_LatestSelected), UserDataBase).Disposed Then _TempUsersList(_LatestSelected).OpenFolder()
Catch ex As Exception
End Try
End Sub
Friend Sub Downloader_OnDownloadCountChange()
If ViewMode = ViewModes.Session Then RefillList()
End Sub
Private Sub BTT_UP_Click(sender As Object, e As EventArgs) Handles BTT_UP.Click
UpdateNavigationButtons(-1)
End Sub
Private Sub BTT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_DOWN.Click
UpdateNavigationButtons(1)
End Sub
Private Sub UpdateNavigationButtons(ByVal Offset As Integer?)
Dim u As Boolean = False, d As Boolean = False
With LIST_DOWN
If .Items.Count > 0 Then
u = _LatestSelected > 0
d = _LatestSelected < .Items.Count - 1
End If
Dim a As Action = Sub()
BTT_UP.Enabled = u
BTT_DOWN.Enabled = d
End Sub
If ToolbarTOP.InvokeRequired Then ToolbarTOP.Invoke(a) Else a.Invoke
a = Nothing
If Offset.HasValue AndAlso .Items.Count > 0 AndAlso
(_LatestSelected + Offset.Value).ValueBetween(0, .Items.Count - 1) Then a = Sub() .SelectedIndex = _LatestSelected + Offset.Value
If Not a Is Nothing Then
If LIST_DOWN.InvokeRequired Then LIST_DOWN.Invoke(a) Else a.Invoke
End If
End With
End Sub
End Class
End Namespace

434
SCrawler/Download/TDownloader.vb Normal file
View File

@@ -0,0 +1,434 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Imports EOptions = PersonalUtilities.Forms.Toolbars.IMyProgress.EnableOptions
Imports SCrawler.API
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Hosts
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace DownloadObjects
Friend Class TDownloader : Implements IDisposable
Friend Event OnJobsChange(ByVal JobsCount As Integer)
Friend Event OnDownloadCountChange()
Friend Event OnDownloading(ByVal Value As Boolean)
Friend Event SendNotification(ByVal Message As String)
Friend Event OnReconfigured()
Friend ReadOnly Property Downloaded As List(Of IUserData)
Private ReadOnly NProv As IFormatProvider
Friend ReadOnly Property Working As Boolean
Get
Return Pool.Count > 0 AndAlso Pool.Exists(Function(j) j.Working)
End Get
End Property
#Region "Jobs"
Friend Class Job : Implements IDisposable
Friend Event OnItemsCountChange(ByVal Sender As Job, ByVal Count As Integer)
Private ReadOnly Hosts As List(Of SettingsHost)
Private ReadOnly Keys As List(Of String)
Private ReadOnly RemovingKeys As List(Of String)
Private TokenSource As CancellationTokenSource
Friend Token As CancellationToken
Private [Thread] As Thread
Private _Working As Boolean
Friend ReadOnly Property Items As List(Of IUserData)
Friend ReadOnly Property [Type] As Download
Friend ReadOnly Property Count As Integer
Get
Return Items.Count
End Get
End Property
Friend ReadOnly Property Working As Boolean
Get
Return _Working OrElse If(Thread?.IsAlive, False)
End Get
End Property
Friend ReadOnly Property IsSeparated As Boolean
Get
Return Hosts.Count = 1 AndAlso Hosts(0).IsSeparatedTasks
End Get
End Property
Friend ReadOnly Property Name As String
Get
Return Hosts(0).Name
End Get
End Property
Friend ReadOnly Property TaskCount As Integer
Get
Return Hosts(0).TaskCount
End Get
End Property
Friend ReadOnly Property Host As SettingsHost
Get
If Hosts.Count > 0 Then
Dim k$ = Hosts(0).Key
Dim i% = Settings.Plugins.FindIndex(Function(p) p.Key = k)
If i >= 0 Then Return Settings.Plugins(i).Settings
End If
Return Nothing
End Get
End Property
Friend Property Progress As MyProgress
Friend Sub New(ByVal JobType As Download)
Hosts = New List(Of SettingsHost)
RemovingKeys = New List(Of String)
Keys = New List(Of String)
Items = New List(Of IUserData)
[Type] = JobType
End Sub
Friend Function Add(ByVal User As IUserData) As Boolean
With DirectCast(User, UserDataBase)
If Keys.Count > 0 Then
Dim i% = Keys.IndexOf(.User.Plugin)
If i >= 0 Then
Items.Add(User)
RaiseEvent OnItemsCountChange(Me, Count)
Return True
Else
If RemovingKeys.Count > 0 Then Return RemovingKeys.IndexOf(.User.Plugin) >= 0
End If
End If
End With
Return False
End Function
Friend Sub AddHost(ByRef h As SettingsHost)
Hosts.Add(h)
Keys.Add(h.Key)
End Sub
Friend Function UserHost(ByVal User As IUserData) As SettingsHost
Dim i% = Keys.IndexOf(DirectCast(User, UserDataBase).User.Plugin)
If i >= 0 Then Return Hosts(i) Else Throw New KeyNotFoundException($"Plugin key [{DirectCast(User, UserDataBase).User.Plugin}] not found")
End Function
Friend Function Available() As Boolean
If Hosts.Count > 0 Then
Dim k$
For i% = Hosts.Count - 1 To 0 Step -1
If Not Hosts(i).Available(Type) Then
k = Hosts(i).Key
If Not RemovingKeys.Contains(k) Then RemovingKeys.Add(k)
Hosts(i).DownloadDone(Type)
Hosts.RemoveAt(i)
Keys.RemoveAt(i)
If Items.Count > 0 Then Items.RemoveAll(Function(u) DirectCast(u, UserDataBase).HOST.Key = k)
End If
Next
Return Hosts.Count > 0
Else
Return False
End If
End Function
Friend Sub ThrowIfCancellationRequested()
Token.ThrowIfCancellationRequested()
End Sub
Friend ReadOnly Property IsCancellationRequested As Boolean
Get
Return Token.IsCancellationRequested
End Get
End Property
Friend Sub [Start](ByVal [ThreadStart] As ThreadStart)
Thread = New Thread(ThreadStart) With {.IsBackground = True}
Thread.SetApartmentState(ApartmentState.MTA)
Thread.Start()
End Sub
Friend Sub [Start]()
If Hosts.Count > 0 Then Hosts.ForEach(Sub(h) h.DownloadStarted([Type]))
TokenSource = New CancellationTokenSource
Token = TokenSource.Token
_Working = True
End Sub
Friend Sub [Stop]()
If Not TokenSource Is Nothing Then TokenSource.Cancel()
End Sub
Friend Sub Stopped()
_Working = False
TokenSource = Nothing
Try
If Not Thread Is Nothing Then
If Thread.IsAlive Then Thread.Abort()
Thread = Nothing
End If
Catch ex As Exception
End Try
If Hosts.Count > 0 Then Hosts.ForEach(Sub(h) h.DownloadDone([Type]))
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
Hosts.Clear()
Keys.Clear()
RemovingKeys.Clear()
Items.Clear()
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
Friend ReadOnly Pool As List(Of Job)
#End Region
Friend Sub New()
Downloaded = New List(Of IUserData)
NProv = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Pool = New List(Of Job)
End Sub
Friend Sub ReconfPool()
If Pool.Count = 0 OrElse Not Pool.Exists(Function(j) j.Working Or j.Count > 0) Then
Pool.ListClearDispose
If Settings.Plugins.Count > 0 Then
Pool.Add(New Job(Download.Main))
For Each p As PluginHost In Settings.Plugins
If p.Settings.IsSeparatedTasks Then
Pool.Add(New Job(Download.Main))
Pool.Last.AddHost(p.Settings)
Else
Pool(0).AddHost(p.Settings)
End If
Next
End If
RaiseEvent OnReconfigured()
End If
End Sub
Private CheckerThread As Thread
Private Sub [Start]()
If Not MyProgressForm.Opened AndAlso Pool.LongCount(Function(p) p.Count > 0) > 1 Then MyProgressForm.Show()
If Not If(CheckerThread?.IsAlive, False) Then
MainProgress.Enabled = True
CheckerThread = New Thread(New ThreadStart(AddressOf JobsChecker))
CheckerThread.SetApartmentState(ApartmentState.MTA)
CheckerThread.Start()
End If
End Sub
Private Sub JobsChecker()
Try
MainProgress.TotalCount = 0
Do While Pool.Exists(Function(p) p.Count > 0)
For Each j As Job In Pool
If j.Count > 0 And Not j.Working Then j.Start(New ThreadStart(Sub() StartDownloading(j)))
Next
Thread.Sleep(200)
Loop
Catch ex As Exception
Finally
With MainProgress
.TotalCount = 0
.CurrentCounter = 0
.InformationTemporary = "All data downloaded"
.Enabled(EOptions.ProgressBar) = False
End With
If Pool.Count > 0 Then Pool.ForEach(Sub(p) If Not p.Progress Is Nothing Then p.Progress.TotalCount = 0)
End Try
End Sub
Private Sub StartDownloading(ByRef _Job As Job)
RaiseEvent OnDownloading(True)
Dim isSeparated As Boolean = _Job.IsSeparated
Dim n$ = _Job.Name
Dim pt As Func(Of String, String) = Function(ByVal t As String) As String
Dim _t$ = If(isSeparated, $"{n} {Left(t, 1).ToLower}{Right(t, t.Length - 1)}", t)
RaiseEvent SendNotification(_t)
Return _t
End Function
Try
_Job.Start()
_Job.Progress.TotalCount = 0
_Job.Progress.CurrentCounter = 0
_Job.Progress.Enabled = True
Dim SiteChecked As Boolean = False
Do While _Job.Count > 0
_Job.ThrowIfCancellationRequested()
If Not SiteChecked Then
If Not _Job.Available Then Exit Sub Else SiteChecked = True : Continue Do
End If
UpdateJobsLabel()
DownloadData(_Job, _Job.Token)
_Job.ThrowIfCancellationRequested()
Thread.Sleep(500)
Loop
_Job.Progress.InformationTemporary = pt("All data downloaded")
Catch oex As OperationCanceledException When _Job.IsCancellationRequested
_Job.Progress.InformationTemporary = pt("Downloading canceled")
Catch ex As Exception
_Job.Progress.InformationTemporary = pt("Downloading error")
ErrorsDescriber.Execute(EDP.SendInLog, ex, "TDownloader.Start")
Finally
_Job.Stopped()
UpdateJobsLabel()
RaiseEvent OnDownloading(False)
End Try
End Sub
Friend Sub [Stop]()
If Pool.Count > 0 Then
For Each j As Job In Pool
If j.Working Then j.Stop()
Next
End If
End Sub
Private Sub UpdateJobsLabel()
RaiseEvent OnJobsChange(Pool.Sum(Function(j) j.Count))
End Sub
Private Sub DownloadData(ByRef _Job As Job, ByVal Token As CancellationToken)
Try
If _Job.Count > 0 Then
Const nf As ANumbers.Formats = ANumbers.Formats.Number
Dim t As New List(Of Task)
Dim i% = 0
Dim limit% = _Job.TaskCount
Dim Keys As New List(Of String)
Dim h As Boolean = False
Dim host As SettingsHost = Nothing
For Each _Item As IUserData In _Job.Items
If Not _Item.Disposed Then
Keys.Add(_Item.Key)
host = _Job.UserHost(_Item)
If host.Source.ReadyToDownload(Download.Main) Then
host.BeforeStartDownload(_Item, Download.Main)
_Job.ThrowIfCancellationRequested()
DirectCast(_Item, UserDataBase).Progress = _Job.Progress
t.Add(Task.Run(Sub() _Item.DownloadData(Token)))
i += 1
If i >= limit Then Exit For
End If
End If
Next
If t.Count > 0 Or Keys.Count > 0 Then
With _Job.Progress
.Enabled(EOptions.All) = True
.Information = IIf(_Job.IsSeparated, $"{_Job.Name} d", "D")
.Information &= $"ownloading {t.Count.NumToString(nf, NProv)}/{_Job.Items.Count.NumToString(nf, NProv)} profiles' data"
.InformationTemporary = .Information
End With
If t.Count > 0 Then Task.WaitAll(t.ToArray)
Dim dcc As Boolean = False
If Keys.Count > 0 Then
For Each k$ In Keys
i = _Job.Items.FindIndex(Function(ii) ii.Key = k)
If i >= 0 Then
With _Job.Items(i)
host.AfterDownload(_Job.Items(i), Download.Main)
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
If Not Downloaded.Contains(.Self) Then Downloaded.Add(GetUserFromMainCollection(.Self))
dcc = True
End If
End With
_Job.Items.RemoveAt(i)
End If
Next
End If
Keys.Clear()
_Job.Items.RemoveAll(Function(ii) ii.Disposed)
If dcc Then Downloaded.RemoveAll(Function(u) u Is Nothing)
If dcc And Downloaded.Count > 0 Then RaiseEvent OnDownloadCountChange()
t.Clear()
End If
End If
Catch aoex As ArgumentOutOfRangeException
ErrorsDescriber.Execute(EDP.SendInLog, aoex, $"TDownloader.DownloadData: index out of range ({_Job.Count})")
Catch oex As OperationCanceledException When _Job.IsCancellationRequested
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "TDownloader.DownloadData")
Finally
If Settings.UserListUpdateRequired Then _
Task.WaitAll(Task.Run(Sub()
While Settings.UserListUpdateRequired : Settings.UpdateUsersList() : End While
End Sub))
End Try
End Sub
Private Function GetUserFromMainCollection(ByVal User As IUserData) As IUserData
Dim uSimple As Predicate(Of IUserData) = Function(u) u.Equals(DirectCast(User, UserDataBase))
Dim uCol As Predicate(Of IUserData) = Function(ByVal u As IUserData) As Boolean
If u.IsCollection Then
Return DirectCast(u, UserDataBind).Collections.Exists(uSimple)
Else
Return False
End If
End Function
Dim uu As Predicate(Of IUserData)
If User.IncludedInCollection Then uu = uCol Else uu = uSimple
Dim i% = Settings.Users.FindIndex(uu)
If i >= 0 Then
If Settings.Users(i).IsCollection Then
With DirectCast(Settings.Users(i), UserDataBind)
i = .Collections.FindIndex(uSimple)
If i >= 0 Then Return .Collections(i)
End With
Else
Return Settings.Users(i)
End If
End If
Return Nothing
End Function
Private Sub AddItem(ByVal Item As IUserData, ByVal _UpdateJobsLabel As Boolean)
ReconfPool()
If Item.IsCollection Then
Item.DownloadData(Nothing)
Else
If Not Contains(Item) Then
If Pool.Count > 0 Then
For i% = 0 To Pool.Count - 1
If Pool(i).Add(Item) Then Exit For
Next
End If
If _UpdateJobsLabel Then UpdateJobsLabel()
End If
End If
End Sub
Friend Sub Add(ByVal Item As IUserData)
AddItem(Item, True)
Start()
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If _Items.ListExists Then
For i% = 0 To _Items.Count - 1 : AddItem(_Items(i), False) : Next
UpdateJobsLabel()
End If
Start()
End Sub
Private Function Contains(ByVal _Item As IUserData)
If Pool.Count > 0 Then
For Each j As Job In Pool
If j.Items.Count > 0 AndAlso j.Items.Contains(_Item) Then Return True
Next
End If
Return False
End Function
Friend Sub UserRemove(ByVal _Item As IUserData)
If Downloaded.Count > 0 AndAlso Downloaded.Contains(_Item) Then Downloaded.Remove(_Item) : RaiseEvent OnDownloadCountChange()
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
[Stop]()
Pool.ListClearDispose
Downloaded.Clear()
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

160
SCrawler/Download/VideosDownloaderForm.Designer.vb generated Normal file
View File

@@ -0,0 +1,160 @@
Namespace DownloadObjects
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class VideosDownloaderForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.BTT_ADD = New System.Windows.Forms.ToolStripButton()
Me.BTT_ADD_LIST = New System.Windows.Forms.ToolStripButton()
Me.BTT_DELETE = New System.Windows.Forms.ToolStripButton()
Me.BTT_DOWN = New System.Windows.Forms.ToolStripButton()
Me.BTT_OPEN_PATH = New System.Windows.Forms.ToolStripButton()
Me.ToolbarBOTTOM = New System.Windows.Forms.StatusStrip()
Me.PR_V = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_STATUS = New System.Windows.Forms.ToolStripStatusLabel()
Me.LIST_VIDEOS = New System.Windows.Forms.ListBox()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.ToolbarBOTTOM.SuspendLayout()
Me.SuspendLayout()
'
'SEP_1
'
SEP_1.Name = "SEP_1"
SEP_1.Size = New System.Drawing.Size(6, 25)
'
'SEP_2
'
SEP_2.Name = "SEP_2"
SEP_2.Size = New System.Drawing.Size(6, 25)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_ADD, Me.BTT_ADD_LIST, Me.BTT_DELETE, SEP_1, Me.BTT_DOWN, SEP_2, Me.BTT_OPEN_PATH})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(524, 25)
Me.ToolbarTOP.TabIndex = 0
'
'BTT_ADD
'
Me.BTT_ADD.AutoToolTip = False
Me.BTT_ADD.Image = Global.SCrawler.My.Resources.Resources.PlusPIC
Me.BTT_ADD.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD.Name = "BTT_ADD"
Me.BTT_ADD.Size = New System.Drawing.Size(75, 22)
Me.BTT_ADD.Text = "Add (Ins)"
'
'BTT_ADD_LIST
'
Me.BTT_ADD_LIST.AutoToolTip = False
Me.BTT_ADD_LIST.Image = Global.SCrawler.My.Resources.Resources.PlusPIC
Me.BTT_ADD_LIST.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD_LIST.Name = "BTT_ADD_LIST"
Me.BTT_ADD_LIST.Size = New System.Drawing.Size(67, 22)
Me.BTT_ADD_LIST.Text = "Add list"
'
'BTT_DELETE
'
Me.BTT_DELETE.AutoToolTip = False
Me.BTT_DELETE.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_DELETE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DELETE.Name = "BTT_DELETE"
Me.BTT_DELETE.Size = New System.Drawing.Size(83, 22)
Me.BTT_DELETE.Text = "Delete (F8)"
'
'BTT_DOWN
'
Me.BTT_DOWN.AutoToolTip = False
Me.BTT_DOWN.Image = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_DOWN.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DOWN.Name = "BTT_DOWN"
Me.BTT_DOWN.Size = New System.Drawing.Size(104, 22)
Me.BTT_DOWN.Text = "Download (F5)"
'
'BTT_OPEN_PATH
'
Me.BTT_OPEN_PATH.AutoToolTip = False
Me.BTT_OPEN_PATH.Image = Global.SCrawler.My.Resources.Resources.Folder_32
Me.BTT_OPEN_PATH.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_OPEN_PATH.Name = "BTT_OPEN_PATH"
Me.BTT_OPEN_PATH.Size = New System.Drawing.Size(120, 22)
Me.BTT_OPEN_PATH.Text = "Open saving path"
'
'ToolbarBOTTOM
'
Me.ToolbarBOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.PR_V, Me.LBL_STATUS})
Me.ToolbarBOTTOM.Location = New System.Drawing.Point(0, 339)
Me.ToolbarBOTTOM.Name = "ToolbarBOTTOM"
Me.ToolbarBOTTOM.Size = New System.Drawing.Size(524, 22)
Me.ToolbarBOTTOM.TabIndex = 1
'
'PR_V
'
Me.PR_V.Name = "PR_V"
Me.PR_V.Size = New System.Drawing.Size(200, 16)
Me.PR_V.Visible = False
'
'LBL_STATUS
'
Me.LBL_STATUS.Name = "LBL_STATUS"
Me.LBL_STATUS.Size = New System.Drawing.Size(0, 17)
'
'LIST_VIDEOS
'
Me.LIST_VIDEOS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_VIDEOS.FormattingEnabled = True
Me.LIST_VIDEOS.Location = New System.Drawing.Point(0, 25)
Me.LIST_VIDEOS.Name = "LIST_VIDEOS"
Me.LIST_VIDEOS.Size = New System.Drawing.Size(524, 314)
Me.LIST_VIDEOS.TabIndex = 2
'
'VideosDownloaderForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(524, 361)
Me.Controls.Add(Me.LIST_VIDEOS)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(540, 400)
Me.Name = "VideosDownloaderForm"
Me.ShowIcon = False
Me.Text = "Download Videos"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()
Me.ToolbarBOTTOM.ResumeLayout(False)
Me.ToolbarBOTTOM.PerformLayout()
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private WithEvents ToolbarTOP As ToolStrip
Private WithEvents BTT_ADD As ToolStripButton
Private WithEvents BTT_ADD_LIST As ToolStripButton
Private WithEvents BTT_DELETE As ToolStripButton
Private WithEvents ToolbarBOTTOM As StatusStrip
Private WithEvents PR_V As ToolStripProgressBar
Private WithEvents LBL_STATUS As ToolStripStatusLabel
Private WithEvents LIST_VIDEOS As ListBox
Private WithEvents BTT_DOWN As ToolStripButton
Private WithEvents BTT_OPEN_PATH As ToolStripButton
End Class
End Namespace

0
SCrawler/VideosDownloaderForm.resx → SCrawler/Download/VideosDownloaderForm.resx
View File

142
SCrawler/Download/VideosDownloaderForm.vb Normal file
View File

@@ -0,0 +1,142 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Namespace DownloadObjects
Friend Class VideosDownloaderForm
Private MyView As FormsView
Private ReadOnly MyPR As Toolbars.MyProgress
Private ReadOnly UrlList As List(Of String)
Private ReadOnly DownloadingUrlsFile As SFile = $"{SettingsFolderName}\VideosUrls.txt"
Friend Sub New()
InitializeComponent()
UrlList = New List(Of String)
MyPR = New Toolbars.MyProgress(ToolbarBOTTOM, PR_V, LBL_STATUS, "Downloading video")
If DownloadingUrlsFile.Exists Then _
UrlList.ListAddList(DownloadingUrlsFile.GetText.StringToList(Of String, List(Of String))(Environment.NewLine), LAP.NotContainsOnly)
End Sub
Private Sub VideosDownloaderForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
MyView = New FormsView(Me)
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
RefillList(False)
Catch ex As Exception
End Try
End Sub
Private Sub VideosDownloaderForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub VideosDownloaderForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MyView Is Nothing Then MyView.Dispose(Settings.Design)
If UrlList.Count > 0 Then UpdateUrlsFile()
UrlList.Clear()
End Sub
Private Sub VideosDownloaderForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Dim b As Boolean = True
Select Case e.KeyCode
Case Keys.Insert : AddVideo()
Case Keys.F5 : DownloadVideos()
Case Keys.F8 : BTT_DELETE_Click(Nothing, EventArgs.Empty)
Case Else : b = False
End Select
If b Then e.Handled = True
End Sub
Private Sub RefillList(Optional ByVal Update As Boolean = True)
Try
With LIST_VIDEOS
.Items.Clear()
If UrlList.Count > 0 Then UrlList.ForEach(Sub(u) .Items.Add(u))
If .Items.Count > 0 And _LatestSelected >= 0 And _LatestSelected <= .Items.Count - 1 Then .SelectedIndex = _LatestSelected
If Update Then UpdateUrlsFile()
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on list refill")
End Try
End Sub
Private Sub UpdateUrlsFile()
If UrlList.Count > 0 Then
TextSaver.SaveTextToFile(UrlList.ListToString(, Environment.NewLine), DownloadingUrlsFile, True,, EDP.SendInLog)
Else
DownloadingUrlsFile.Delete(, Settings.DeleteMode, EDP.SendInLog)
End If
End Sub
Private Sub BTT_ADD_Click(sender As Object, e As EventArgs) Handles BTT_ADD.Click
AddVideo()
End Sub
Private Sub AddVideo()
Dim URL$ = GetNewVideoURL()
If Not URL.IsEmptyString Then
If Not UrlList.Contains(URL) Then
UrlList.Add(URL)
RefillList()
Else
MsgBoxE("This URL already added to list")
End If
End If
End Sub
Private Sub BTT_ADD_LIST_Click(sender As Object, e As EventArgs) Handles BTT_ADD_LIST.Click
Dim l$ = InputBoxE("Enter URLs (new line as delimiter):", "URLs list", GetCurrentBuffer(),,,,,, True)
If Not l.IsEmptyString Then
Dim ub% = UrlList.Count
UrlList.ListAddList(l.StringFormatLines.StringToList(Of String, List(Of String))(vbCrLf).ListForEach(Function(u, i) u.Trim,, False))
If Not UrlList.Count = ub Then RefillList()
End If
End Sub
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click
If _LatestSelected >= 0 And _LatestSelected <= UrlList.Count - 1 Then
If MsgBoxE({$"Do you really want to delete video URL:{vbCr}{UrlList(_LatestSelected)}", "Deleting URL..."},
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
UrlList.RemoveAt(_LatestSelected)
RefillList()
End If
Else
MsgBoxE("URL does not selected", MsgBoxStyle.Exclamation)
End If
End Sub
Private Sub BTT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_DOWN.Click
DownloadVideos()
End Sub
Private Sub DownloadVideos()
If UrlList.Count > 0 Then
MyPR.TotalCount = UrlList.Count
MyPR.Enabled = True
Dim IsFirst As Boolean = True
For i% = UrlList.Count - 1 To 0 Step -1
If DownloadVideoByURL(UrlList(i), IsFirst, True) Then UrlList.RemoveAt(i)
MyPR.Perform()
IsFirst = False
Next
MyPR.Done()
RefillList()
MyPR.Enabled = False
Else
MsgBoxE("No one video added", MsgBoxStyle.Exclamation)
End If
End Sub
Private _LatestSelected As Integer = -1
Private Sub LIST_VIDEOS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_VIDEOS.SelectedIndexChanged
_LatestSelected = LIST_VIDEOS.SelectedIndex
End Sub
Private Sub BTT_OPEN_PATH_Click(sender As Object, e As EventArgs) Handles BTT_OPEN_PATH.Click
With Settings.LatestSavingPath
If Not .Value.IsEmptyString Then
If .Value.Exists(SFO.Path, False) Then
.Value.Open(SFO.Path, EDP.ShowMainMsg)
Else
MsgBoxE($"Path [{ .Value}] does not exists!", MsgBoxStyle.Exclamation)
End If
Else
MsgBoxE("Saving path does not set!", MsgBoxStyle.Exclamation)
End If
End With
End Sub
End Class
End Namespace

336
SCrawler/DownloadSavedPostsForm.Designer.vb generated
View File

@@ -1,336 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class DownloadSavedPostsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_BUTTONS As System.Windows.Forms.TableLayoutPanel
Dim TP_REDDIT As System.Windows.Forms.TableLayoutPanel
Dim TP_REDDIT_PR As System.Windows.Forms.TableLayoutPanel
Dim TP_INST As System.Windows.Forms.TableLayoutPanel
Dim TP_INST_PR As System.Windows.Forms.TableLayoutPanel
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadSavedPostsForm))
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.BTT_DOWN_ALL = New System.Windows.Forms.Button()
Me.BTT_STOP_ALL = New System.Windows.Forms.Button()
Me.BTT_REDDIT_START = New System.Windows.Forms.Button()
Me.BTT_REDDIT_STOP = New System.Windows.Forms.Button()
Me.PR_REDDIT = New System.Windows.Forms.ProgressBar()
Me.BTT_REDDIT_OPEN = New System.Windows.Forms.Button()
Me.LBL_REDDIT = New System.Windows.Forms.Label()
Me.BTT_INST_START = New System.Windows.Forms.Button()
Me.BTT_INST_STOP = New System.Windows.Forms.Button()
Me.PR_INST = New System.Windows.Forms.ProgressBar()
Me.BTT_INST_OPEN = New System.Windows.Forms.Button()
Me.LBL_INST = New System.Windows.Forms.Label()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_BUTTONS = New System.Windows.Forms.TableLayoutPanel()
TP_REDDIT = New System.Windows.Forms.TableLayoutPanel()
TP_REDDIT_PR = New System.Windows.Forms.TableLayoutPanel()
TP_INST = New System.Windows.Forms.TableLayoutPanel()
TP_INST_PR = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
TP_MAIN.SuspendLayout()
TP_BUTTONS.SuspendLayout()
TP_REDDIT.SuspendLayout()
TP_REDDIT_PR.SuspendLayout()
TP_INST.SuspendLayout()
TP_INST_PR.SuspendLayout()
Me.SuspendLayout()
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.Inset
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(TP_BUTTONS, 0, 0)
TP_MAIN.Controls.Add(TP_REDDIT, 0, 1)
TP_MAIN.Controls.Add(TP_INST, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_MAIN.Size = New System.Drawing.Size(484, 156)
TP_MAIN.TabIndex = 0
'
'TP_BUTTONS
'
TP_BUTTONS.ColumnCount = 2
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_BUTTONS.Controls.Add(Me.BTT_DOWN_ALL, 0, 0)
TP_BUTTONS.Controls.Add(Me.BTT_STOP_ALL, 1, 0)
TP_BUTTONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_BUTTONS.Location = New System.Drawing.Point(2, 2)
TP_BUTTONS.Margin = New System.Windows.Forms.Padding(0)
TP_BUTTONS.Name = "TP_BUTTONS"
TP_BUTTONS.RowCount = 1
TP_BUTTONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BUTTONS.Size = New System.Drawing.Size(480, 30)
TP_BUTTONS.TabIndex = 0
'
'BTT_DOWN_ALL
'
Me.BTT_DOWN_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_DOWN_ALL.Location = New System.Drawing.Point(3, 3)
Me.BTT_DOWN_ALL.Name = "BTT_DOWN_ALL"
Me.BTT_DOWN_ALL.Size = New System.Drawing.Size(234, 24)
Me.BTT_DOWN_ALL.TabIndex = 0
Me.BTT_DOWN_ALL.Text = "Download ALL"
Me.BTT_DOWN_ALL.UseVisualStyleBackColor = True
'
'BTT_STOP_ALL
'
Me.BTT_STOP_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_STOP_ALL.Location = New System.Drawing.Point(243, 3)
Me.BTT_STOP_ALL.Name = "BTT_STOP_ALL"
Me.BTT_STOP_ALL.Size = New System.Drawing.Size(234, 24)
Me.BTT_STOP_ALL.TabIndex = 1
Me.BTT_STOP_ALL.Text = "Stop ALL"
Me.BTT_STOP_ALL.UseVisualStyleBackColor = True
'
'TP_REDDIT
'
TP_REDDIT.ColumnCount = 1
TP_REDDIT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_REDDIT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_REDDIT.Controls.Add(TP_REDDIT_PR, 0, 0)
TP_REDDIT.Controls.Add(Me.LBL_REDDIT, 0, 1)
TP_REDDIT.Dock = System.Windows.Forms.DockStyle.Fill
TP_REDDIT.Location = New System.Drawing.Point(2, 34)
TP_REDDIT.Margin = New System.Windows.Forms.Padding(0)
TP_REDDIT.Name = "TP_REDDIT"
TP_REDDIT.RowCount = 2
TP_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_REDDIT.Size = New System.Drawing.Size(480, 59)
TP_REDDIT.TabIndex = 1
'
'TP_REDDIT_PR
'
TP_REDDIT_PR.ColumnCount = 4
TP_REDDIT_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_REDDIT_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_REDDIT_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_REDDIT_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_REDDIT_PR.Controls.Add(Me.BTT_REDDIT_START, 0, 0)
TP_REDDIT_PR.Controls.Add(Me.BTT_REDDIT_STOP, 1, 0)
TP_REDDIT_PR.Controls.Add(Me.PR_REDDIT, 3, 0)
TP_REDDIT_PR.Controls.Add(Me.BTT_REDDIT_OPEN, 2, 0)
TP_REDDIT_PR.Dock = System.Windows.Forms.DockStyle.Fill
TP_REDDIT_PR.Location = New System.Drawing.Point(0, 0)
TP_REDDIT_PR.Margin = New System.Windows.Forms.Padding(0)
TP_REDDIT_PR.Name = "TP_REDDIT_PR"
TP_REDDIT_PR.RowCount = 1
TP_REDDIT_PR.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_REDDIT_PR.Size = New System.Drawing.Size(480, 29)
TP_REDDIT_PR.TabIndex = 0
'
'BTT_REDDIT_START
'
Me.BTT_REDDIT_START.BackgroundImage = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_REDDIT_START.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_REDDIT_START.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_REDDIT_START.Location = New System.Drawing.Point(3, 3)
Me.BTT_REDDIT_START.Name = "BTT_REDDIT_START"
Me.BTT_REDDIT_START.Size = New System.Drawing.Size(24, 23)
Me.BTT_REDDIT_START.TabIndex = 0
TT_MAIN.SetToolTip(Me.BTT_REDDIT_START, "Start downloading saved Reddit posts")
Me.BTT_REDDIT_START.UseVisualStyleBackColor = True
'
'BTT_REDDIT_STOP
'
Me.BTT_REDDIT_STOP.BackgroundImage = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_REDDIT_STOP.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_REDDIT_STOP.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_REDDIT_STOP.Enabled = False
Me.BTT_REDDIT_STOP.Location = New System.Drawing.Point(33, 3)
Me.BTT_REDDIT_STOP.Name = "BTT_REDDIT_STOP"
Me.BTT_REDDIT_STOP.Size = New System.Drawing.Size(24, 23)
Me.BTT_REDDIT_STOP.TabIndex = 1
TT_MAIN.SetToolTip(Me.BTT_REDDIT_STOP, "Stop downloading saved Reddit posts")
Me.BTT_REDDIT_STOP.UseVisualStyleBackColor = True
'
'PR_REDDIT
'
Me.PR_REDDIT.Dock = System.Windows.Forms.DockStyle.Fill
Me.PR_REDDIT.Location = New System.Drawing.Point(93, 3)
Me.PR_REDDIT.Name = "PR_REDDIT"
Me.PR_REDDIT.Size = New System.Drawing.Size(384, 23)
Me.PR_REDDIT.TabIndex = 2
'
'BTT_REDDIT_OPEN
'
Me.BTT_REDDIT_OPEN.BackgroundImage = CType(resources.GetObject("BTT_REDDIT_OPEN.BackgroundImage"), System.Drawing.Image)
Me.BTT_REDDIT_OPEN.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_REDDIT_OPEN.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_REDDIT_OPEN.Location = New System.Drawing.Point(63, 3)
Me.BTT_REDDIT_OPEN.Name = "BTT_REDDIT_OPEN"
Me.BTT_REDDIT_OPEN.Size = New System.Drawing.Size(24, 23)
Me.BTT_REDDIT_OPEN.TabIndex = 3
Me.BTT_REDDIT_OPEN.UseVisualStyleBackColor = True
'
'LBL_REDDIT
'
Me.LBL_REDDIT.AutoSize = True
Me.LBL_REDDIT.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_REDDIT.Location = New System.Drawing.Point(3, 29)
Me.LBL_REDDIT.Name = "LBL_REDDIT"
Me.LBL_REDDIT.Size = New System.Drawing.Size(474, 30)
Me.LBL_REDDIT.TabIndex = 1
Me.LBL_REDDIT.Text = "Reddit"
Me.LBL_REDDIT.TextAlign = System.Drawing.ContentAlignment.TopCenter
'
'TP_INST
'
TP_INST.ColumnCount = 1
TP_INST.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_INST.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_INST.Controls.Add(TP_INST_PR, 0, 0)
TP_INST.Controls.Add(Me.LBL_INST, 0, 1)
TP_INST.Dock = System.Windows.Forms.DockStyle.Fill
TP_INST.Location = New System.Drawing.Point(2, 95)
TP_INST.Margin = New System.Windows.Forms.Padding(0)
TP_INST.Name = "TP_INST"
TP_INST.RowCount = 2
TP_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_INST.Size = New System.Drawing.Size(480, 59)
TP_INST.TabIndex = 2
'
'TP_INST_PR
'
TP_INST_PR.ColumnCount = 4
TP_INST_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_INST_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_INST_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_INST_PR.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_INST_PR.Controls.Add(Me.BTT_INST_START, 0, 0)
TP_INST_PR.Controls.Add(Me.BTT_INST_STOP, 1, 0)
TP_INST_PR.Controls.Add(Me.PR_INST, 3, 0)
TP_INST_PR.Controls.Add(Me.BTT_INST_OPEN, 2, 0)
TP_INST_PR.Dock = System.Windows.Forms.DockStyle.Fill
TP_INST_PR.Location = New System.Drawing.Point(0, 0)
TP_INST_PR.Margin = New System.Windows.Forms.Padding(0)
TP_INST_PR.Name = "TP_INST_PR"
TP_INST_PR.RowCount = 1
TP_INST_PR.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_INST_PR.Size = New System.Drawing.Size(480, 29)
TP_INST_PR.TabIndex = 0
'
'BTT_INST_START
'
Me.BTT_INST_START.BackgroundImage = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_INST_START.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_INST_START.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_INST_START.Location = New System.Drawing.Point(3, 3)
Me.BTT_INST_START.Name = "BTT_INST_START"
Me.BTT_INST_START.Size = New System.Drawing.Size(24, 23)
Me.BTT_INST_START.TabIndex = 0
TT_MAIN.SetToolTip(Me.BTT_INST_START, "Start downloading saved Instagram posts")
Me.BTT_INST_START.UseVisualStyleBackColor = True
'
'BTT_INST_STOP
'
Me.BTT_INST_STOP.BackgroundImage = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_INST_STOP.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_INST_STOP.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_INST_STOP.Enabled = False
Me.BTT_INST_STOP.Location = New System.Drawing.Point(33, 3)
Me.BTT_INST_STOP.Name = "BTT_INST_STOP"
Me.BTT_INST_STOP.Size = New System.Drawing.Size(24, 23)
Me.BTT_INST_STOP.TabIndex = 1
TT_MAIN.SetToolTip(Me.BTT_INST_STOP, "Stop downloading saved Instagram posts")
Me.BTT_INST_STOP.UseVisualStyleBackColor = True
'
'PR_INST
'
Me.PR_INST.Dock = System.Windows.Forms.DockStyle.Fill
Me.PR_INST.Location = New System.Drawing.Point(93, 3)
Me.PR_INST.Name = "PR_INST"
Me.PR_INST.Size = New System.Drawing.Size(384, 23)
Me.PR_INST.TabIndex = 2
'
'BTT_INST_OPEN
'
Me.BTT_INST_OPEN.BackgroundImage = CType(resources.GetObject("BTT_INST_OPEN.BackgroundImage"), System.Drawing.Image)
Me.BTT_INST_OPEN.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_INST_OPEN.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_INST_OPEN.Location = New System.Drawing.Point(63, 3)
Me.BTT_INST_OPEN.Name = "BTT_INST_OPEN"
Me.BTT_INST_OPEN.Size = New System.Drawing.Size(24, 23)
Me.BTT_INST_OPEN.TabIndex = 3
Me.BTT_INST_OPEN.UseVisualStyleBackColor = True
'
'LBL_INST
'
Me.LBL_INST.AutoSize = True
Me.LBL_INST.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_INST.Location = New System.Drawing.Point(3, 29)
Me.LBL_INST.Name = "LBL_INST"
Me.LBL_INST.Size = New System.Drawing.Size(474, 30)
Me.LBL_INST.TabIndex = 1
Me.LBL_INST.Text = "Instagram"
Me.LBL_INST.TextAlign = System.Drawing.ContentAlignment.TopCenter
'
'DownloadSavedPostsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(484, 156)
Me.Controls.Add(TP_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(500, 195)
Me.MinimumSize = New System.Drawing.Size(500, 195)
Me.Name = "DownloadSavedPostsForm"
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Saved posts"
TP_MAIN.ResumeLayout(False)
TP_BUTTONS.ResumeLayout(False)
TP_REDDIT.ResumeLayout(False)
TP_REDDIT.PerformLayout()
TP_REDDIT_PR.ResumeLayout(False)
TP_INST.ResumeLayout(False)
TP_INST.PerformLayout()
TP_INST_PR.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
Private WithEvents BTT_DOWN_ALL As Button
Private WithEvents BTT_STOP_ALL As Button
Private WithEvents BTT_REDDIT_START As Button
Private WithEvents BTT_REDDIT_STOP As Button
Private WithEvents PR_REDDIT As ProgressBar
Private WithEvents LBL_REDDIT As Label
Private WithEvents BTT_INST_START As Button
Private WithEvents BTT_INST_STOP As Button
Private WithEvents PR_INST As ProgressBar
Private WithEvents LBL_INST As Label
Private WithEvents BTT_REDDIT_OPEN As Button
Private WithEvents BTT_INST_OPEN As Button
End Class

157
SCrawler/DownloadSavedPostsForm.vb
View File

@@ -1,157 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports System.Threading
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API
Imports Job = SCrawler.TDownloader.Job
Friend Class DownloadSavedPostsForm
Friend Event OnDownloadDone(ByVal Message As String)
Private MyView As FormsView
Private ReadOnly ProgressReddit As MyProgress
Private ReadOnly ProgressInstgram As MyProgress
Private JobReddit As Job
Private JobInstagram As Job
Friend ReadOnly Property Working As Boolean
Get
Return JobReddit Or JobInstagram
End Get
End Property
#Region "Start and Stop functions"
Friend Overloads Sub [Stop]()
[Stop](Sites.Reddit)
[Stop](Sites.Instagram)
End Sub
Private Overloads Sub [Stop](ByVal Site As Sites)
Select Case Site
Case Sites.Reddit : If JobReddit Then JobReddit.Stop()
Case Sites.Instagram : If JobInstagram Then JobInstagram.Stop()
End Select
End Sub
Private Overloads Sub [Start]()
Start(Sites.Reddit)
Start(Sites.Instagram)
End Sub
Private Overloads Sub [Start](ByVal Site As Sites)
Select Case Site
Case Sites.Reddit : If Not JobReddit Then JobReddit.Start(New ThreadStart(Sub() DownloadData(Sites.Reddit)))
Case Sites.Instagram
If Not JobInstagram Then
If Not Downloader.Working(Sites.Instagram) Then
Downloader.InstagramSavedPostsDownloading = True
JobInstagram.Start(New ThreadStart(Sub() DownloadData(Sites.Instagram)))
Else
MsgBoxE({$"Downloading Instagram profiles still works.{vbCr}Wait for this to be done before starting.{vbCr}Operation canceled",
"Instagram saved posts"}, MsgBoxStyle.Critical)
End If
End If
End Select
End Sub
#End Region
#Region "Form functions"
Friend Sub New()
InitializeComponent()
ProgressReddit = New MyProgress(PR_REDDIT, LBL_REDDIT)
ProgressInstgram = New MyProgress(PR_INST, LBL_INST)
JobReddit = New Job(ProgressReddit) With {.Site = Sites.Reddit}
JobInstagram = New Job(ProgressInstgram) With {.Site = Sites.Instagram}
End Sub
Private Sub DownloadSavedPostsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
MyView = New FormsView(Me) With {.LocationOnly = True}
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
End Sub
Private Sub DownloadSavedPostsForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub DownloadSavedPostsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
[Stop]()
MyView.Dispose(Settings.Design)
End Sub
#End Region
#Region "Controls"
Private Sub BTT_DOWN_ALL_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_ALL.Click
Start()
End Sub
Private Sub BTT_STOP_ALL_Click(sender As Object, e As EventArgs) Handles BTT_STOP_ALL.Click
[Stop]()
End Sub
#Region "Reddit"
Private Sub BTT_REDDIT_START_Click(sender As Object, e As EventArgs) Handles BTT_REDDIT_START.Click
Start(Sites.Reddit)
End Sub
Private Sub BTT_REDDIT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_REDDIT_STOP.Click
[Stop](Sites.Reddit)
End Sub
Private Sub BTT_REDDIT_OPEN_Click(sender As Object, e As EventArgs) Handles BTT_REDDIT_OPEN.Click
OpenPath(Reddit.ProfileSaved.DataPath)
End Sub
Private Sub LBL_REDDIT_DoubleClick(sender As Object, e As EventArgs) Handles LBL_REDDIT.DoubleClick
OpenPath(Reddit.ProfileSaved.DataPath)
End Sub
#End Region
#Region "Instagram"
Private Sub BTT_INST_START_Click(sender As Object, e As EventArgs) Handles BTT_INST_START.Click
Start(Sites.Instagram)
End Sub
Private Sub BTT_INST_STOP_Click(sender As Object, e As EventArgs) Handles BTT_INST_STOP.Click
[Stop](Sites.Instagram)
End Sub
Private Sub BTT_INST_OPEN_Click(sender As Object, e As EventArgs) Handles BTT_INST_OPEN.Click
OpenPath(Instagram.ProfileSaved.DataPath)
End Sub
Private Sub LBL_INST_DoubleClick(sender As Object, e As EventArgs) Handles LBL_INST.DoubleClick
OpenPath(Instagram.ProfileSaved.DataPath)
End Sub
#End Region
#End Region
Private Sub DownloadData(ByVal Site As Sites)
Dim btte As Action(Of Button, Boolean) = Sub(b, e) If b.InvokeRequired Then b.Invoke(Sub() b.Enabled = e) Else b.Enabled = e
Try
Select Case Site
Case Sites.Reddit
btte(BTT_REDDIT_START, False)
btte(BTT_REDDIT_STOP, True)
JobReddit.Progress.InformationTemporary = "Reddit downloading started"
JobReddit.Start()
Reddit.ProfileSaved.Download(JobReddit.Progress, JobReddit)
Case Sites.Instagram
btte(BTT_INST_START, False)
btte(BTT_INST_STOP, True)
JobInstagram.Progress.InformationTemporary = "Instagram downloading started"
JobInstagram.Start()
Instagram.ProfileSaved.Download(JobInstagram.Progress, JobInstagram)
End Select
RaiseEvent OnDownloadDone($"Downloading saved {Site} posts is completed")
Catch ex As Exception
Select Case Site
Case Sites.Reddit : JobReddit.Progress.InformationTemporary = "Reddit downloading error"
Case Sites.Instagram : JobInstagram.Progress.InformationTemporary = "Instagram downloading error"
End Select
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, {$"{Site} saved posts downloading error", "Saved posts"})
Finally
Select Case Site
Case Sites.Reddit
JobReddit.Stopped()
btte(BTT_REDDIT_START, True)
btte(BTT_REDDIT_STOP, False)
Case Sites.Instagram
JobInstagram.Stopped()
btte(BTT_INST_START, True)
btte(BTT_INST_STOP, False)
Downloader.InstagramSavedPostsDownloading = False
End Select
End Try
End Sub
Private Sub OpenPath(ByVal f As SFile)
If f.Exists(SFO.Path, False) Then f.Open(SFO.Path)
End Sub
End Class

134
SCrawler/DownloadedInfoForm.Designer.vb generated
View File

@@ -1,134 +0,0 @@
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class DownloadedInfoForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadedInfoForm))
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
Me.MENU_VIEW_SESSION = New System.Windows.Forms.ToolStripMenuItem()
Me.MENU_VIEW_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.ToolbarBOTTOM = New System.Windows.Forms.StatusStrip()
Me.LIST_DOWN = New System.Windows.Forms.ListBox()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout()
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_VIEW, Me.BTT_REFRESH, SEP_1, Me.BTT_CLEAR})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(554, 25)
Me.ToolbarTOP.TabIndex = 0
'
'MENU_VIEW
'
Me.MENU_VIEW.AutoToolTip = False
Me.MENU_VIEW.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_VIEW_SESSION, Me.MENU_VIEW_ALL})
Me.MENU_VIEW.Image = CType(resources.GetObject("MENU_VIEW.Image"), System.Drawing.Image)
Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_VIEW.Name = "MENU_VIEW"
Me.MENU_VIEW.Size = New System.Drawing.Size(45, 22)
Me.MENU_VIEW.Text = "View"
'
'MENU_VIEW_SESSION
'
Me.MENU_VIEW_SESSION.AutoToolTip = True
Me.MENU_VIEW_SESSION.Name = "MENU_VIEW_SESSION"
Me.MENU_VIEW_SESSION.Size = New System.Drawing.Size(113, 22)
Me.MENU_VIEW_SESSION.Text = "Session"
Me.MENU_VIEW_SESSION.ToolTipText = "Show downloaded users by this session"
'
'MENU_VIEW_ALL
'
Me.MENU_VIEW_ALL.AutoToolTip = True
Me.MENU_VIEW_ALL.Name = "MENU_VIEW_ALL"
Me.MENU_VIEW_ALL.Size = New System.Drawing.Size(113, 22)
Me.MENU_VIEW_ALL.Text = "All"
Me.MENU_VIEW_ALL.ToolTipText = "Show all users (sorted by latest download)"
'
'BTT_REFRESH
'
Me.BTT_REFRESH.Image = Global.SCrawler.My.Resources.Resources.Refresh
Me.BTT_REFRESH.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_REFRESH.Name = "BTT_REFRESH"
Me.BTT_REFRESH.Size = New System.Drawing.Size(89, 22)
Me.BTT_REFRESH.Text = "Refresh (F5)"
Me.BTT_REFRESH.ToolTipText = "Force list refresh"
'
'ToolbarBOTTOM
'
Me.ToolbarBOTTOM.Location = New System.Drawing.Point(0, 389)
Me.ToolbarBOTTOM.Name = "ToolbarBOTTOM"
Me.ToolbarBOTTOM.Size = New System.Drawing.Size(554, 22)
Me.ToolbarBOTTOM.TabIndex = 1
'
'LIST_DOWN
'
Me.LIST_DOWN.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_DOWN.FormattingEnabled = True
Me.LIST_DOWN.Location = New System.Drawing.Point(0, 25)
Me.LIST_DOWN.Name = "LIST_DOWN"
Me.LIST_DOWN.Size = New System.Drawing.Size(554, 364)
Me.LIST_DOWN.TabIndex = 2
'
'SEP_1
'
SEP_1.Name = "SEP_1"
SEP_1.Size = New System.Drawing.Size(6, 25)
'
'BTT_CLEAR
'
Me.BTT_CLEAR.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.BTT_CLEAR.Image = CType(resources.GetObject("BTT_CLEAR.Image"), System.Drawing.Image)
Me.BTT_CLEAR.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR.Name = "BTT_CLEAR"
Me.BTT_CLEAR.Size = New System.Drawing.Size(38, 22)
Me.BTT_CLEAR.Text = "Clear"
Me.BTT_CLEAR.ToolTipText = "Clear info list"
'
'DownloadedInfoForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(554, 411)
Me.Controls.Add(Me.LIST_DOWN)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(570, 450)
Me.Name = "DownloadedInfoForm"
Me.ShowIcon = False
Me.Text = "Downloaded items"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private WithEvents ToolbarTOP As ToolStrip
Private WithEvents MENU_VIEW As ToolStripDropDownButton
Private WithEvents MENU_VIEW_SESSION As ToolStripMenuItem
Private WithEvents MENU_VIEW_ALL As ToolStripMenuItem
Private WithEvents BTT_REFRESH As ToolStripButton
Private WithEvents ToolbarBOTTOM As StatusStrip
Private WithEvents LIST_DOWN As ListBox
Private WithEvents BTT_CLEAR As ToolStripButton
End Class

141
SCrawler/DownloadedInfoForm.vb
View File

@@ -1,141 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports SCrawler.API.Base
Friend Class DownloadedInfoForm
Private MyView As FormsView
Private ReadOnly LParams As New ListAddParams(LAP.IgnoreICopier) With {.e = EDP.None}
Friend Enum ViewModes As Integer
Session = 0
All = 1
End Enum
Friend Property ViewMode As ViewModes
Get
Return IIf(MENU_VIEW_ALL.Checked, ViewModes.All, ViewModes.Session)
End Get
Set(ByVal SMode As ViewModes)
Settings.InfoViewMode.Value = CInt(SMode)
End Set
End Property
Private ReadOnly _TempUsersList As List(Of IUserData)
Friend Sub New()
InitializeComponent()
_TempUsersList = New List(Of IUserData)
If Settings.InfoViewMode.Value = CInt(ViewModes.All) Then
MENU_VIEW_SESSION.Checked = False
MENU_VIEW_ALL.Checked = True
Else
MENU_VIEW_SESSION.Checked = True
MENU_VIEW_ALL.Checked = False
End If
Settings.InfoViewMode.Value = ViewMode
RefillList()
End Sub
Private Sub DownloadedInfoForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
If MyView Is Nothing Then
MyView = New FormsView(Me)
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
End If
BTT_CLEAR.Visible = ViewMode = ViewModes.Session
RefillList()
Catch ex As Exception
End Try
End Sub
Private Sub DownloadedInfoForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub DownloadedInfoForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MyView Is Nothing Then MyView.Dispose(Settings.Design)
_TempUsersList.Clear()
End Sub
Private Sub DownloadedInfoForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.F5 Then RefillList() : e.Handled = True
End Sub
Private Class UsersDateOrder : Implements IComparer(Of IUserData)
Friend Function Compare(ByVal x As IUserData, ByVal y As IUserData) As Integer Implements IComparer(Of IUserData).Compare
Dim xv& = If(DirectCast(x.Self, UserDataBase).LastUpdated.HasValue, DirectCast(x.Self, UserDataBase).LastUpdated.Value.Ticks, 0)
Dim yv& = If(DirectCast(y.Self, UserDataBase).LastUpdated.HasValue, DirectCast(y.Self, UserDataBase).LastUpdated.Value.Ticks, 0)
Return xv.CompareTo(yv) * -1
End Function
End Class
Private Sub RefillList()
Try
_TempUsersList.Clear()
Dim lClear As Action = Sub() LIST_DOWN.Items.Clear()
If LIST_DOWN.InvokeRequired Then LIST_DOWN.Invoke(lClear) Else lClear.Invoke
If ViewMode = ViewModes.Session Then
_TempUsersList.ListAddList(Downloader.Downloaded, LParams)
Else
_TempUsersList.ListAddList(Settings.Users.SelectMany(Of IUserData) _
(Function(u) If(u.IsCollection, DirectCast(u, API.UserDataBind).Collections, {u})), LParams)
End If
If _TempUsersList.Count > 0 Then
_TempUsersList.Sort(New UsersDateOrder)
For Each user As IUserData In _TempUsersList
If LIST_DOWN.InvokeRequired Then
LIST_DOWN.Invoke(Sub() LIST_DOWN.Items.Add(user.DownloadedInformation))
Else
LIST_DOWN.Items.Add(user.DownloadedInformation)
End If
Next
If _LatestSelected >= 0 AndAlso _LatestSelected <= LIST_DOWN.Items.Count - 1 Then
Dim aSel As Action = Sub() LIST_DOWN.SelectedIndex = _LatestSelected
If LIST_DOWN.InvokeRequired Then LIST_DOWN.Invoke(aSel) Else aSel.Invoke
Else
_LatestSelected = -1
End If
Else
_LatestSelected = -1
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[DownloadedInfoForm.RefillList]")
End Try
End Sub
Private Sub MENU_VIEW_SESSION_Click(sender As Object, e As EventArgs) Handles MENU_VIEW_SESSION.Click
MENU_VIEW_SESSION.Checked = True
MENU_VIEW_ALL.Checked = False
ViewMode = ViewModes.Session
BTT_CLEAR.Visible = True
RefillList()
End Sub
Private Sub MENU_VIEW_ALL_Click(sender As Object, e As EventArgs) Handles MENU_VIEW_ALL.Click
MENU_VIEW_SESSION.Checked = False
MENU_VIEW_ALL.Checked = True
ViewMode = ViewModes.All
BTT_CLEAR.Visible = False
RefillList()
End Sub
Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click
RefillList()
End Sub
Private Sub BTT_CLEAR_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR.Click
If LIST_DOWN.Items.Count > 0 Then
Downloader.Downloaded.Clear()
RefillList()
End If
End Sub
Private _LatestSelected As Integer = -1
Private Sub LIST_DOWN_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_DOWN.SelectedIndexChanged
_LatestSelected = LIST_DOWN.SelectedIndex
End Sub
Private Sub LIST_DOWN_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_DOWN.MouseDoubleClick
Try
If _LatestSelected >= 0 AndAlso _LatestSelected <= _TempUsersList.Count - 1 AndAlso
Not DirectCast(_TempUsersList(_LatestSelected).Self, UserDataBase).Disposed Then _TempUsersList(_LatestSelected).OpenFolder()
Catch ex As Exception
End Try
End Sub
Friend Sub Downloader_OnDownloadCountChange()
If ViewMode = ViewModes.Session Then RefillList()
End Sub
End Class

436
SCrawler/Editors/GlobalSettingsForm.Designer.vb generated
View File

@@ -27,6 +27,7 @@
Dim TP_FILE_NAME As System.Windows.Forms.TableLayoutPanel
Dim TP_FILE_PATTERNS As System.Windows.Forms.TableLayoutPanel
Dim LBL_DATE_POS As System.Windows.Forms.Label
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TT_MAIN As System.Windows.Forms.ToolTip
Dim TP_CHANNELS_IMGS As System.Windows.Forms.TableLayoutPanel
Dim TAB_BASIS As System.Windows.Forms.TabPage
@@ -34,12 +35,6 @@
Dim TP_DEFS As System.Windows.Forms.TableLayoutPanel
Dim TAB_DEFS_CHANNELS As System.Windows.Forms.TabPage
Dim TP_CHANNELS As System.Windows.Forms.TableLayoutPanel
Dim TAB_DEFS_REDDIT As System.Windows.Forms.TabPage
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton8 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TAB_DEFS_TWITTER As System.Windows.Forms.TabPage
Dim ActionButton9 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton10 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.TXT_GLOBAL_PATH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_IMAGE_LARGE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_IMAGE_SMALL = New PersonalUtilities.Forms.Controls.TextBoxExtended()
@@ -58,32 +53,22 @@
Me.CH_EXIT_CONFIRM = New System.Windows.Forms.CheckBox()
Me.CH_CLOSE_TO_TRAY = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_NOTIFY = New System.Windows.Forms.CheckBox()
Me.CH_FAST_LOAD = New System.Windows.Forms.CheckBox()
Me.TXT_FOLDER_CMD = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_COPY_CHANNEL_USER_IMAGE = New System.Windows.Forms.CheckBox()
Me.CH_DEF_TEMP = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_IMAGES = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_VIDEOS = New System.Windows.Forms.CheckBox()
Me.CH_SEPARATE_VIDEO_FOLDER = New System.Windows.Forms.CheckBox()
Me.CH_CHANNELS_USERS_TEMP = New System.Windows.Forms.CheckBox()
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL = New System.Windows.Forms.CheckBox()
Me.CH_UDESCR_UP = New System.Windows.Forms.CheckBox()
Me.TXT_CHANNELS_ROWS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_CHANNELS_COLUMNS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_CHANNEL_USER_POST_LIMIT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.DEFS_REDDIT = New SCrawler.Editors.SiteDefaults()
Me.TXT_REDDIT_SAVED_POSTS_USER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_REDDIT_USER_MEDIA = New System.Windows.Forms.CheckBox()
Me.TXT_REDDIT_SAVED_POSTS_PATH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.DEFS_TWITTER = New SCrawler.Editors.SiteDefaults()
Me.CH_TWITTER_USER_MEDIA = New System.Windows.Forms.CheckBox()
Me.TXT_REQ_WAIT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_REQ_COUNT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_LIMIT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TAB_MAIN = New System.Windows.Forms.TabControl()
Me.TAB_DEFS_INSTAGRAM = New System.Windows.Forms.TabPage()
Me.DEFS_INST = New SCrawler.Editors.SiteDefaults()
Me.TXT_INST_SAVED_POSTS_USER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_INST_SAVED_POSTS_PATH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TAB_DEFS_REDGIFS = New System.Windows.Forms.TabPage()
Me.DEFS_REDGIFS = New SCrawler.Editors.SiteDefaults()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
Me.CH_RECYCLE_DEL = New System.Windows.Forms.CheckBox()
TP_BASIS = New System.Windows.Forms.TableLayoutPanel()
TP_IMAGES = New System.Windows.Forms.TableLayoutPanel()
TP_FILE_NAME = New System.Windows.Forms.TableLayoutPanel()
@@ -96,8 +81,6 @@
TP_DEFS = New System.Windows.Forms.TableLayoutPanel()
TAB_DEFS_CHANNELS = New System.Windows.Forms.TabPage()
TP_CHANNELS = New System.Windows.Forms.TableLayoutPanel()
TAB_DEFS_REDDIT = New System.Windows.Forms.TabPage()
TAB_DEFS_TWITTER = New System.Windows.Forms.TabPage()
TP_BASIS.SuspendLayout()
CType(Me.TXT_GLOBAL_PATH, System.ComponentModel.ISupportInitialize).BeginInit()
TP_IMAGES.SuspendLayout()
@@ -109,6 +92,7 @@
CType(Me.TXT_IMGUR_CLIENT_ID, System.ComponentModel.ISupportInitialize).BeginInit()
TP_FILE_NAME.SuspendLayout()
TP_FILE_PATTERNS.SuspendLayout()
CType(Me.TXT_FOLDER_CMD, System.ComponentModel.ISupportInitialize).BeginInit()
TP_CHANNELS_IMGS.SuspendLayout()
CType(Me.TXT_CHANNELS_ROWS, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_CHANNELS_COLUMNS, System.ComponentModel.ISupportInitialize).BeginInit()
@@ -118,21 +102,7 @@
TAB_DEFS_CHANNELS.SuspendLayout()
TP_CHANNELS.SuspendLayout()
CType(Me.TXT_CHANNEL_USER_POST_LIMIT, System.ComponentModel.ISupportInitialize).BeginInit()
TAB_DEFS_REDDIT.SuspendLayout()
Me.DEFS_REDDIT.SuspendLayout()
CType(Me.TXT_REDDIT_SAVED_POSTS_USER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_REDDIT_SAVED_POSTS_PATH, System.ComponentModel.ISupportInitialize).BeginInit()
TAB_DEFS_TWITTER.SuspendLayout()
Me.DEFS_TWITTER.SuspendLayout()
CType(Me.TXT_REQ_WAIT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_REQ_COUNT, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_LIMIT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit()
Me.TAB_MAIN.SuspendLayout()
Me.TAB_DEFS_INSTAGRAM.SuspendLayout()
Me.DEFS_INST.SuspendLayout()
CType(Me.TXT_INST_SAVED_POSTS_USER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_INST_SAVED_POSTS_PATH, System.ComponentModel.ISupportInitialize).BeginInit()
Me.TAB_DEFS_REDGIFS.SuspendLayout()
Me.CONTAINER_MAIN.ContentPanel.SuspendLayout()
Me.CONTAINER_MAIN.SuspendLayout()
Me.SuspendLayout()
@@ -154,10 +124,13 @@
TP_BASIS.Controls.Add(Me.CH_EXIT_CONFIRM, 0, 9)
TP_BASIS.Controls.Add(Me.CH_CLOSE_TO_TRAY, 0, 10)
TP_BASIS.Controls.Add(Me.CH_SHOW_NOTIFY, 0, 11)
TP_BASIS.Controls.Add(Me.CH_FAST_LOAD, 0, 12)
TP_BASIS.Controls.Add(Me.TXT_FOLDER_CMD, 0, 13)
TP_BASIS.Controls.Add(Me.CH_RECYCLE_DEL, 0, 14)
TP_BASIS.Dock = System.Windows.Forms.DockStyle.Fill
TP_BASIS.Location = New System.Drawing.Point(3, 3)
TP_BASIS.Name = "TP_BASIS"
TP_BASIS.RowCount = 13
TP_BASIS.RowCount = 16
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
@@ -170,8 +143,11 @@
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_BASIS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BASIS.Size = New System.Drawing.Size(570, 366)
TP_BASIS.Size = New System.Drawing.Size(570, 422)
TP_BASIS.TabIndex = 0
'
'TXT_GLOBAL_PATH
@@ -489,6 +465,40 @@
Me.CH_SHOW_NOTIFY.Text = "Show notifications"
Me.CH_SHOW_NOTIFY.UseVisualStyleBackColor = True
'
'CH_FAST_LOAD
'
Me.CH_FAST_LOAD.AutoSize = True
Me.CH_FAST_LOAD.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FAST_LOAD.Location = New System.Drawing.Point(4, 344)
Me.CH_FAST_LOAD.Name = "CH_FAST_LOAD"
Me.CH_FAST_LOAD.Size = New System.Drawing.Size(562, 19)
Me.CH_FAST_LOAD.TabIndex = 12
Me.CH_FAST_LOAD.Text = "Fast profiles loading"
TT_MAIN.SetToolTip(Me.CH_FAST_LOAD, "Fast loading of profiles in the main window")
Me.CH_FAST_LOAD.UseVisualStyleBackColor = True
'
'TXT_FOLDER_CMD
'
Me.TXT_FOLDER_CMD.AutoShowClearButton = True
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Enabled = False
ActionButton7.Index = 0
ActionButton7.Name = "BTT_CLEAR"
ActionButton7.Visible = False
Me.TXT_FOLDER_CMD.Buttons.Add(ActionButton7)
Me.TXT_FOLDER_CMD.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.CheckBox
Me.TXT_FOLDER_CMD.CaptionText = "Folder cmd"
Me.TXT_FOLDER_CMD.CaptionToolTipEnabled = True
Me.TXT_FOLDER_CMD.CaptionToolTipText = "The command to open a folder."
Me.TXT_FOLDER_CMD.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_FOLDER_CMD.LeaveDefaultButtons = True
Me.TXT_FOLDER_CMD.Location = New System.Drawing.Point(4, 370)
Me.TXT_FOLDER_CMD.Name = "TXT_FOLDER_CMD"
Me.TXT_FOLDER_CMD.PlaceholderEnabled = True
Me.TXT_FOLDER_CMD.PlaceholderText = "MyCommand /arg {0}"
Me.TXT_FOLDER_CMD.Size = New System.Drawing.Size(562, 22)
Me.TXT_FOLDER_CMD.TabIndex = 13
'
'CH_COPY_CHANNEL_USER_IMAGE
'
Me.CH_COPY_CHANNEL_USER_IMAGE.AutoSize = True
@@ -554,14 +564,39 @@
'
Me.CH_CHANNELS_USERS_TEMP.AutoSize = True
Me.CH_CHANNELS_USERS_TEMP.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_CHANNELS_USERS_TEMP.Location = New System.Drawing.Point(4, 88)
Me.CH_CHANNELS_USERS_TEMP.Location = New System.Drawing.Point(4, 114)
Me.CH_CHANNELS_USERS_TEMP.Name = "CH_CHANNELS_USERS_TEMP"
Me.CH_CHANNELS_USERS_TEMP.Size = New System.Drawing.Size(562, 19)
Me.CH_CHANNELS_USERS_TEMP.TabIndex = 3
Me.CH_CHANNELS_USERS_TEMP.TabIndex = 4
Me.CH_CHANNELS_USERS_TEMP.Text = "Create temporary users"
TT_MAIN.SetToolTip(Me.CH_CHANNELS_USERS_TEMP, "Users added from channels will be created with this parameter")
Me.CH_CHANNELS_USERS_TEMP.UseVisualStyleBackColor = True
'
'CH_COPY_CHANNEL_USER_IMAGE_ALL
'
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.AutoSize = True
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.Location = New System.Drawing.Point(4, 88)
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.Name = "CH_COPY_CHANNEL_USER_IMAGE_ALL"
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.Size = New System.Drawing.Size(562, 19)
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.TabIndex = 3
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.Text = "Copy images from all channels"
TT_MAIN.SetToolTip(Me.CH_COPY_CHANNEL_USER_IMAGE_ALL, "Copy user images from all channels you have when adding a user from a channel")
Me.CH_COPY_CHANNEL_USER_IMAGE_ALL.UseVisualStyleBackColor = True
'
'CH_UDESCR_UP
'
Me.CH_UDESCR_UP.AutoSize = True
Me.CH_UDESCR_UP.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_UDESCR_UP.Location = New System.Drawing.Point(4, 108)
Me.CH_UDESCR_UP.Name = "CH_UDESCR_UP"
Me.CH_UDESCR_UP.Size = New System.Drawing.Size(562, 19)
Me.CH_UDESCR_UP.TabIndex = 4
Me.CH_UDESCR_UP.Text = "Update user description every time"
TT_MAIN.SetToolTip(Me.CH_UDESCR_UP, "If the user description does not contain a new user description, then the new one" &
" will be added via a new line")
Me.CH_UDESCR_UP.UseVisualStyleBackColor = True
'
'TP_CHANNELS_IMGS
'
TP_CHANNELS_IMGS.ColumnCount = 2
@@ -613,7 +648,7 @@
TAB_BASIS.Location = New System.Drawing.Point(4, 22)
TAB_BASIS.Name = "TAB_BASIS"
TAB_BASIS.Padding = New System.Windows.Forms.Padding(3)
TAB_BASIS.Size = New System.Drawing.Size(576, 372)
TAB_BASIS.Size = New System.Drawing.Size(576, 428)
TAB_BASIS.TabIndex = 0
TAB_BASIS.Text = "Basis"
'
@@ -623,7 +658,7 @@
TAB_DEFAULTS.Location = New System.Drawing.Point(4, 22)
TAB_DEFAULTS.Name = "TAB_DEFAULTS"
TAB_DEFAULTS.Padding = New System.Windows.Forms.Padding(3)
TAB_DEFAULTS.Size = New System.Drawing.Size(576, 372)
TAB_DEFAULTS.Size = New System.Drawing.Size(576, 426)
TAB_DEFAULTS.TabIndex = 1
TAB_DEFAULTS.Text = "Defaults"
'
@@ -636,16 +671,18 @@
TP_DEFS.Controls.Add(Me.CH_DOWN_VIDEOS, 0, 3)
TP_DEFS.Controls.Add(Me.CH_DOWN_IMAGES, 0, 2)
TP_DEFS.Controls.Add(Me.CH_DEF_TEMP, 0, 1)
TP_DEFS.Controls.Add(Me.CH_UDESCR_UP, 0, 4)
TP_DEFS.Dock = System.Windows.Forms.DockStyle.Fill
TP_DEFS.Location = New System.Drawing.Point(3, 3)
TP_DEFS.Name = "TP_DEFS"
TP_DEFS.RowCount = 5
TP_DEFS.RowCount = 6
TP_DEFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DEFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DEFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DEFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DEFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DEFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_DEFS.Size = New System.Drawing.Size(570, 366)
TP_DEFS.Size = New System.Drawing.Size(570, 420)
TP_DEFS.TabIndex = 0
'
'TAB_DEFS_CHANNELS
@@ -654,7 +691,7 @@
TAB_DEFS_CHANNELS.Location = New System.Drawing.Point(4, 22)
TAB_DEFS_CHANNELS.Name = "TAB_DEFS_CHANNELS"
TAB_DEFS_CHANNELS.Padding = New System.Windows.Forms.Padding(3)
TAB_DEFS_CHANNELS.Size = New System.Drawing.Size(576, 372)
TAB_DEFS_CHANNELS.Size = New System.Drawing.Size(576, 426)
TAB_DEFS_CHANNELS.TabIndex = 4
TAB_DEFS_CHANNELS.Text = "Channels"
'
@@ -666,19 +703,19 @@
TP_CHANNELS.Controls.Add(Me.TXT_CHANNEL_USER_POST_LIMIT, 0, 1)
TP_CHANNELS.Controls.Add(TP_CHANNELS_IMGS, 0, 0)
TP_CHANNELS.Controls.Add(Me.CH_COPY_CHANNEL_USER_IMAGE, 0, 2)
TP_CHANNELS.Controls.Add(Me.CH_CHANNELS_USERS_TEMP, 0, 3)
TP_CHANNELS.Controls.Add(Me.CH_CHANNELS_USERS_TEMP, 0, 4)
TP_CHANNELS.Controls.Add(Me.CH_COPY_CHANNEL_USER_IMAGE_ALL, 0, 3)
TP_CHANNELS.Dock = System.Windows.Forms.DockStyle.Fill
TP_CHANNELS.Location = New System.Drawing.Point(3, 3)
TP_CHANNELS.Name = "TP_CHANNELS"
TP_CHANNELS.RowCount = 5
TP_CHANNELS.RowCount = 6
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_CHANNELS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_CHANNELS.Size = New System.Drawing.Size(570, 366)
TP_CHANNELS.Size = New System.Drawing.Size(570, 420)
TP_CHANNELS.TabIndex = 0
'
'TXT_CHANNEL_USER_POST_LIMIT
@@ -701,284 +738,58 @@
Me.TXT_CHANNEL_USER_POST_LIMIT.Text = "1"
Me.TXT_CHANNEL_USER_POST_LIMIT.TextBoxTextAlign = System.Windows.Forms.HorizontalAlignment.Center
'
'TAB_DEFS_REDDIT
'
TAB_DEFS_REDDIT.Controls.Add(Me.DEFS_REDDIT)
TAB_DEFS_REDDIT.Location = New System.Drawing.Point(4, 22)
TAB_DEFS_REDDIT.Name = "TAB_DEFS_REDDIT"
TAB_DEFS_REDDIT.Padding = New System.Windows.Forms.Padding(3)
TAB_DEFS_REDDIT.Size = New System.Drawing.Size(576, 372)
TAB_DEFS_REDDIT.TabIndex = 2
TAB_DEFS_REDDIT.Text = "Reddit"
'
'DEFS_REDDIT
'
Me.DEFS_REDDIT.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.DEFS_REDDIT.ColumnCount = 1
Me.DEFS_REDDIT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_REDDIT.Controls.Add(Me.TXT_REDDIT_SAVED_POSTS_USER, 0, 4)
Me.DEFS_REDDIT.Controls.Add(Me.CH_REDDIT_USER_MEDIA, 0, 3)
Me.DEFS_REDDIT.Controls.Add(Me.TXT_REDDIT_SAVED_POSTS_PATH, 0, 5)
Me.DEFS_REDDIT.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEFS_REDDIT.Location = New System.Drawing.Point(3, 3)
Me.DEFS_REDDIT.Name = "DEFS_REDDIT"
Me.DEFS_REDDIT.RowCount = 7
Me.DEFS_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_REDDIT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_REDDIT.Size = New System.Drawing.Size(570, 366)
Me.DEFS_REDDIT.TabIndex = 1
'
'TXT_REDDIT_SAVED_POSTS_USER
'
Me.TXT_REDDIT_SAVED_POSTS_USER.CaptionText = "Saved posts user"
Me.TXT_REDDIT_SAVED_POSTS_USER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_REDDIT_SAVED_POSTS_USER.Location = New System.Drawing.Point(4, 108)
Me.TXT_REDDIT_SAVED_POSTS_USER.Name = "TXT_REDDIT_SAVED_POSTS_USER"
Me.TXT_REDDIT_SAVED_POSTS_USER.Size = New System.Drawing.Size(562, 22)
Me.TXT_REDDIT_SAVED_POSTS_USER.TabIndex = 4
'
'CH_REDDIT_USER_MEDIA
'
Me.CH_REDDIT_USER_MEDIA.AutoSize = True
Me.CH_REDDIT_USER_MEDIA.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_REDDIT_USER_MEDIA.Location = New System.Drawing.Point(4, 82)
Me.CH_REDDIT_USER_MEDIA.Name = "CH_REDDIT_USER_MEDIA"
Me.CH_REDDIT_USER_MEDIA.Size = New System.Drawing.Size(562, 19)
Me.CH_REDDIT_USER_MEDIA.TabIndex = 3
Me.CH_REDDIT_USER_MEDIA.Text = "Get user media only"
Me.CH_REDDIT_USER_MEDIA.UseVisualStyleBackColor = True
'
'TXT_REDDIT_SAVED_POSTS_PATH
'
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Index = 0
ActionButton7.Name = "BTT_OPEN"
ActionButton8.BackgroundImage = CType(resources.GetObject("ActionButton8.BackgroundImage"), System.Drawing.Image)
ActionButton8.Index = 1
ActionButton8.Name = "BTT_CLEAR"
Me.TXT_REDDIT_SAVED_POSTS_PATH.Buttons.Add(ActionButton7)
Me.TXT_REDDIT_SAVED_POSTS_PATH.Buttons.Add(ActionButton8)
Me.TXT_REDDIT_SAVED_POSTS_PATH.CaptionText = "Saved posts path"
Me.TXT_REDDIT_SAVED_POSTS_PATH.CaptionToolTipEnabled = True
Me.TXT_REDDIT_SAVED_POSTS_PATH.CaptionToolTipText = "Special path (clear to use default)"
Me.TXT_REDDIT_SAVED_POSTS_PATH.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_REDDIT_SAVED_POSTS_PATH.Location = New System.Drawing.Point(4, 137)
Me.TXT_REDDIT_SAVED_POSTS_PATH.Name = "TXT_REDDIT_SAVED_POSTS_PATH"
Me.TXT_REDDIT_SAVED_POSTS_PATH.Size = New System.Drawing.Size(562, 22)
Me.TXT_REDDIT_SAVED_POSTS_PATH.TabIndex = 8
'
'TAB_DEFS_TWITTER
'
TAB_DEFS_TWITTER.Controls.Add(Me.DEFS_TWITTER)
TAB_DEFS_TWITTER.Location = New System.Drawing.Point(4, 22)
TAB_DEFS_TWITTER.Name = "TAB_DEFS_TWITTER"
TAB_DEFS_TWITTER.Padding = New System.Windows.Forms.Padding(3)
TAB_DEFS_TWITTER.Size = New System.Drawing.Size(576, 372)
TAB_DEFS_TWITTER.TabIndex = 3
TAB_DEFS_TWITTER.Text = "Twitter"
'
'DEFS_TWITTER
'
Me.DEFS_TWITTER.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.DEFS_TWITTER.ColumnCount = 1
Me.DEFS_TWITTER.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_TWITTER.Controls.Add(Me.CH_TWITTER_USER_MEDIA, 0, 3)
Me.DEFS_TWITTER.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEFS_TWITTER.Location = New System.Drawing.Point(3, 3)
Me.DEFS_TWITTER.Name = "DEFS_TWITTER"
Me.DEFS_TWITTER.RowCount = 5
Me.DEFS_TWITTER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_TWITTER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_TWITTER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_TWITTER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_TWITTER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_TWITTER.Size = New System.Drawing.Size(570, 366)
Me.DEFS_TWITTER.TabIndex = 1
'
'CH_TWITTER_USER_MEDIA
'
Me.CH_TWITTER_USER_MEDIA.AutoSize = True
Me.CH_TWITTER_USER_MEDIA.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_TWITTER_USER_MEDIA.Location = New System.Drawing.Point(4, 82)
Me.CH_TWITTER_USER_MEDIA.Name = "CH_TWITTER_USER_MEDIA"
Me.CH_TWITTER_USER_MEDIA.Size = New System.Drawing.Size(562, 19)
Me.CH_TWITTER_USER_MEDIA.TabIndex = 3
Me.CH_TWITTER_USER_MEDIA.Text = "Get user media only"
Me.CH_TWITTER_USER_MEDIA.UseVisualStyleBackColor = True
'
'TXT_REQ_WAIT_TIMER
'
Me.TXT_REQ_WAIT_TIMER.CaptionText = "Request timer"
Me.TXT_REQ_WAIT_TIMER.CaptionWidth = 120.0R
Me.TXT_REQ_WAIT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_REQ_WAIT_TIMER.Location = New System.Drawing.Point(4, 82)
Me.TXT_REQ_WAIT_TIMER.Name = "TXT_REQ_WAIT_TIMER"
Me.TXT_REQ_WAIT_TIMER.Size = New System.Drawing.Size(568, 22)
Me.TXT_REQ_WAIT_TIMER.TabIndex = 3
'
'TXT_REQ_COUNT
'
Me.TXT_REQ_COUNT.CaptionText = "Request timer counter"
Me.TXT_REQ_COUNT.CaptionWidth = 120.0R
Me.TXT_REQ_COUNT.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_REQ_COUNT.Location = New System.Drawing.Point(4, 111)
Me.TXT_REQ_COUNT.Name = "TXT_REQ_COUNT"
Me.TXT_REQ_COUNT.Size = New System.Drawing.Size(568, 22)
Me.TXT_REQ_COUNT.TabIndex = 4
'
'TXT_LIMIT_TIMER
'
Me.TXT_LIMIT_TIMER.CaptionText = "Posts limit timer"
Me.TXT_LIMIT_TIMER.CaptionWidth = 120.0R
Me.TXT_LIMIT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_LIMIT_TIMER.Location = New System.Drawing.Point(4, 140)
Me.TXT_LIMIT_TIMER.Name = "TXT_LIMIT_TIMER"
Me.TXT_LIMIT_TIMER.Size = New System.Drawing.Size(568, 22)
Me.TXT_LIMIT_TIMER.TabIndex = 5
'
'TAB_MAIN
'
Me.TAB_MAIN.Controls.Add(TAB_BASIS)
Me.TAB_MAIN.Controls.Add(TAB_DEFAULTS)
Me.TAB_MAIN.Controls.Add(TAB_DEFS_CHANNELS)
Me.TAB_MAIN.Controls.Add(TAB_DEFS_REDDIT)
Me.TAB_MAIN.Controls.Add(TAB_DEFS_TWITTER)
Me.TAB_MAIN.Controls.Add(Me.TAB_DEFS_INSTAGRAM)
Me.TAB_MAIN.Controls.Add(Me.TAB_DEFS_REDGIFS)
Me.TAB_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TAB_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TAB_MAIN.Name = "TAB_MAIN"
Me.TAB_MAIN.SelectedIndex = 0
Me.TAB_MAIN.Size = New System.Drawing.Size(584, 398)
Me.TAB_MAIN.Size = New System.Drawing.Size(584, 454)
Me.TAB_MAIN.TabIndex = 1
'
'TAB_DEFS_INSTAGRAM
'
Me.TAB_DEFS_INSTAGRAM.BackColor = System.Drawing.SystemColors.Control
Me.TAB_DEFS_INSTAGRAM.Controls.Add(Me.DEFS_INST)
Me.TAB_DEFS_INSTAGRAM.Location = New System.Drawing.Point(4, 22)
Me.TAB_DEFS_INSTAGRAM.Name = "TAB_DEFS_INSTAGRAM"
Me.TAB_DEFS_INSTAGRAM.Size = New System.Drawing.Size(576, 372)
Me.TAB_DEFS_INSTAGRAM.TabIndex = 5
Me.TAB_DEFS_INSTAGRAM.Text = "Instagram"
'
'DEFS_INST
'
Me.DEFS_INST.BaseControlsPadding = New System.Windows.Forms.Padding(120, 0, 0, 0)
Me.DEFS_INST.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.DEFS_INST.ColumnCount = 1
Me.DEFS_INST.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_INST.Controls.Add(Me.TXT_LIMIT_TIMER, 0, 5)
Me.DEFS_INST.Controls.Add(Me.TXT_REQ_COUNT, 0, 4)
Me.DEFS_INST.Controls.Add(Me.TXT_REQ_WAIT_TIMER, 0, 3)
Me.DEFS_INST.Controls.Add(Me.TXT_INST_SAVED_POSTS_USER, 0, 6)
Me.DEFS_INST.Controls.Add(Me.TXT_INST_SAVED_POSTS_PATH, 0, 7)
Me.DEFS_INST.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEFS_INST.Location = New System.Drawing.Point(0, 0)
Me.DEFS_INST.Name = "DEFS_INST"
Me.DEFS_INST.RowCount = 9
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEFS_INST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_INST.Size = New System.Drawing.Size(576, 372)
Me.DEFS_INST.TabIndex = 1
'
'TXT_INST_SAVED_POSTS_USER
'
Me.TXT_INST_SAVED_POSTS_USER.CaptionText = "Saved posts user"
Me.TXT_INST_SAVED_POSTS_USER.CaptionWidth = 120.0R
Me.TXT_INST_SAVED_POSTS_USER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_INST_SAVED_POSTS_USER.Location = New System.Drawing.Point(4, 169)
Me.TXT_INST_SAVED_POSTS_USER.Name = "TXT_INST_SAVED_POSTS_USER"
Me.TXT_INST_SAVED_POSTS_USER.Size = New System.Drawing.Size(568, 22)
Me.TXT_INST_SAVED_POSTS_USER.TabIndex = 9
'
'TXT_INST_SAVED_POSTS_PATH
'
ActionButton9.BackgroundImage = CType(resources.GetObject("ActionButton9.BackgroundImage"), System.Drawing.Image)
ActionButton9.Index = 0
ActionButton9.Name = "BTT_OPEN"
ActionButton10.BackgroundImage = CType(resources.GetObject("ActionButton10.BackgroundImage"), System.Drawing.Image)
ActionButton10.Index = 1
ActionButton10.Name = "BTT_CLEAR"
Me.TXT_INST_SAVED_POSTS_PATH.Buttons.Add(ActionButton9)
Me.TXT_INST_SAVED_POSTS_PATH.Buttons.Add(ActionButton10)
Me.TXT_INST_SAVED_POSTS_PATH.CaptionText = "Saved posts path"
Me.TXT_INST_SAVED_POSTS_PATH.CaptionToolTipEnabled = True
Me.TXT_INST_SAVED_POSTS_PATH.CaptionToolTipText = "Special path (clear to use default)"
Me.TXT_INST_SAVED_POSTS_PATH.CaptionWidth = 120.0R
Me.TXT_INST_SAVED_POSTS_PATH.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_INST_SAVED_POSTS_PATH.Location = New System.Drawing.Point(4, 198)
Me.TXT_INST_SAVED_POSTS_PATH.Name = "TXT_INST_SAVED_POSTS_PATH"
Me.TXT_INST_SAVED_POSTS_PATH.Size = New System.Drawing.Size(568, 22)
Me.TXT_INST_SAVED_POSTS_PATH.TabIndex = 13
'
'TAB_DEFS_REDGIFS
'
Me.TAB_DEFS_REDGIFS.BackColor = System.Drawing.SystemColors.Control
Me.TAB_DEFS_REDGIFS.Controls.Add(Me.DEFS_REDGIFS)
Me.TAB_DEFS_REDGIFS.Location = New System.Drawing.Point(4, 22)
Me.TAB_DEFS_REDGIFS.Name = "TAB_DEFS_REDGIFS"
Me.TAB_DEFS_REDGIFS.Size = New System.Drawing.Size(576, 372)
Me.TAB_DEFS_REDGIFS.TabIndex = 6
Me.TAB_DEFS_REDGIFS.Text = "RedGifs"
'
'DEFS_REDGIFS
'
Me.DEFS_REDGIFS.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.DEFS_REDGIFS.ColumnCount = 1
Me.DEFS_REDGIFS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_REDGIFS.Dock = System.Windows.Forms.DockStyle.Fill
Me.DEFS_REDGIFS.Location = New System.Drawing.Point(0, 0)
Me.DEFS_REDGIFS.Name = "DEFS_REDGIFS"
Me.DEFS_REDGIFS.RowCount = 4
Me.DEFS_REDGIFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_REDGIFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_REDGIFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEFS_REDGIFS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEFS_REDGIFS.Size = New System.Drawing.Size(576, 372)
Me.DEFS_REDGIFS.TabIndex = 0
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
Me.CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TAB_MAIN)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(584, 398)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(584, 454)
Me.CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_MAIN.LeftToolStripPanelVisible = False
Me.CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
Me.CONTAINER_MAIN.Name = "CONTAINER_MAIN"
Me.CONTAINER_MAIN.RightToolStripPanelVisible = False
Me.CONTAINER_MAIN.Size = New System.Drawing.Size(584, 398)
Me.CONTAINER_MAIN.Size = New System.Drawing.Size(584, 479)
Me.CONTAINER_MAIN.TabIndex = 0
Me.CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'CH_RECYCLE_DEL
'
Me.CH_RECYCLE_DEL.AutoSize = True
Me.CH_RECYCLE_DEL.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_RECYCLE_DEL.Location = New System.Drawing.Point(4, 399)
Me.CH_RECYCLE_DEL.Name = "CH_RECYCLE_DEL"
Me.CH_RECYCLE_DEL.Size = New System.Drawing.Size(562, 19)
Me.CH_RECYCLE_DEL.TabIndex = 14
Me.CH_RECYCLE_DEL.Text = "Delete data to recycle bin"
Me.CH_RECYCLE_DEL.UseVisualStyleBackColor = True
'
'GlobalSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(584, 398)
Me.ClientSize = New System.Drawing.Size(584, 479)
Me.Controls.Add(Me.CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(600, 437)
Me.MaximumSize = New System.Drawing.Size(600, 518)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(600, 437)
Me.MinimumSize = New System.Drawing.Size(600, 518)
Me.Name = "GlobalSettingsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
@@ -997,6 +808,7 @@
TP_FILE_NAME.PerformLayout()
TP_FILE_PATTERNS.ResumeLayout(False)
TP_FILE_PATTERNS.PerformLayout()
CType(Me.TXT_FOLDER_CMD, System.ComponentModel.ISupportInitialize).EndInit()
TP_CHANNELS_IMGS.ResumeLayout(False)
CType(Me.TXT_CHANNELS_ROWS, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_CHANNELS_COLUMNS, System.ComponentModel.ISupportInitialize).EndInit()
@@ -1008,23 +820,7 @@
TP_CHANNELS.ResumeLayout(False)
TP_CHANNELS.PerformLayout()
CType(Me.TXT_CHANNEL_USER_POST_LIMIT, System.ComponentModel.ISupportInitialize).EndInit()
TAB_DEFS_REDDIT.ResumeLayout(False)
Me.DEFS_REDDIT.ResumeLayout(False)
Me.DEFS_REDDIT.PerformLayout()
CType(Me.TXT_REDDIT_SAVED_POSTS_USER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_REDDIT_SAVED_POSTS_PATH, System.ComponentModel.ISupportInitialize).EndInit()
TAB_DEFS_TWITTER.ResumeLayout(False)
Me.DEFS_TWITTER.ResumeLayout(False)
Me.DEFS_TWITTER.PerformLayout()
CType(Me.TXT_REQ_WAIT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_REQ_COUNT, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_LIMIT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
Me.TAB_MAIN.ResumeLayout(False)
Me.TAB_DEFS_INSTAGRAM.ResumeLayout(False)
Me.DEFS_INST.ResumeLayout(False)
CType(Me.TXT_INST_SAVED_POSTS_USER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_INST_SAVED_POSTS_PATH, System.ComponentModel.ISupportInitialize).EndInit()
Me.TAB_DEFS_REDGIFS.ResumeLayout(False)
Me.CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
Me.CONTAINER_MAIN.ResumeLayout(False)
Me.CONTAINER_MAIN.PerformLayout()
@@ -1048,11 +844,8 @@
Private WithEvents CH_DOWN_VIDEOS As CheckBox
Private WithEvents CH_DOWN_IMAGES As CheckBox
Private WithEvents CH_DEF_TEMP As CheckBox
Private WithEvents CH_TWITTER_USER_MEDIA As CheckBox
Private WithEvents CH_CHANNELS_USERS_TEMP As CheckBox
Private WithEvents TAB_DEFS_INSTAGRAM As TabPage
Private WithEvents TXT_IMGUR_CLIENT_ID As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_REDDIT_SAVED_POSTS_USER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents OPT_FILE_NAME_REPLACE As RadioButton
Private WithEvents OPT_FILE_NAME_ADD_DATE As RadioButton
Private WithEvents CH_FILE_NAME_CHANGE As CheckBox
@@ -1062,19 +855,12 @@
Private WithEvents OPT_FILE_DATE_END As RadioButton
Private WithEvents CH_EXIT_CONFIRM As CheckBox
Private WithEvents CH_CLOSE_TO_TRAY As CheckBox
Private WithEvents TXT_REQ_WAIT_TIMER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_REQ_COUNT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_LIMIT_TIMER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TAB_DEFS_REDGIFS As TabPage
Private WithEvents TAB_MAIN As TabControl
Private WithEvents DEFS_TWITTER As SiteDefaults
Private WithEvents DEFS_REDDIT As SiteDefaults
Private WithEvents DEFS_INST As SiteDefaults
Private WithEvents DEFS_REDGIFS As SiteDefaults
Private WithEvents TXT_INST_SAVED_POSTS_USER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_SHOW_NOTIFY As CheckBox
Private WithEvents CH_REDDIT_USER_MEDIA As CheckBox
Private WithEvents TXT_REDDIT_SAVED_POSTS_PATH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_INST_SAVED_POSTS_PATH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_COPY_CHANNEL_USER_IMAGE_ALL As CheckBox
Private WithEvents CH_UDESCR_UP As CheckBox
Private WithEvents CH_FAST_LOAD As CheckBox
Private WithEvents TXT_FOLDER_CMD As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_RECYCLE_DEL As CheckBox
End Class
End Namespace

52
SCrawler/Editors/GlobalSettingsForm.resx
View File

@@ -206,6 +206,14 @@
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="CH_SEPARATE_VIDEO_FOLDER.ToolTip" xml:space="preserve">
<value>This is a global setting for newly added users only.
This parameter specifies how the video will be stored in the users' download path.
@@ -229,50 +237,6 @@ If checked, videos will be stored in separate folder; otherwise, videos will be
<metadata name="TP_CHANNELS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TAB_DEFS_REDDIT.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TAB_DEFS_TWITTER.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton10.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAABAA8AAAAQAAEABAAwOgAA9gAAADAwEAABAAQAaAYAACg7AAAgIBAAAQAEAOgCAACQQQAAGBgQAAEA

138
SCrawler/Editors/GlobalSettingsForm.vb
View File

@@ -12,38 +12,6 @@ Imports PersonalUtilities.Forms.Toolbars
Namespace Editors
Friend Class GlobalSettingsForm : Implements IOkCancelToolbar
Private ReadOnly MyDefs As DefaultFormProps(Of FieldsChecker)
#Region "Checkers declarations"
Private Class SavedPostsChecker : Implements ICustomProvider
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If Not ACheck(Value) OrElse CStr(Value).Contains("/") Then
Return Nothing
Else
Return Value
End If
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
End Function
End Class
Private Class InstaTimersChecker : Implements ICustomProvider
Private ReadOnly _LowestValue As Integer
Friend Sub New(ByVal LowestValue As Integer)
_LowestValue = LowestValue
End Sub
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If ACheck(Of Integer)(Value) AndAlso CInt(Value) >= _LowestValue Then
Return Value
Else
Return Nothing
End If
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
End Function
End Class
#End Region
Friend Sub New()
InitializeComponent()
MyDefs = New DefaultFormProps(Of FieldsChecker)
@@ -64,17 +32,24 @@ Namespace Editors
TXT_MAX_JOBS_CHANNELS.Value = .ChannelsMaxJobsCount.Value
CH_CHECK_VER_START.Checked = .CheckUpdatesAtStart
TXT_IMGUR_CLIENT_ID.Text = .ImgurClientID
CH_FAST_LOAD.Checked = .FastProfilesLoading
TXT_FOLDER_CMD.Text = .OpenFolderInOtherProgram
TXT_FOLDER_CMD.Checked = .OpenFolderInOtherProgram.Attribute
CH_RECYCLE_DEL.Checked = .DeleteToRecycleBin
'Defaults
CH_SEPARATE_VIDEO_FOLDER.Checked = .SeparateVideoFolder.Value
CH_DEF_TEMP.Checked = .DefaultTemporary
CH_DOWN_IMAGES.Checked = .DefaultDownloadImages
CH_DOWN_VIDEOS.Checked = .DefaultDownloadVideos
CH_UDESCR_UP.Checked = .UpdateUserDescriptionEveryTime
'Channels
TXT_CHANNELS_ROWS.Value = .ChannelsImagesRows.Value
TXT_CHANNELS_COLUMNS.Value = .ChannelsImagesColumns.Value
TXT_CHANNEL_USER_POST_LIMIT.Value = .FromChannelDownloadTop.Value
TXT_CHANNEL_USER_POST_LIMIT.Checked = .FromChannelDownloadTopUse.Value
CH_COPY_CHANNEL_USER_IMAGE.Checked = .FromChannelCopyImageToUser
CH_COPY_CHANNEL_USER_IMAGE_ALL.Checked = .ChannelsAddUserImagesFromAllChannels
CH_COPY_CHANNEL_USER_IMAGE_ALL.Enabled = CH_COPY_CHANNEL_USER_IMAGE.Checked
CH_CHANNELS_USERS_TEMP.Checked = .ChannelsDefaultTemporary
'Channels filenames
CH_FILE_NAME_CHANGE.Checked = .FileReplaceNameByDate Or .FileAddDateToFileName Or .FileAddTimeToFileName
@@ -88,38 +63,11 @@ Namespace Editors
CH_EXIT_CONFIRM.Checked = .ExitConfirm
CH_CLOSE_TO_TRAY.Checked = .CloseToTray
CH_SHOW_NOTIFY.Checked = .ShowNotifications
'Reddit
With .Site(Sites.Reddit)
SetChecker(DEFS_REDDIT, Sites.Reddit)
CH_REDDIT_USER_MEDIA.Checked = .GetUserMediaOnly
TXT_REDDIT_SAVED_POSTS_USER.Text = .SavedPostsUserName
TXT_REDDIT_SAVED_POSTS_PATH.Text = .SavedPostsPath(False)
End With
'Twitter
With .Site(Sites.Twitter)
SetChecker(DEFS_TWITTER, Sites.Twitter)
CH_TWITTER_USER_MEDIA.Checked = .GetUserMediaOnly
End With
'Instagram
With .Site(Sites.Instagram)
SetChecker(DEFS_INST, Sites.Instagram)
TXT_REQ_WAIT_TIMER.Text = .RequestsWaitTimer
TXT_REQ_COUNT.Text = .RequestsWaitTimerTaskCount
TXT_LIMIT_TIMER.Text = .SleepTimerOnPostsLimit
TXT_INST_SAVED_POSTS_USER.Text = .SavedPostsUserName
TXT_INST_SAVED_POSTS_PATH.Text = .SavedPostsPath(False)
End With
'RedGifs
SetChecker(DEFS_REDGIFS, Sites.RedGifs)
End With
.MyFieldsChecker = New FieldsChecker
With .MyFieldsChecker
.AddControl(Of String)(TXT_GLOBAL_PATH, TXT_GLOBAL_PATH.CaptionText)
.AddControl(Of String)(TXT_COLLECTIONS_PATH, TXT_COLLECTIONS_PATH.CaptionText)
.AddControl(Of String)(TXT_REDDIT_SAVED_POSTS_USER, TXT_REDDIT_SAVED_POSTS_USER.CaptionText, True, New SavedPostsChecker)
.AddControl(Of Integer)(TXT_REQ_WAIT_TIMER, TXT_REQ_WAIT_TIMER.CaptionText,, New InstaTimersChecker(100))
.AddControl(Of Integer)(TXT_REQ_COUNT, TXT_REQ_COUNT.CaptionText,, New InstaTimersChecker(1))
.AddControl(Of Integer)(TXT_LIMIT_TIMER, TXT_LIMIT_TIMER.CaptionText,, New InstaTimersChecker(10000))
.EndLoaderOperations()
End With
.AppendDetectors()
@@ -130,35 +78,6 @@ Namespace Editors
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Overloads Sub SetChecker(ByRef CH As SiteDefaults, ByVal s As Sites)
With Settings(s)
SetChecker(CH.MyTemporary, .Temporary)
SetChecker(CH.MyImagesDown, .DownloadImages)
SetChecker(CH.MyVideosDown, .DownloadVideos)
End With
End Sub
Private Overloads Sub SetChecker(ByRef State As CheckState, ByVal Prop As XML.Base.XMLValue(Of Boolean))
If Prop.ValueF.Exists Then
State = If(Prop.Value, CheckState.Checked, CheckState.Unchecked)
Else
State = CheckState.Indeterminate
End If
End Sub
Private Overloads Sub SetPropByChecker(ByRef CH As SiteDefaults, ByVal s As Sites)
With Settings(s)
SetPropByChecker(CH.MyTemporary, .Temporary)
SetPropByChecker(CH.MyTemporary, .Temporary)
SetPropByChecker(CH.MyImagesDown, .DownloadImages)
SetPropByChecker(CH.MyVideosDown, .DownloadVideos)
End With
End Sub
Private Overloads Sub SetPropByChecker(ByVal State As CheckState, ByRef Prop As XML.Base.XMLValue(Of Boolean))
Select Case State
Case CheckState.Checked : Prop.Value = True
Case CheckState.Unchecked : Prop.Value = False
Case CheckState.Indeterminate : Prop.ValueF = Nothing
End Select
End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
If MyDefs.MyFieldsChecker.AllParamsOK Then
With Settings
@@ -190,6 +109,7 @@ Namespace Editors
End If
.BeginUpdate()
'Basis
.GlobalPath.Value = TXT_GLOBAL_PATH.Text
.MaxLargeImageHeigh.Value = CInt(TXT_IMAGE_LARGE.Value)
@@ -199,17 +119,23 @@ Namespace Editors
.ChannelsMaxJobsCount.Value = TXT_MAX_JOBS_CHANNELS.Value
.CheckUpdatesAtStart.Value = CH_CHECK_VER_START.Checked
.ImgurClientID.Value = TXT_IMGUR_CLIENT_ID.Text
.FastProfilesLoading.Value = CH_FAST_LOAD.Checked
.OpenFolderInOtherProgram.Value = TXT_FOLDER_CMD.Text
.OpenFolderInOtherProgram.Attribute.Value = TXT_FOLDER_CMD.Checked
.DeleteToRecycleBin.Value = CH_RECYCLE_DEL.Checked
'Defaults
.SeparateVideoFolder.Value = CH_SEPARATE_VIDEO_FOLDER.Checked
.DefaultTemporary.Value = CH_DEF_TEMP.Checked
.DefaultDownloadImages.Value = CH_DOWN_IMAGES.Checked
.DefaultDownloadVideos.Value = CH_DOWN_VIDEOS.Checked
.UpdateUserDescriptionEveryTime.Value = CH_UDESCR_UP.Checked
'Channels
.ChannelsImagesRows.Value = CInt(TXT_CHANNELS_ROWS.Value)
.ChannelsImagesColumns.Value = CInt(TXT_CHANNELS_COLUMNS.Value)
.FromChannelDownloadTop.Value = CInt(TXT_CHANNEL_USER_POST_LIMIT.Value)
.FromChannelDownloadTopUse.Value = TXT_CHANNEL_USER_POST_LIMIT.Checked
.FromChannelCopyImageToUser.Value = CH_COPY_CHANNEL_USER_IMAGE.Checked
.ChannelsAddUserImagesFromAllChannels.Value = CH_COPY_CHANNEL_USER_IMAGE_ALL.Checked
.ChannelsDefaultTemporary.Value = CH_CHANNELS_USERS_TEMP.Checked
'Other program settings
.ExitConfirm.Value = CH_EXIT_CONFIRM.Checked
@@ -226,29 +152,6 @@ Namespace Editors
.FileAddTimeToFileName.Value = False
.FileReplaceNameByDate.Value = False
End If
'Reddit
With .Site(Sites.Reddit)
SetPropByChecker(DEFS_REDDIT, Sites.Reddit)
.GetUserMediaOnly.Value = CH_REDDIT_USER_MEDIA.Checked
.SavedPostsUserName.Value = TXT_REDDIT_SAVED_POSTS_USER.Text
.SavedPostsPath = TXT_REDDIT_SAVED_POSTS_PATH.Text
End With
'Twitter
With .Site(Sites.Twitter)
SetPropByChecker(DEFS_TWITTER, Sites.Twitter)
.GetUserMediaOnly.Value = CH_TWITTER_USER_MEDIA.Checked
End With
'Instagram
With .Site(Sites.Instagram)
SetPropByChecker(DEFS_INST, Sites.Instagram)
.RequestsWaitTimer.Value = AConvert(Of Integer)(TXT_REQ_WAIT_TIMER.Text)
.RequestsWaitTimerTaskCount.Value = AConvert(Of Integer)(TXT_REQ_COUNT.Text)
.SleepTimerOnPostsLimit.Value = AConvert(Of Integer)(TXT_LIMIT_TIMER.Text)
.SavedPostsUserName.Value = TXT_INST_SAVED_POSTS_USER.Text
.SavedPostsPath = TXT_INST_SAVED_POSTS_PATH.Text
End With
'RedGifs
SetPropByChecker(DEFS_REDGIFS, Sites.RedGifs)
.EndUpdate()
End With
@@ -292,17 +195,8 @@ Namespace Editors
CH_FILE_TIME.Enabled = b
ChangePositionControlsEnabling()
End Sub
Private Sub TXT_REDDIT_SAVED_POSTS_PATH_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_REDDIT_SAVED_POSTS_PATH.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Open Then
Dim f As SFile = SFile.SelectPath
If Not f.IsEmptyString Then TXT_REDDIT_SAVED_POSTS_PATH.Text = f
End If
End Sub
Private Sub TXT_INST_SAVED_POSTS_PATH_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_INST_SAVED_POSTS_PATH.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Open Then
Dim f As SFile = SFile.SelectPath
If Not f.IsEmptyString Then TXT_INST_SAVED_POSTS_PATH.Text = f
End If
Private Sub CH_COPY_CHANNEL_USER_IMAGE_CheckedChanged(sender As Object, e As EventArgs) Handles CH_COPY_CHANNEL_USER_IMAGE.CheckedChanged
CH_COPY_CHANNEL_USER_IMAGE_ALL.Enabled = CH_COPY_CHANNEL_USER_IMAGE.Checked
End Sub
End Class
End Namespace

2
SCrawler/Editors/LabelsForm.vb
View File

@@ -81,7 +81,7 @@ Friend Class LabelsForm : Implements IOkCancelToolbar
If Sender.DefaultButton = ActionButton.DefaultButtons.Add Then AddNewLabel()
End Sub
Private Sub CMB_LABELS_ActionOnButtonClearClick() Handles CMB_LABELS.ActionOnButtonClearClick
CMB_LABELS.Clear(ComboBoxExtended.ClearMode.CheckedInexes)
CMB_LABELS.Clear(ComboBoxExtended.ClearMode.CheckedIndexes)
End Sub
Private Sub AddNewLabel()
Dim nl$ = InputBoxE("Enter new label name:", "New label")

29
SCrawler/Editors/SiteDefaults.vb
View File

@@ -7,6 +7,7 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports SCrawler.Plugin.Hosts
Namespace Editors
Public Class SiteDefaults : Inherits TableLayoutPanel
Private ReadOnly CH_TEMP As CheckBox
@@ -99,4 +100,32 @@ Namespace Editors
End Set
End Property
End Class
Friend NotInheritable Class SiteDefaultsFunctions
Private Sub New()
End Sub
Friend Overloads Shared Sub SetChecker(ByRef CH As SiteDefaults, ByRef h As SettingsHost)
SetChecker(CH.MyTemporary, h.Temporary)
SetChecker(CH.MyImagesDown, h.DownloadImages)
SetChecker(CH.MyVideosDown, h.DownloadVideos)
End Sub
Private Overloads Shared Sub SetChecker(ByRef State As CheckState, ByVal Prop As XML.Base.XMLValue(Of Boolean))
If Prop.ValueF.Exists Then
State = If(Prop.Value, CheckState.Checked, CheckState.Unchecked)
Else
State = CheckState.Indeterminate
End If
End Sub
Friend Overloads Shared Sub SetPropByChecker(ByRef CH As SiteDefaults, ByRef h As SettingsHost)
SetPropByChecker(CH.MyTemporary, h.Temporary)
SetPropByChecker(CH.MyImagesDown, h.DownloadImages)
SetPropByChecker(CH.MyVideosDown, h.DownloadVideos)
End Sub
Private Overloads Shared Sub SetPropByChecker(ByVal State As CheckState, ByRef Prop As XML.Base.XMLValue(Of Boolean))
Select Case State
Case CheckState.Checked : Prop.Value = True
Case CheckState.Unchecked : Prop.Value = False
Case CheckState.Indeterminate : Prop.ValueF = Nothing
End Select
End Sub
End Class
End Namespace

117
SCrawler/Editors/SiteEditorForm.Designer.vb generated
View File

@@ -24,14 +24,14 @@
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.TXT_PATH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_COOKIES = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_TOKEN = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_AUTH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TP_SITE_PROPS = New SCrawler.Editors.SiteDefaults()
Me.TXT_PATH_SAVED_POSTS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_GET_USER_MEDIA_ONLY = New System.Windows.Forms.CheckBox()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
Me.TP_MAIN.SuspendLayout()
CType(Me.TXT_PATH, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_COOKIES, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_TOKEN, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_AUTH, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_PATH_SAVED_POSTS, System.ComponentModel.ISupportInitialize).BeginInit()
Me.CONTAINER_MAIN.ContentPanel.SuspendLayout()
Me.CONTAINER_MAIN.SuspendLayout()
Me.SuspendLayout()
@@ -40,20 +40,21 @@
'
Me.TP_MAIN.ColumnCount = 1
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_MAIN.Controls.Add(Me.TXT_PATH, 0, 0)
Me.TP_MAIN.Controls.Add(Me.TXT_COOKIES, 0, 1)
Me.TP_MAIN.Controls.Add(Me.TXT_TOKEN, 0, 2)
Me.TP_MAIN.Controls.Add(Me.TXT_AUTH, 0, 3)
Me.TP_MAIN.Controls.Add(Me.TXT_COOKIES, 0, 2)
Me.TP_MAIN.Controls.Add(Me.TP_SITE_PROPS, 0, 4)
Me.TP_MAIN.Controls.Add(Me.TXT_PATH_SAVED_POSTS, 0, 1)
Me.TP_MAIN.Controls.Add(Me.CH_GET_USER_MEDIA_ONLY, 0, 3)
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 4
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(544, 132)
Me.TP_MAIN.RowCount = 5
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(544, 219)
Me.TP_MAIN.TabIndex = 0
'
'TXT_PATH
@@ -88,42 +89,57 @@
Me.TXT_COOKIES.CaptionText = "Cookies"
Me.TXT_COOKIES.ClearTextByButtonClear = False
Me.TXT_COOKIES.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_COOKIES.Location = New System.Drawing.Point(3, 36)
Me.TXT_COOKIES.Location = New System.Drawing.Point(3, 59)
Me.TXT_COOKIES.Name = "TXT_COOKIES"
Me.TXT_COOKIES.Size = New System.Drawing.Size(538, 22)
Me.TXT_COOKIES.TabIndex = 1
Me.TXT_COOKIES.TabIndex = 2
Me.TXT_COOKIES.TextBoxReadOnly = True
'
'TXT_TOKEN
'TP_SITE_PROPS
'
Me.TP_SITE_PROPS.BaseControlsPadding = New System.Windows.Forms.Padding(97, 0, 0, 0)
Me.TP_SITE_PROPS.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.TP_SITE_PROPS.ColumnCount = 1
Me.TP_SITE_PROPS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_SITE_PROPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_SITE_PROPS.Location = New System.Drawing.Point(3, 112)
Me.TP_SITE_PROPS.Name = "TP_SITE_PROPS"
Me.TP_SITE_PROPS.RowCount = 4
Me.TP_SITE_PROPS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_SITE_PROPS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_SITE_PROPS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_SITE_PROPS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_SITE_PROPS.Size = New System.Drawing.Size(538, 104)
Me.TP_SITE_PROPS.TabIndex = 4
'
'TXT_PATH_SAVED_POSTS
'
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Index = 0
ActionButton5.Name = "BTT_CLEAR"
Me.TXT_TOKEN.Buttons.Add(ActionButton5)
Me.TXT_TOKEN.CaptionText = "Token"
Me.TXT_TOKEN.CaptionToolTipEnabled = True
Me.TXT_TOKEN.CaptionToolTipText = "Set token from [x-csrf-token] response header"
Me.TXT_TOKEN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TOKEN.Location = New System.Drawing.Point(3, 69)
Me.TXT_TOKEN.Name = "TXT_TOKEN"
Me.TXT_TOKEN.Size = New System.Drawing.Size(538, 22)
Me.TXT_TOKEN.TabIndex = 2
'
'TXT_AUTH
'
ActionButton5.Name = "BTT_OPEN"
ActionButton6.BackgroundImage = CType(resources.GetObject("ActionButton6.BackgroundImage"), System.Drawing.Image)
ActionButton6.Index = 0
ActionButton6.Index = 1
ActionButton6.Name = "BTT_CLEAR"
Me.TXT_AUTH.Buttons.Add(ActionButton6)
Me.TXT_AUTH.CaptionText = "Authorization"
Me.TXT_AUTH.CaptionToolTipEnabled = True
Me.TXT_AUTH.CaptionToolTipText = "Set authorization from [authorization] response header. This field must start fro" &
"m [Bearer] key word"
Me.TXT_AUTH.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_AUTH.Location = New System.Drawing.Point(3, 102)
Me.TXT_AUTH.Name = "TXT_AUTH"
Me.TXT_AUTH.Size = New System.Drawing.Size(538, 22)
Me.TXT_AUTH.TabIndex = 3
Me.TXT_PATH_SAVED_POSTS.Buttons.Add(ActionButton5)
Me.TXT_PATH_SAVED_POSTS.Buttons.Add(ActionButton6)
Me.TXT_PATH_SAVED_POSTS.CaptionText = "Saved posts path"
Me.TXT_PATH_SAVED_POSTS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_PATH_SAVED_POSTS.Location = New System.Drawing.Point(3, 31)
Me.TXT_PATH_SAVED_POSTS.Name = "TXT_PATH_SAVED_POSTS"
Me.TXT_PATH_SAVED_POSTS.Size = New System.Drawing.Size(538, 22)
Me.TXT_PATH_SAVED_POSTS.TabIndex = 1
'
'CH_GET_USER_MEDIA_ONLY
'
Me.CH_GET_USER_MEDIA_ONLY.AutoSize = True
Me.CH_GET_USER_MEDIA_ONLY.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_USER_MEDIA_ONLY.Location = New System.Drawing.Point(3, 87)
Me.CH_GET_USER_MEDIA_ONLY.Name = "CH_GET_USER_MEDIA_ONLY"
Me.CH_GET_USER_MEDIA_ONLY.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_GET_USER_MEDIA_ONLY.Size = New System.Drawing.Size(538, 19)
Me.CH_GET_USER_MEDIA_ONLY.TabIndex = 3
Me.CH_GET_USER_MEDIA_ONLY.Text = "Get user media only"
Me.CH_GET_USER_MEDIA_ONLY.UseVisualStyleBackColor = True
'
'CONTAINER_MAIN
'
@@ -131,13 +147,13 @@
'CONTAINER_MAIN.ContentPanel
'
Me.CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TP_MAIN)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(544, 132)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(544, 219)
Me.CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_MAIN.LeftToolStripPanelVisible = False
Me.CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
Me.CONTAINER_MAIN.Name = "CONTAINER_MAIN"
Me.CONTAINER_MAIN.RightToolStripPanelVisible = False
Me.CONTAINER_MAIN.Size = New System.Drawing.Size(544, 132)
Me.CONTAINER_MAIN.Size = New System.Drawing.Size(544, 219)
Me.CONTAINER_MAIN.TabIndex = 0
Me.CONTAINER_MAIN.TopToolStripPanelVisible = False
'
@@ -145,23 +161,23 @@
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(544, 132)
Me.ClientSize = New System.Drawing.Size(544, 219)
Me.Controls.Add(Me.CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(560, 171)
Me.MaximumSize = New System.Drawing.Size(560, 258)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(560, 171)
Me.MinimumSize = New System.Drawing.Size(560, 258)
Me.Name = "SiteEditorForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Site"
Me.TP_MAIN.ResumeLayout(False)
Me.TP_MAIN.PerformLayout()
CType(Me.TXT_PATH, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_COOKIES, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_TOKEN, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_AUTH, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_PATH_SAVED_POSTS, System.ComponentModel.ISupportInitialize).EndInit()
Me.CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
Me.CONTAINER_MAIN.ResumeLayout(False)
Me.CONTAINER_MAIN.PerformLayout()
@@ -172,8 +188,9 @@
Private WithEvents CONTAINER_MAIN As ToolStripContainer
Private WithEvents TXT_PATH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_COOKIES As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_TOKEN As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_AUTH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TP_MAIN As TableLayoutPanel
Private WithEvents TXT_PATH_SAVED_POSTS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TP_SITE_PROPS As SiteDefaults
Private WithEvents CH_GET_USER_MEDIA_ONLY As CheckBox
End Class
End Namespace

9
SCrawler/Editors/SiteEditorForm.resx
View File

@@ -206,9 +206,12 @@
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton6.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">

265
SCrawler/Editors/SiteEditorForm.vb
View File

@@ -11,142 +11,221 @@ Imports PersonalUtilities.Forms.Controls
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools.WEB
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Hosts
Namespace Editors
Friend Class SiteEditorForm : Implements IOkCancelToolbar
Private ReadOnly LBL_AUTH As Label
Private ReadOnly LBL_OTHER As Label
Private ReadOnly MyDefs As DefaultFormProps(Of FieldsChecker)
Private ReadOnly MySite As Sites
Friend Sub New(ByVal s As Sites)
Private SpecialButton As Button
#Region "Providers"
Private Class SavedPostsChecker : Implements ICustomProvider
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If Not ACheck(Value) OrElse CStr(Value).Contains("/") Then
Return Nothing
Else
Return Value
End If
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
End Function
End Class
#End Region
Private ReadOnly Property Host As SettingsHost
Friend Sub New(ByVal h As SettingsHost)
InitializeComponent()
MySite = s
MyDefs = New DefaultFormProps(Of FieldsChecker)
Host = h
LBL_AUTH = New Label With {.Text = "Authorization", .TextAlign = ContentAlignment.MiddleCenter, .Dock = DockStyle.Fill}
LBL_OTHER = New Label With {.Text = "Other Parameters", .TextAlign = ContentAlignment.MiddleCenter, .Dock = DockStyle.Fill}
End Sub
Private Sub SiteEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Const LBorder% = 3
Const DOffset% = 100
Try
With MyDefs
.MyViewInitialize(Me, Settings.Design, True)
.AddOkCancelToolbar()
.DelegateClosingChecker()
Select Case MySite
Case Sites.Reddit : Icon = My.Resources.RedditIcon
Case Sites.Twitter : Icon = My.Resources.TwitterIcon
Case Sites.Instagram : Icon = My.Resources.InstagramIcon
Case Else : ShowIcon = False
End Select
Text = MySite.ToString
With Settings(MySite)
TXT_PATH.Text = .Path(False)
With .Responser
If .Cookies Is Nothing Then .Cookies = New CookieKeeper(.CookiesDomain)
SetCookieText()
If MySite = Sites.Twitter Then
TXT_TOKEN.Text = .Headers(API.Base.SiteSettings.Header_Twitter_Token)
TXT_AUTH.Text = .Headers(API.Base.SiteSettings.Header_Twitter_Authorization)
End If
End With
If MySite = Sites.Instagram Then
TXT_TOKEN.Text = .InstaHash
TXT_AUTH.Text = .InstaHash_SP
End If
End With
If MySite = Sites.Twitter Or MySite = Sites.Instagram Then
If MySite = Sites.Instagram Then
TXT_TOKEN.CaptionText = "Hash"
TXT_TOKEN.CaptionToolTipText = "Instagram session hash"
TXT_TOKEN.Buttons.Clear()
TXT_TOKEN.Buttons.AddRange({ActionButton.DefaultButtons.Refresh, ActionButton.DefaultButtons.Clear})
TXT_AUTH.CaptionText = "Hash 2"
TXT_AUTH.CaptionToolTipText = "Instagram session hash for saved posts"
End If
Else
TXT_AUTH.Visible = False
TXT_TOKEN.Visible = False
Dim p As PaddingE = PaddingE.GetOf({TP_MAIN})
Dim s As New Size(Size.Width, Size.Height - p.Vertical(2) - TXT_AUTH.NeededHeight - TXT_TOKEN.NeededHeight)
With TP_MAIN
.RowStyles(2).Height = 0
.RowStyles(3).Height = 0
End With
MinimumSize = s
Size = s
MaximumSize = s
End If
.MyFieldsChecker = New FieldsChecker
With .MyFieldsChecker
If MySite = Sites.Twitter Or MySite = Sites.Instagram Then
.AddControl(Of String)(TXT_TOKEN, TXT_TOKEN.CaptionText)
.AddControl(Of String)(TXT_AUTH, TXT_AUTH.CaptionText, MySite = Sites.Instagram)
With Host
With .Source
Text = .Site
If Not .Icon Is Nothing Then Icon = .Icon Else ShowIcon = False
End With
SetCookieText()
TXT_PATH.Text = .Path(False)
TXT_PATH_SAVED_POSTS.Text = .SavedPostsPath(False)
CH_GET_USER_MEDIA_ONLY.Checked = .GetUserMediaOnly.Value
SiteDefaultsFunctions.SetChecker(TP_SITE_PROPS, Host)
With MyDefs.MyFieldsChecker
.AddControl(Of String)(TXT_PATH, TXT_PATH.CaptionText, True, New SavedPostsChecker)
.AddControl(Of String)(TXT_PATH_SAVED_POSTS, TXT_PATH_SAVED_POSTS.CaptionText, True, New SavedPostsChecker)
End With
If .PropList.Count > 0 Then
Dim offset% = DOffset
Dim h% = 0, c% = 0
Dim laAdded As Boolean = False
Dim loAdded As Boolean = False
If Not Host.IsMyClass Then
h -= 28
TXT_COOKIES.Enabled = False
TXT_COOKIES.Visible = False
TP_MAIN.RowStyles(2).Height = 0
End If
Dim AddTpControl As Action(Of Control, Integer) = Sub(ByVal cnt As Control, ByVal _height As Integer)
TP_SITE_PROPS.RowStyles.Add(New RowStyle(SizeType.Absolute, _height))
TP_SITE_PROPS.RowCount += 1
TP_SITE_PROPS.Controls.Add(cnt, 0, TP_SITE_PROPS.RowStyles.Count - 1)
h += _height
c += 1
End Sub
Dim pArr() As Boolean
If .PropList.Exists(Function(p) If(p.Options?.IsAuth, False)) Then pArr = {True, False} Else pArr = {False}
.PropList.Sort()
For Each pAuth As Boolean In pArr
For Each prop As PropertyValueHost In .PropList
If Not prop.Options Is Nothing Then
With prop
If .Options.IsAuth = pAuth Then
If pArr.Length = 2 Then
Select Case pAuth
Case True
If Not laAdded Then AddTpControl(LBL_AUTH, 25) : laAdded = True
Case False
If Not loAdded Then AddTpControl(LBL_OTHER, 25) : loAdded = True
End Select
End If
.CreateControl()
AddTpControl(.Control, .ControlHeight)
If .Options.LeftOffset > offset Then offset = .Options.LeftOffset
If Not .Options.AllowNull Or Not .ProviderFieldsChecker Is Nothing Then
MyDefs.MyFieldsChecker.AddControl(.Control, .Options.ControlText, .Type, .Options.AllowNull, .ProviderFieldsChecker)
End If
End If
End With
End If
Next
Next
SpecialButton = .GetSettingsButtonInternal
If Not SpecialButton Is Nothing Then AddTpControl(SpecialButton, 28)
offset -= LBorder
TP_SITE_PROPS.BaseControlsPadding = New Padding(offset, 0, 0, 0)
If offset > DOffset - LBorder Then
TXT_PATH.CaptionWidth = offset
TXT_PATH_SAVED_POSTS.CaptionWidth = offset
TXT_COOKIES.CaptionWidth = offset
End If
If c > 0 Or Not Host.IsMyClass Then
Dim ss As New Size(Size.Width, Size.Height + h + c)
MinimumSize = ss
Size = ss
MaximumSize = ss
End If
End If
.EndLoaderOperations()
End With
TextBoxExtended.SetFalseDetector(Me, True, AddressOf .Detector)
.MyFieldsChecker.EndLoaderOperations()
.AppendDetectors()
.EndLoaderOperations()
End With
Catch ex As Exception
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Sub SiteEditorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Host.PropList.Count > 0 Then Host.PropList.ForEach(Sub(p) p.DisposeControl())
If Not SpecialButton Is Nothing Then SpecialButton.Dispose()
LBL_AUTH.Dispose()
LBL_OTHER.Dispose()
End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
If MyDefs.MyFieldsChecker.AllParamsOK Then
If MySite = Sites.Instagram Then
If Not TXT_TOKEN.IsEmptyString AndAlso Not TXT_AUTH.IsEmptyString AndAlso TXT_TOKEN.Text = TXT_AUTH.Text Then
MsgBoxE({"InstaHash for saved posts must be different from InstaHash!", "InstaHash are equal"}, vbCritical)
Exit Sub
Dim i%, ii%
With Host
Dim indxList As New List(Of Integer)
For i = 0 To .PropList.Count - 1
If .PropList(i).PropertiesChecking.ListExists And Not .PropList(i).PropertiesCheckingMethod Is Nothing Then indxList.Add(i)
Next
If indxList.Count > 0 Then
Dim pList As New List(Of PropertyData)
Dim n$()
For i = 0 To indxList.Count - 1
n = .PropList(indxList(i)).PropertiesChecking
For ii = 0 To .PropList.Count - 1
With .PropList(ii)
If n.Contains(.Name) Then pList.Add(New PropertyData(.Name, .GetControlValue))
End With
Next
If pList.Count > 0 AndAlso Not CBool(.PropList(indxList(i)).PropertiesCheckingMethod.Invoke(.Source, {pList})) Then Exit Sub
Next
End If
End If
With Settings(MySite)
If TXT_PATH.IsEmptyString Then .Path = Nothing Else .Path = TXT_PATH.Text
Select Case MySite
Case Sites.Twitter
With .Responser
.Headers(API.Base.SiteSettings.Header_Twitter_Token) = TXT_TOKEN.Text
.Headers(API.Base.SiteSettings.Header_Twitter_Authorization) = TXT_AUTH.Text
End With
Case Sites.Instagram
.InstaHash.Value = TXT_TOKEN.Text
.InstaHash_SP.Value = TXT_AUTH.Text
End Select
.Update()
End With
Settings.BeginUpdate()
If Not Host Is Nothing Then
With Host
SiteDefaultsFunctions.SetPropByChecker(TP_SITE_PROPS, Host)
If TXT_PATH.IsEmptyString Then .Path = Nothing Else .Path = TXT_PATH.Text
.SavedPostsPath = TXT_PATH_SAVED_POSTS.Text
.GetUserMediaOnly.Value = CH_GET_USER_MEDIA_ONLY.Checked
If .PropList.Count > 0 Then .PropList.ForEach(Sub(p) If Not p.Options Is Nothing Then p.UpdateValueByControl())
End With
End If
Settings.EndUpdate()
MyDefs.CloseForm()
End If
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
Private Sub TXT_TOKEN_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_TOKEN.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Refresh Then
With Settings(Sites.Instagram)
If .GatherInstaHash() Then
.InstaHashUpdateRequired.Value = Not .InstaHash.IsEmptyString
TXT_TOKEN.Text = .InstaHash
End If
End With
End If
End Sub
Private Sub TXT_PATH_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_PATH.ActionOnButtonClick
ChangePath(Sender, Host.Path(False), TXT_PATH)
End Sub
Private Sub TXT_PATH_SAVED_POSTS_ActionOnButtonClick(Sender As ActionButton) Handles TXT_PATH_SAVED_POSTS.ActionOnButtonClick
ChangePath(Sender, Host.SavedPostsPath(False), TXT_PATH_SAVED_POSTS)
End Sub
Private Sub ChangePath(ByVal Sender As ActionButton, ByVal PathValue As SFile, ByRef CNT As TextBoxExtended)
If Sender.DefaultButton = ActionButton.DefaultButtons.Open Then
Dim f As SFile = SFile.SelectPath(Settings(MySite).Path(False))
If Not f.IsEmptyString Then TXT_PATH.Text = f
Dim f As SFile = SFile.SelectPath(PathValue)
If Not f.IsEmptyString Then CNT.Text = f
End If
End Sub
Private Sub TXT_COOKIES_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_COOKIES.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Edit Then
Using f As New CookieListForm(Settings(MySite).Responser.Cookies) With {.MyDesignXML = Settings.Design} : f.ShowDialog() : End Using
SetCookieText()
If TypeOf Host.Source Is IResponserContainer Then
Using f As New CookieListForm(DirectCast(Host.Source, IResponserContainer).Responser.Cookies) With {.MyDesignXML = Settings.Design} : f.ShowDialog() : End Using
SetCookieText()
End If
End If
End Sub
Private Sub TXT_COOKIES_ActionOnButtonClearClick() Handles TXT_COOKIES.ActionOnButtonClearClick
With Settings(MySite).Responser
If Not .Cookies Is Nothing Then .Cookies.Dispose()
.Cookies = New CookieKeeper(.CookiesDomain)
End With
SetCookieText()
If TypeOf Host.Source Is IResponserContainer Then
With DirectCast(Host.Source, IResponserContainer).Responser
If Not .Cookies Is Nothing Then .Cookies.Dispose()
.Cookies = New CookieKeeper(.CookiesDomain)
End With
SetCookieText()
End If
End Sub
Private Sub SetCookieText()
TXT_COOKIES.Text = $"{If(Settings(MySite).Responser.Cookies?.Count, 0)} cookies"
If TypeOf Host.Source Is IResponserContainer Then _
TXT_COOKIES.Text = $"{If(DirectCast(Host.Source, IResponserContainer).Responser.Cookies?.Count, 0)} cookies"
End Sub
End Class
End Namespace

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

@@ -26,7 +26,6 @@ Namespace Editors
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(SiteSelectionForm))
Dim ListColumn1 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Dim ListColumn2 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Me.CMB_SITES = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
@@ -60,13 +59,9 @@ Namespace Editors
ListColumn1.DisplayMember = True
ListColumn1.Name = "COL_DISPLAY"
ListColumn1.Text = "Site"
ListColumn1.ValueMember = True
ListColumn1.Width = -1
ListColumn2.Name = "COL_VALUE"
ListColumn2.Text = "Value"
ListColumn2.ValueMember = True
ListColumn2.Visible = False
Me.CMB_SITES.Columns.Add(ListColumn1)
Me.CMB_SITES.Columns.Add(ListColumn2)
Me.CMB_SITES.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_SITES.ListCheckBoxes = True
Me.CMB_SITES.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple

12
SCrawler/Editors/SiteSelectionForm.vb
View File

@@ -12,11 +12,11 @@ Imports PersonalUtilities.Forms.Controls.Base
Namespace Editors
Friend Class SiteSelectionForm : Implements IOkCancelToolbar
Private ReadOnly MyDefs As DefaultFormProps
Friend ReadOnly Property SelectedSites As List(Of Sites)
Friend Sub New(ByVal s As List(Of Sites))
Friend ReadOnly Property SelectedSites As List(Of String)
Friend Sub New(ByVal s As List(Of String))
InitializeComponent()
SelectedSites.ListAddList(s)
If SelectedSites Is Nothing Then SelectedSites = New List(Of Sites)
If SelectedSites Is Nothing Then SelectedSites = New List(Of String)
MyDefs = New DefaultFormProps
End Sub
Private Sub SiteSelectionForm_Load(sender As Object, e As EventArgs) Handles Me.Load
@@ -25,8 +25,8 @@ Namespace Editors
.DelegateClosingChecker()
.AddOkCancelToolbar()
CMB_SITES.BeginUpdate()
Dim sl As List(Of Sites) = ListAddList(Of Sites)(Nothing, [Enum].GetValues(GetType(Sites))).ListWithRemove(Sites.Undefined)
CMB_SITES.Items.AddRange(sl.Select(Function(s) New ListItem({s.ToString, CInt(s)})))
Dim sl As List(Of String) = ListAddList(Nothing, Settings.Plugins.Select(Function(p) p.Name))
CMB_SITES.Items.AddRange(sl.Select(Function(s) New ListItem(s)))
Dim l As New List(Of Integer)
If SelectedSites.Count > 0 Then sl.ForEach(Sub(s) If SelectedSites.Contains(s) Then l.Add(sl.IndexOf(s)))
sl.Clear()
@@ -41,7 +41,7 @@ Namespace Editors
End Sub
Public Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
Try
SelectedSites.ListAddList(CMB_SITES.Items.CheckedItems.Select(Function(i) DirectCast(i.Value(1), Sites)), LAP.ClearBeforeAdd)
SelectedSites.ListAddList(CMB_SITES.Items.CheckedItems.Select(Function(i) CStr(i.Value(0))), LAP.ClearBeforeAdd)
MyDefs.CloseForm()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex)

191
SCrawler/Editors/UserCreatorForm.Designer.vb generated
View File

@@ -16,23 +16,24 @@
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_PARAMS As System.Windows.Forms.TableLayoutPanel
Dim TP_OTHER As System.Windows.Forms.TableLayoutPanel
Dim TP_SITE As System.Windows.Forms.TableLayoutPanel
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(UserCreatorForm))
Dim ListColumn1 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Dim ListColumn2 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Dim TP_PARAMS As System.Windows.Forms.TableLayoutPanel
Dim TP_OTHER As System.Windows.Forms.TableLayoutPanel
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_DOWN_OPTIONS As System.Windows.Forms.TableLayoutPanel
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_DOWN_OPTIONS As System.Windows.Forms.TableLayoutPanel
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton6 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.TXT_USER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TP_SITE = New System.Windows.Forms.TableLayoutPanel()
Me.OPT_REDDIT = New System.Windows.Forms.RadioButton()
Me.OPT_TWITTER = New System.Windows.Forms.RadioButton()
Me.CH_IS_CHANNEL = New System.Windows.Forms.CheckBox()
Me.OPT_INSTAGRAM = New System.Windows.Forms.RadioButton()
Me.OPT_REDGIFS = New System.Windows.Forms.RadioButton()
Me.CMB_SITE = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_OTHER_SETTINGS = New System.Windows.Forms.Button()
Me.CH_TEMP = New System.Windows.Forms.CheckBox()
Me.CH_FAV = New System.Windows.Forms.CheckBox()
Me.CH_PARSE_USER_MEDIA = New System.Windows.Forms.CheckBox()
@@ -48,13 +49,15 @@
Me.TXT_SPEC_FOLDER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_SITE = New System.Windows.Forms.TableLayoutPanel()
TP_PARAMS = New System.Windows.Forms.TableLayoutPanel()
TP_OTHER = New System.Windows.Forms.TableLayoutPanel()
TP_DOWN_OPTIONS = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
TP_MAIN.SuspendLayout()
CType(Me.TXT_USER, System.ComponentModel.ISupportInitialize).BeginInit()
Me.TP_SITE.SuspendLayout()
TP_SITE.SuspendLayout()
CType(Me.CMB_SITE, System.ComponentModel.ISupportInitialize).BeginInit()
TP_PARAMS.SuspendLayout()
TP_OTHER.SuspendLayout()
CType(Me.TXT_DESCR, System.ComponentModel.ISupportInitialize).BeginInit()
@@ -73,7 +76,7 @@
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(Me.TXT_USER, 0, 0)
TP_MAIN.Controls.Add(Me.TP_SITE, 0, 3)
TP_MAIN.Controls.Add(TP_SITE, 0, 3)
TP_MAIN.Controls.Add(TP_PARAMS, 0, 4)
TP_MAIN.Controls.Add(TP_OTHER, 0, 6)
TP_MAIN.Controls.Add(Me.TXT_DESCR, 0, 9)
@@ -112,85 +115,69 @@
'
'TP_SITE
'
Me.TP_SITE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.TP_SITE.ColumnCount = 5
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
Me.TP_SITE.Controls.Add(Me.OPT_REDDIT, 0, 0)
Me.TP_SITE.Controls.Add(Me.OPT_TWITTER, 2, 0)
Me.TP_SITE.Controls.Add(Me.CH_IS_CHANNEL, 1, 0)
Me.TP_SITE.Controls.Add(Me.OPT_INSTAGRAM, 3, 0)
Me.TP_SITE.Controls.Add(Me.OPT_REDGIFS, 4, 0)
Me.TP_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_SITE.Location = New System.Drawing.Point(1, 88)
Me.TP_SITE.Margin = New System.Windows.Forms.Padding(0)
Me.TP_SITE.Name = "TP_SITE"
Me.TP_SITE.RowCount = 1
Me.TP_SITE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_SITE.Size = New System.Drawing.Size(452, 31)
Me.TP_SITE.TabIndex = 3
'
'OPT_REDDIT
'
Me.OPT_REDDIT.AutoSize = True
Me.OPT_REDDIT.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_REDDIT.Location = New System.Drawing.Point(4, 4)
Me.OPT_REDDIT.Name = "OPT_REDDIT"
Me.OPT_REDDIT.Size = New System.Drawing.Size(83, 23)
Me.OPT_REDDIT.TabIndex = 0
Me.OPT_REDDIT.TabStop = True
Me.OPT_REDDIT.Text = "Reddit"
Me.OPT_REDDIT.UseVisualStyleBackColor = True
'
'OPT_TWITTER
'
Me.OPT_TWITTER.AutoSize = True
Me.OPT_TWITTER.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_TWITTER.Location = New System.Drawing.Point(184, 4)
Me.OPT_TWITTER.Name = "OPT_TWITTER"
Me.OPT_TWITTER.Size = New System.Drawing.Size(83, 23)
Me.OPT_TWITTER.TabIndex = 1
Me.OPT_TWITTER.TabStop = True
Me.OPT_TWITTER.Text = "Twitter"
Me.OPT_TWITTER.UseVisualStyleBackColor = True
TP_SITE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_SITE.ColumnCount = 3
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 79.0!))
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 88.0!))
TP_SITE.Controls.Add(Me.CH_IS_CHANNEL, 0, 0)
TP_SITE.Controls.Add(Me.CMB_SITE, 1, 0)
TP_SITE.Controls.Add(Me.BTT_OTHER_SETTINGS, 2, 0)
TP_SITE.Dock = System.Windows.Forms.DockStyle.Fill
TP_SITE.Location = New System.Drawing.Point(1, 88)
TP_SITE.Margin = New System.Windows.Forms.Padding(0)
TP_SITE.Name = "TP_SITE"
TP_SITE.RowCount = 1
TP_SITE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_SITE.Size = New System.Drawing.Size(452, 31)
TP_SITE.TabIndex = 3
'
'CH_IS_CHANNEL
'
Me.CH_IS_CHANNEL.AutoSize = True
Me.CH_IS_CHANNEL.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_IS_CHANNEL.Location = New System.Drawing.Point(94, 4)
Me.CH_IS_CHANNEL.Location = New System.Drawing.Point(4, 4)
Me.CH_IS_CHANNEL.Name = "CH_IS_CHANNEL"
Me.CH_IS_CHANNEL.Size = New System.Drawing.Size(83, 23)
Me.CH_IS_CHANNEL.TabIndex = 2
Me.CH_IS_CHANNEL.Size = New System.Drawing.Size(73, 23)
Me.CH_IS_CHANNEL.TabIndex = 0
Me.CH_IS_CHANNEL.Text = "Channel"
Me.CH_IS_CHANNEL.UseVisualStyleBackColor = True
'
'OPT_INSTAGRAM
'CMB_SITE
'
Me.OPT_INSTAGRAM.AutoSize = True
Me.OPT_INSTAGRAM.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_INSTAGRAM.Location = New System.Drawing.Point(274, 4)
Me.OPT_INSTAGRAM.Name = "OPT_INSTAGRAM"
Me.OPT_INSTAGRAM.Size = New System.Drawing.Size(83, 23)
Me.OPT_INSTAGRAM.TabIndex = 3
Me.OPT_INSTAGRAM.TabStop = True
Me.OPT_INSTAGRAM.Text = "Instagram"
Me.OPT_INSTAGRAM.UseVisualStyleBackColor = True
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Index = 0
ActionButton1.Name = "BTT_COMBOBOX_ARROW"
Me.CMB_SITE.Buttons.Add(ActionButton1)
ListColumn1.Name = "_COL_KEY"
ListColumn1.Text = "Key"
ListColumn1.ValueMember = True
ListColumn1.Visible = False
ListColumn2.DisplayMember = True
ListColumn2.Name = "_COL_VALUE"
ListColumn2.Text = "Value"
ListColumn2.Width = -1
Me.CMB_SITE.Columns.Add(ListColumn1)
Me.CMB_SITE.Columns.Add(ListColumn2)
Me.CMB_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_SITE.Location = New System.Drawing.Point(84, 2)
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(3, 1, 3, 3)
Me.CMB_SITE.Name = "CMB_SITE"
Me.CMB_SITE.Size = New System.Drawing.Size(275, 22)
Me.CMB_SITE.TabIndex = 1
Me.CMB_SITE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
'
'OPT_REDGIFS
'BTT_OTHER_SETTINGS
'
Me.OPT_REDGIFS.AutoSize = True
Me.OPT_REDGIFS.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_REDGIFS.Location = New System.Drawing.Point(364, 4)
Me.OPT_REDGIFS.Name = "OPT_REDGIFS"
Me.OPT_REDGIFS.Size = New System.Drawing.Size(84, 23)
Me.OPT_REDGIFS.TabIndex = 4
Me.OPT_REDGIFS.TabStop = True
Me.OPT_REDGIFS.Text = "RedGifs"
Me.OPT_REDGIFS.UseVisualStyleBackColor = True
Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(364, 2)
Me.BTT_OTHER_SETTINGS.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS"
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(86, 27)
Me.BTT_OTHER_SETTINGS.TabIndex = 2
Me.BTT_OTHER_SETTINGS.Text = "Options"
TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings")
Me.BTT_OTHER_SETTINGS.UseVisualStyleBackColor = True
'
'TP_PARAMS
'
@@ -277,11 +264,11 @@
'
'TXT_DESCR
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Dock = System.Windows.Forms.DockStyle.Top
ActionButton1.Index = 0
ActionButton1.Name = "BTT_CLEAR"
Me.TXT_DESCR.Buttons.Add(ActionButton1)
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Dock = System.Windows.Forms.DockStyle.Top
ActionButton2.Index = 0
ActionButton2.Name = "BTT_CLEAR"
Me.TXT_DESCR.Buttons.Add(ActionButton2)
Me.TXT_DESCR.CaptionDock = System.Windows.Forms.DockStyle.Top
Me.TXT_DESCR.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.None
Me.TXT_DESCR.CaptionVisible = False
@@ -345,14 +332,14 @@
'
'TXT_LABELS
'
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Index = 0
ActionButton2.Name = "BTT_OPEN"
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Index = 1
ActionButton3.Name = "BTT_CLEAR"
Me.TXT_LABELS.Buttons.Add(ActionButton2)
ActionButton3.Index = 0
ActionButton3.Name = "BTT_OPEN"
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Index = 1
ActionButton4.Name = "BTT_CLEAR"
Me.TXT_LABELS.Buttons.Add(ActionButton3)
Me.TXT_LABELS.Buttons.Add(ActionButton4)
Me.TXT_LABELS.CaptionText = "Labels"
Me.TXT_LABELS.CaptionWidth = 50.0R
Me.TXT_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
@@ -404,16 +391,16 @@
'
'TXT_SPEC_FOLDER
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Index = 0
ActionButton4.Name = "BTT_OPEN"
ActionButton4.ToolTipText = "Select a new path in the folder selection dialog"
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Index = 1
ActionButton5.Name = "BTT_CLEAR"
ActionButton5.ToolTipText = "Clear"
Me.TXT_SPEC_FOLDER.Buttons.Add(ActionButton4)
ActionButton5.Index = 0
ActionButton5.Name = "BTT_OPEN"
ActionButton5.ToolTipText = "Select a new path in the folder selection dialog"
ActionButton6.BackgroundImage = CType(resources.GetObject("ActionButton6.BackgroundImage"), System.Drawing.Image)
ActionButton6.Index = 1
ActionButton6.Name = "BTT_CLEAR"
ActionButton6.ToolTipText = "Clear"
Me.TXT_SPEC_FOLDER.Buttons.Add(ActionButton5)
Me.TXT_SPEC_FOLDER.Buttons.Add(ActionButton6)
Me.TXT_SPEC_FOLDER.CaptionText = "Special path"
Me.TXT_SPEC_FOLDER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_SPEC_FOLDER.Location = New System.Drawing.Point(4, 62)
@@ -456,8 +443,9 @@
Me.Text = "Create User"
TP_MAIN.ResumeLayout(False)
CType(Me.TXT_USER, System.ComponentModel.ISupportInitialize).EndInit()
Me.TP_SITE.ResumeLayout(False)
Me.TP_SITE.PerformLayout()
TP_SITE.ResumeLayout(False)
TP_SITE.PerformLayout()
CType(Me.CMB_SITE, System.ComponentModel.ISupportInitialize).EndInit()
TP_PARAMS.ResumeLayout(False)
TP_PARAMS.PerformLayout()
TP_OTHER.ResumeLayout(False)
@@ -479,8 +467,6 @@
Private WithEvents CONTAINER_MAIN As ToolStripContainer
Private WithEvents TXT_USER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents OPT_REDDIT As RadioButton
Private WithEvents OPT_TWITTER As RadioButton
Private WithEvents CH_TEMP As CheckBox
Private WithEvents CH_FAV As CheckBox
Private WithEvents CH_PARSE_USER_MEDIA As CheckBox
@@ -494,9 +480,8 @@
Private WithEvents CH_DOWN_IMAGES As CheckBox
Private WithEvents CH_DOWN_VIDEOS As CheckBox
Private WithEvents CH_IS_CHANNEL As CheckBox
Private WithEvents OPT_INSTAGRAM As RadioButton
Private WithEvents TXT_SPEC_FOLDER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents OPT_REDGIFS As RadioButton
Private WithEvents TP_SITE As TableLayoutPanel
Private WithEvents CMB_SITE As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_OTHER_SETTINGS As Button
End Class
End Namespace

113
SCrawler/Editors/UserCreatorForm.resx
View File

@@ -120,20 +120,113 @@
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_PARAMS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_OTHER.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<metadata name="TP_SITE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL
GlAKCkhEC4KgQlsLQkqhKi/lrYWWlxaw3dLddrerz/Q89+7dc2fbfTn3npf5fJJv2rS758z85nnOzJz5
nZktAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK3O3r79wVUIz65jfGNVxI/VIX69CvGO9M//a9P+e8o3B/8v
vKn9s+3fyX8dAJgmaWd+fl3E96Wd/E9XdvZHkfbvXNa+Rn45AGCS3bvjj/E/h3box5OrmxjPyy8PAEyS
XXO7zqhCeH/HDnwUOdCE+J6zdux4eH47YIrEGE8uy/Ls9Bnx/LooL0oH9b9Th/I1TVG+rCqKC+q6Xsh/
FJgmO8vy6WknfdPQTnsjckMdwlPy2wITLO3wF6si/lGas1ekuXvX0Fzuyg9S3psOCl6qDwimQB3ji9Ok
3btmEm907kpnEa/Mbw9Mlq1pB/6cdHZ/ZcfcPZrcXoXyrVVVFfl1gUmSdsS/libqPUMTd5NSvjktwrbB
kgDjVi1UT26K+Nnu+XrMuaud60uPWHpIfhtg3JqyfEaanHcPTdZNTRPCPy4uLj40LxIwBudt2fKAtOP/
0zQnN+5koIg3tpca81sC49J+LZcm5a3rJulYEq6LSV40YBOFEB6V5uFV6+flRiTsSwf9r81vDYzBCSO4
vjfq/KAuiqfm5QM2QRPjuWnubUbz71DCn6W33zpYCmDT1EX5m92Tcuy5q47xFXkxgQ3UduqnOXfn0Bzc
xJSvz4sCbIb2pzlp8v1w/WScnKSzkjekRT1hsMTAKC0vL5/Ydud3zb1NT1FelBcL2GiDm3d0TMTJy0ea
pjk1LzYwAu3NvtLc+uTQXBtn7tYYCJtja/vQno5JOJFpQrzWb4hhNJoQnpjm1Q3D82wCcnNRFKfnxQQ2
Qttk1zH5JjzhFmcIcHzyzb6O5aFem5J0sP/OvKjARmg7b7sm3xRkT3vDorwawJHb1t6Ep2NOTVoOtDch
yssMjFr6IPh8x8SbnsT4lrQamgPhCMzPzz+sifHjnXNpMnN5XnRglJaWlk5KE2z/0ISbxnzQQ0bgvlXz
1ePSXPnG0NyZ+DRF8Zi8CsCo7Azh0V0TbkrzRc2B0G3wIJ9429CcmZLce4MgYJTyff87JtzU5uayLM/J
qwcM7vD5+jQ3DgzNlWnKDXldgFFJZwW/2jHZpj1727uZ5VWE3mofqJXmw4eG5sdUpqqqXXm1gFGoQnhJ
12SbgRxoYvzjtIruK04vxRjPSvPgK0PzYmqTPqtemVcNGIU6xgu7JtusJH1ovH9ubu6UvLrQC2ncPyuN
/58Mz4fpTvnmvHrAKJQL5dO6J9ssJXxucWFhLq8yzLKtaUf5h2ncb9zz+8eUKsYP53UERmHX/PyOrsk2
g7nJDUWYZUuPWHpIE8oPdIz92UiMn86rCoxIOmOYta8KD5uftk2Peb1hZtTzdVOHcF3HmJ+ZVCF+Ia8u
MCppcl0+PNlmOG1zYPtYYc2BzIQ0np+ZxvWPh8b5LObqvMrAqEzRo4BHmctijCfnEsBUqkP5u2ksz8Kd
PI8g5SfyagOj0jbIpQk2c01DR5Brmh3NfC4DTI324LWO8V0dY3pm48mAsEGm7OEgo0sRb9wZ4+NzGWDi
lWUZ0ti9Zt1YnvUU8fdyCYBRmsFbAh9xqhDvqEN4Xi4FTKz8s93vD4/hPiSdpJyXywCMWPtrgKuGJ12P
ck/6gPmDXAuYOHVR/lY6UN3XMXb7kDv17MAGqhaqJ6WJ1sdegDUJ726a5oG5JDB2917vL+Kl3eO1N/lQ
LgewUdIO8E0dk69vubosy+25JDA2bYNuFeJnOsZovxLjhbkkwEZZXl4+0QfOvfl2Ogg4O5cFNl1dFE9N
4/B7Q+Oyj7mh/VzKZQE2UtM0j6iL+LWOidizhN3OPBiHuigvSmPwrvVjsn9pQnh1LguwGQa3Fo3fHp6M
Pcw97c1WcllgQy0tLZ2UDr7/qmMc9jJNiF/WkwNjMHhQ0GzfX/yIU8RLfRCxkdq+kzTfrugcf/3MgZ1l
+fRcHmCztU8Yq2P8h47J2cdcpTmQjdCE8IQ0vnzjdkjKP8nlAcZoWxXin3dP0n4l1eGb9UL92FwXOG51
Ub48ja09w2Otz2nvTJpKs21QIWDs0lnKb6TJqTEphN3NQvncXBY4VtvSju4N3WOs17l6cXHxoblGwKRo
r8mlHeAtHZO2b9mfDohem8sCR2XX3K4z0hj65NCYklSTGONpuUzApNlVFFWaqP81NHF7mvD2tnM7lwbu
V/vwqTR2vrV+LPU7VSjf4ff+MAU0B65NeWVd12fm0sBhpTnzosHDp7rGUV8T9lVFvDiXCJgSrmEezDea
onhMrgsM25rmyuvSODkwNG56nvZyYvi5XCNg2mgOXM3tVVH9ci4L3KtpmlN9W7Y+VYhfiEkuEzCt8n3L
fzA8yXuY/b7OZEVZlovt3ew6xknf8965ublTcpmAaac5cG3C2zQ09Vv7bVAaC/+7fmz0Og6QYVZpDlyT
GD/dPlgpl4b+2Nru5NIYuGfdmOhxmhB/VBblL+QaATNKc+DBfH1nCI/OdWHGtTewSdv874fGgIT4xfYb
wlwmYNZpDlzNbVUIz85lYUblJ2i6BDacGP/u7O3bH5zLBPSF5sDV7K+L+Nu5LMyYtJP7xbSNfzy0zfue
A+03gak8WwdVAnpHc+CaxHiJ5sCZsnK9f/+6bd3v3JZ2/r+SawT0mebAg0kfjB93v/Pp136t3X693bWN
e56v6nsBhmkOXE24Ph0EnJXrwpSp63qhDuXnu7dtn1P+U1VVP5PLBHAozYGDtD+LchvU6TN4Iqa+lqGs
XO8/YVAlgMPQHLiSsC+dNb0ml4UJVxflRWm73b1+O/Y5YXcVwvNziQDun+bANYnxkvO2bHlALg0TJsZ4
cl3ESzu3Xa8Trm+KYimXCeDIaQ48mKqIH9McOHl2zc/vaIr42a5t1vN8tCiK03OZAI6J5sCVFPFr7QNk
cl0Ys3yp6nvrtlO/s3K9f9ugSgDHSXPgILk58PxcFsYkX+93J8s1qUK8oynKF+YSAYyO5sCVhH3pgOjV
uSxsoqZpHpjq//bu7dLjFPHGND+Xc5kARk9z4JrE+JZUEl+1bpLFhYW5VPf/WLcd5N/ruj4zlwlg42gO
PCQfdXOVjdeE8MRU6xuGai9uXw2MgebA1YTrFkMoc10YsaYoX5rqfOf6uvc6e9LO/xW5RACbT3Pgam5N
B0Q/m8vCCLT3XnCQ2ZXwnWqhenIuE8D4aA5czV3OykZj19yuM1I9PzlUXwnhirIst+cyAYyf5sA1GTQH
uu/6MdoZ4+NTHb+1rq59j+v9wKTSHHhIPtI0zam5NByhNH5enGr306Fa9j1720ttuUQAE0tz4Epi/FJM
cl24b8ZNd25KdTk31whg8mkOXEm4pX1EbS4LHebn5x+WdnIf765fr3NVCOFRuUwA00Nz4Gr21kX58lwW
1qjmq8el+nxjqF4S4yVLS0sn5TIBTB/NgWuiOfAQTVE+J9XltnV16nXCvqqIF+cSAUw3zYGH5INnb9/+
4Fyavtra7uRSLe4Zqk3f88MmxvNyjQBmhiavg/liVVVFrkuvLC4uPjSt/4eG6iEhXlOWZchlApg9mgNX
c3P6wD8nl6UXqvlqZ1rv/xmqQ+/ThPJv5ufnH5TLBDC7NAeuZm97n/tclplWhfCstL4/GVr/nsf1fqCH
NAeu5kB7aSSVZFabA13v786tVVFckGsE0C+aAw8mnSG/f25u7pRcmpnQbt8mlB/oWt8+pwnxWk+PBNAc
uJoqxC/MSnNgs7BQ1yFc17WePc97Z+1AD+C4aA5czU3T/qjXdED3zLQePx5ar75nf77ev3VQJQBWaQ5c
zZ4qhJfkskyVuigvapvbOtapt2lC/FFTls/IJQKgi+bA1aw0B07FGWOM8eQ6xnd1rEe/E+OX2jGdywTA
fdEcuCYx/u2kXzNudjTz6az/c53L3+NUMX7YI6EBjp7mwIO5pt3J5rpMlHKhfFpavu8PLW/fM+s/7QTY
eJoDV/PduiiWc1kmwuB6f7x7aDn7ntvrGC/MJQLgeGgOHKQK8Y46hOflsoxN0zQPbEJ8Z9cy9jxf3RnC
o3OZABgFzYGrab9efl0qyViaAxcXFubSgchnOpar77k8xnhaLhMAo6Q5cE2K+L7NfoBMHcJT0nvfvG5Z
+h3X+wE2iebAg7m6LMvtuS4bKl/v14txSMLuKoQX5BIBsBk0B64kfCfV4om5LCN33pYtD3DA1ZVwfb1Q
PzaXCYDNpDlwJWH3RnSe75rbdUZ6/X9b/369z0eLojg9lwmAcdAcuJqV5sCRaEJ4QnrNbw+9R9+zcr1/
26BKAIyV5sBDcll7W95cmmPSPocgvc6dQ6/b9+xpivJluUQATBDNgQdz1TE2B6phV4p446TdhAmAIens
9ZXpQ1tz4KA58Am5LPfrrB07Hp7+zr90v1Z/UxXxU3Vdn5nLBMAk0xy4krC7WSifm8tyWGVZnl2F+M3u
1+hxYrxkeXn5xFwmAKaB5sDV7E9nsRfnsqyTdnIvGtxiuPPv9jV7Ul1ekUsEwLTRHHgwVSjfsbS0dFIu
TWtr+6uB9P8ODP/Znue7ZVmek2sEwBTT2Laa8sr2enb7jHoHRl0JV8QYH5nHDQCzwJ0DV/P1tKO7vuO/
9zpVKN/qej/AjNIcKB3Z24TyVXmIADCrNAfKmtzUxHhuHhoAzDrNgZJyVQjhUXlIANAjmgN7m/Du471d
MgBTzp0D+5Sw777uiQBAz2gO7EPCLSnn500OAAOaA2c615RlGfKmBoBDaQ6cvTQhvmd+fv5BeRMDwGFp
DpyJuN4PwDHQHDjVubUqigvypgSAo6M5cPrShHjtYghl3oQAcGw0B05Rivi+ubm5U/KmA4Djozlw4rM/
X+/fOthiADA6mgMnME2IP2rK8hl5GwHAxtAcOFH5SozxrLxpAGBjaQ4cf6oYP9w0zal5kwDA5tAcOLYc
aC/FpE1wwmBLAMAm0xy46bk91fvCXH4AGCvNgZuRIn6tKYrH5JoDwGTQHLihuTzGeFouNQBMFs2BI4/r
/QBMB82Bo0rYXYXwglxWAJh8mgOPN+H6eqF+bC4nAEwVzYHHkiL+c1EUp+caAsB00hx4FInxLalk2waV
A4AppznwfrOnLsqX53IBwOzQHHiYFPHGaqF6Ui4TAMwezYGHpirip+q6PjOXBwBmmubANjFesry8fGKu
CQD0Q4+bA/dWMf56LgMA9E8PmwO/W5blOXn1AaC/+tMcWF4ZY3xkXm0AYOabA2O8ZGlp6aS8ugDAGrPY
HLi3CeWr8voBAIczQ82BN6UDmnPzagEA92f6mwPLz1dVVeTVAQCO1LQ2B1Yh/PX8/PyD8moAAEdrupoD
w76qiBfnRQcAjtMUNAeGW1LOz8sLAIzKBDcHXlOWZciLCQCM2gQ2B142Nzd3Sl48AGCjTEhz4H7X+wFg
k425OfDWqqh+Pi8KALDJtqWDgDemHfKBoR30hqUJ8dqY5PcHAMalKcrnpJ3z94Z31qNO+/t+1/sBYIKk
k/LT6hD+Mu2oR/4rgXTW/+X02r+U3woAmDTtz/GaIv5F2nH/ZHhHfpS5J+Vf01n/S9LLbhu8OgAw0dpb
8TYL5XPTmfvb0o78v/MOvWtHvybtzXzKT1Qx/n5d1wv5pQCAaXXvAUFRLLXd+3WMFzZF+cKUl7X/rIri
gsWFhbn8RwEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII=
</value>
</data>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<metadata name="TP_PARAMS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_OTHER.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -141,7 +234,7 @@
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -152,7 +245,7 @@
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -163,7 +256,7 @@
<metadata name="TP_DOWN_OPTIONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -174,7 +267,7 @@
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton6.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go

181
SCrawler/Editors/UserCreatorForm.vb
View File

@@ -8,10 +8,13 @@
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Hosts
Namespace Editors
Friend Class UserCreatorForm : Implements IOkCancelToolbar
Private ReadOnly MyDef As DefaultFormProps(Of FieldsChecker)
@@ -62,8 +65,9 @@ Namespace Editors
Return TXT_USER_FRIENDLY.Text
End Get
End Property
Friend Property MyExchangeOptions As Object = Nothing
Private ReadOnly _SpecPathPattern As RParams = RParams.DM("\w:\\.*", 0, EDP.ReturnValue)
Private ReadOnly Property SpecialPath(ByVal s As Sites) As SFile
Private ReadOnly Property SpecialPath(ByVal s As SettingsHost) As SFile
Get
If TXT_SPEC_FOLDER.IsEmptyString Then
Return Nothing
@@ -71,9 +75,8 @@ Namespace Editors
If Not CStr(RegexReplace(TXT_SPEC_FOLDER.Text, _SpecPathPattern)).IsEmptyString Then
Return $"{TXT_SPEC_FOLDER.Text}\"
Else
Return $"{Settings(s).Path.PathWithSeparator}{TXT_SPEC_FOLDER.Text}\"
Return $"{s.Path.PathWithSeparator}{TXT_SPEC_FOLDER.Text}\"
End If
End If
End Get
End Property
@@ -89,7 +92,7 @@ Namespace Editors
Me.New
If Not _Instance Is Nothing Then
UserInstance = _Instance
User = DirectCast(UserInstance.Self, UserDataBase).User
User = DirectCast(UserInstance, UserDataBase).User
End If
End Sub
Private Sub UserCreatorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
@@ -98,26 +101,26 @@ Namespace Editors
.MyViewInitialize(Me, Settings.Design, True)
.AddOkCancelToolbar()
CH_AUTO_DETECT_SITE.Enabled = False
With CMB_SITE
.BeginUpdate()
.Items.AddRange(Settings.Plugins.Select(Function(p) New ListItem({p.Key, p.Name})))
.EndUpdate(True)
End With
If User.Name.IsEmptyString Then
OPT_REDDIT.Checked = False
OPT_TWITTER.Checked = False
OPT_INSTAGRAM.Checked = False
CH_READY_FOR_DOWN.Checked = True
CH_TEMP.Checked = Settings.DefaultTemporary
CH_DOWN_IMAGES.Checked = Settings.DefaultDownloadImages
CH_DOWN_VIDEOS.Checked = Settings.DefaultDownloadVideos
SetParamsBySite()
Else
TP_ADD_BY_LIST.Enabled = False
TXT_USER.Text = User.Name
TXT_SPEC_FOLDER.Text = User.SpecialPath
Select Case User.Site
Case Sites.Reddit : OPT_REDDIT.Checked = True
Case Sites.Twitter : OPT_TWITTER.Checked = True
Case Sites.Instagram : OPT_INSTAGRAM.Checked = True
Case Sites.RedGifs : OPT_REDGIFS.Checked = True
End Select
Dim i% = Settings.Plugins.FindIndex(Function(p) p.Key = User.Plugin)
If i >= 0 Then CMB_SITE.SelectedIndex = i
SetParamsBySite()
TP_SITE.Enabled = False
CH_IS_CHANNEL.Enabled = False
CMB_SITE.Enabled = False
CH_IS_CHANNEL.Checked = User.IsChannel
If Not UserInstance Is Nothing Then
TXT_USER.Enabled = False
@@ -167,31 +170,26 @@ Namespace Editors
Private Sub UserCreatorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
UserLabels.Clear()
End Sub
Private Function GetSiteByCheckers() As Sites
Select Case True
Case OPT_REDDIT.Checked : Return Sites.Reddit
Case OPT_TWITTER.Checked : Return Sites.Twitter
Case OPT_INSTAGRAM.Checked : Return Sites.Instagram
Case OPT_REDGIFS.Checked : Return Sites.RedGifs
Case Else : Return Sites.Undefined
End Select
Private Function GetSiteByCheckers() As SettingsHost
Return If(CMB_SITE.SelectedIndex >= 0, Settings(CStr(CMB_SITE.Items(CMB_SITE.SelectedIndex).Value(0))), Nothing)
End Function
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
If Not CH_ADD_BY_LIST.Checked Then
If MyDef.MyFieldsChecker.AllParamsOK Then
Dim s As Sites = GetSiteByCheckers()
If Not s = Sites.Undefined Then
Dim s As SettingsHost = GetSiteByCheckers()
If Not s Is Nothing Then
Dim tmpUser As UserInfo = User.Clone
With tmpUser
.Name = TXT_USER.Text
.SpecialPath = SpecialPath(s)
.Site = s
.Site = s.Name
.Plugin = s.Key
.IsChannel = CH_IS_CHANNEL.Checked
.UpdateUserFile()
End With
User = tmpUser
If Not UserInstance Is Nothing Then
With DirectCast(UserInstance.Self, UserDataBase)
With DirectCast(UserInstance, UserDataBase)
.User = User
.FriendlyName = TXT_USER_FRIENDLY.Text
.Favorite = CH_FAV.Checked
@@ -200,6 +198,7 @@ Namespace Editors
.DownloadImages = CH_DOWN_IMAGES.Checked
.DownloadVideos = CH_DOWN_VIDEOS.Checked
.UserDescription = TXT_DESCR.Text
If Not MyExchangeOptions Is Nothing Then .ExchangeOptionsSet(MyExchangeOptions)
Dim l As New ListAddParams(LAP.NotContainsOnly + LAP.ClearBeforeAdd)
If .IsCollection Then
With DirectCast(UserInstance, API.UserDataBind)
@@ -227,65 +226,54 @@ CloseForm:
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDef.CloseForm(IIf(StartIndex >= 0, DialogResult.OK, DialogResult.Cancel))
End Sub
Private ReadOnly TwitterRegEx As RParams = RParams.DMS("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1)
Private ReadOnly RedditRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/user/([^/]+)", 1)
Private ReadOnly RedditRegEx2 As RParams = RParams.DMS(".?u/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/r/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx2 As RParams = RParams.DMS(".?r/([^/]+)", 1)
Private ReadOnly InstagramRegEx As RParams = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
Private ReadOnly RedGifsRegEx As RParams = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
Private _TextChangeInvoked As Boolean = False
Private Sub TXT_USER_ActionOnTextChange() Handles TXT_USER.ActionOnTextChange
Try
If Not _TextChangeInvoked Then
_TextChangeInvoked = True
If Not CH_ADD_BY_LIST.Checked Then
Dim s() As Object = GetSiteByText(TXT_USER.Text)
Select Case s(0)
Case Sites.Twitter : OPT_TWITTER.Checked = True
Case Sites.Reddit : OPT_REDDIT.Checked = True
Case Sites.Instagram : OPT_INSTAGRAM.Checked = True
Case Sites.RedGifs : OPT_REDGIFS.Checked = True
Case Else : OPT_TWITTER.Checked = False : OPT_REDDIT.Checked = False : OPT_INSTAGRAM.Checked = False
End Select
CH_IS_CHANNEL.Checked = CBool(s(1))
Dim s As ExchangeOptions = GetSiteByText(TXT_USER.Text)
Dim found As Boolean = False
If Not s.UserName.IsEmptyString Then
Dim i% = Settings.Plugins.FindIndex(Function(p) p.Key = s.HostKey)
If i >= 0 Then
CMB_SITE.SelectedIndex = i
CH_IS_CHANNEL.Checked = s.IsChannel
TXT_USER.Text = s.UserName
found = True
End If
End If
If Not found Then
CMB_SITE.SelectedIndex = -1
CMB_SITE.Clear(ComboBoxExtended.ClearMode.Text)
CH_IS_CHANNEL.Checked = False
End If
End If
_TextChangeInvoked = False
End If
Catch ex As Exception
End Try
End Sub
Private Function GetSiteByText(ByRef TXT As String) As Object()
If Not TXT.IsEmptyString AndAlso TXT.Length > 8 Then
If CheckRegex(TXT, TwitterRegEx) Then
Return {Sites.Twitter, False}
ElseIf CheckRegex(TXT, RedditRegEx1) OrElse CheckRegex(TXT, RedditRegEx2) Then
Return {Sites.Reddit, False}
ElseIf CheckRegex(TXT, RedditChannelRegEx1) OrElse CheckRegex(TXT, RedditChannelRegEx2) Then
Return {Sites.Reddit, True}
ElseIf CheckRegex(TXT, InstagramRegEx) Then
Return {Sites.Instagram, False}
ElseIf CheckRegex(TXT, RedGifsRegEx) Then
Return {Sites.RedGifs, False}
End If
Private Function GetSiteByText(ByRef TXT As String) As ExchangeOptions
Dim s As ExchangeOptions
For Each p As PluginHost In Settings.Plugins
s = p.Settings.IsMyUser(TXT)
If Not s.UserName.IsEmptyString Then Return s
Next
Return Nothing
End Function
Private Sub CMB_SITE_ActionSelectedItemChanged(ByVal _Item As ListViewItem) Handles CMB_SITE.ActionSelectedItemChanged
CH_IS_CHANNEL.Checked = False
MyExchangeOptions = Nothing
SetParamsBySite()
End Sub
Private Sub BTT_OTHER_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_OTHER_SETTINGS.Click
Dim s As SettingsHost = GetSiteByCheckers()
If Not s Is Nothing Then
s.Source.UserOptions(MyExchangeOptions, True)
MyDef.ChangesDetected = True
MyDef.MyOkCancel.EnableOK = True
End If
Return {Sites.Undefined, False}
End Function
Private Function CheckRegex(ByRef TXT As String, ByVal r As RParams) As Boolean
Dim s$ = RegexReplace(TXT, r)
If Not s.IsEmptyString Then TXT = s : Return True Else Return False
End Function
Private Sub OPT_REDDIT_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_REDDIT.CheckedChanged
If OPT_REDDIT.Checked Then CH_IS_CHANNEL.Enabled = True : SetParamsBySite()
End Sub
Private Sub OPT_TWITTER_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_TWITTER.CheckedChanged
If OPT_TWITTER.Checked Then CH_IS_CHANNEL.Checked = False : CH_IS_CHANNEL.Enabled = False : SetParamsBySite()
End Sub
Private Sub OPT_INSTAGRAM_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_INSTAGRAM.CheckedChanged
If OPT_INSTAGRAM.Checked Then CH_IS_CHANNEL.Checked = False : CH_IS_CHANNEL.Enabled = False : SetParamsBySite()
End Sub
Private Sub OPT_REDGIFS_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_REDGIFS.CheckedChanged
If OPT_REDGIFS.Checked Then CH_IS_CHANNEL.Checked = False : CH_IS_CHANNEL.Enabled = False : SetParamsBySite()
End Sub
Private Sub TXT_SPEC_FOLDER_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_SPEC_FOLDER.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Open Then
@@ -302,15 +290,27 @@ CloseForm:
If CH_FAV.Checked Then CH_TEMP.Checked = False
End Sub
Private Sub SetParamsBySite()
Dim s As Sites = GetSiteByCheckers()
If Not s = Sites.Undefined Then
With Settings(s)
Dim s As SettingsHost = GetSiteByCheckers()
If Not s Is Nothing Then
With s
CH_TEMP.Checked = .Temporary
CH_DOWN_IMAGES.Checked = .DownloadImages
CH_DOWN_VIDEOS.Checked = .DownloadVideos
CH_PARSE_USER_MEDIA.Checked = .GetUserMediaOnly.Value
CH_READY_FOR_DOWN.Checked = Not CH_TEMP.Checked
If s.HasSpecialOptions Then
BTT_OTHER_SETTINGS.Enabled = True
If UserInstance Is Nothing Then
s.Source.UserOptions(MyExchangeOptions, False)
Else
MyExchangeOptions = DirectCast(UserInstance, UserDataBase).ExchangeOptionsGet
End If
Else
BTT_OTHER_SETTINGS.Enabled = False
End If
End With
Else
BTT_OTHER_SETTINGS.Enabled = False
End If
End Sub
Private Sub CH_ADD_BY_LIST_CheckedChanged(sender As Object, e As EventArgs) Handles CH_ADD_BY_LIST.CheckedChanged
@@ -327,10 +327,14 @@ CloseForm:
TXT_USER_FRIENDLY.Enabled = Not CH_ADD_BY_LIST.Checked
End Sub
Private Sub CH_AUTO_DETECT_SITE_CheckedChanged(sender As Object, e As EventArgs) Handles CH_AUTO_DETECT_SITE.CheckedChanged
OPT_REDDIT.Enabled = Not CH_AUTO_DETECT_SITE.Checked
OPT_TWITTER.Enabled = Not CH_AUTO_DETECT_SITE.Checked
OPT_INSTAGRAM.Enabled = Not CH_AUTO_DETECT_SITE.Checked
CH_IS_CHANNEL.Enabled = Not CH_AUTO_DETECT_SITE.Checked
CMB_SITE.Enabled = Not CH_AUTO_DETECT_SITE.Checked
If CH_AUTO_DETECT_SITE.Checked Then
BTT_OTHER_SETTINGS.Enabled = False
MyExchangeOptions = Nothing
Else
BTT_OTHER_SETTINGS.Enabled = True
End If
End Sub
Private Function CreateUsersByList() As Boolean
Try
@@ -343,24 +347,28 @@ CloseForm:
Dim BannedUsers() As String = Nothing
Dim uu$
Dim tmpUser As UserInfo
Dim s As Sites = GetSiteByCheckers()
Dim sObj() As Object
Dim s As SettingsHost = GetSiteByCheckers()
Dim sObj As ExchangeOptions
Dim _IsChannel As Boolean = CH_IS_CHANNEL.Checked
Dim Added% = 0
Dim Skipped% = 0
Dim uid%
Dim sf As Func(Of Sites, String) = Function(__s) SpecialPath(__s).PathWithSeparator
Dim __sf As Func(Of String, Sites, SFile) = Function(Input, __s) IIf(sf(__s).IsEmptyString, Nothing, New SFile($"{sf(__s)}{Input}\"))
Dim sf As Func(Of SettingsHost, String) = Function(__s) SpecialPath(__s).PathWithSeparator
Dim __sf As Func(Of String, SettingsHost, SFile) = Function(Input, __s) IIf(sf(__s).IsEmptyString, Nothing, New SFile($"{sf(__s)}{Input}\"))
For i% = 0 To u.Count - 1
uu = u(i)
If CH_AUTO_DETECT_SITE.Checked Then
sObj = GetSiteByText(uu)
s = sObj(0)
_IsChannel = CBool(sObj(1))
If Not sObj.UserName.IsEmptyString Then
s = Settings(sObj.HostKey)
uu = sObj.UserName
Else
s = Nothing
End If
End If
If Not s = Sites.Undefined Then
If Not s Is Nothing Then
tmpUser = New UserInfo(uu, s,,, __sf(uu, s)) With {.IsChannel = _IsChannel}
uid = -1
If Settings.UsersList.Count > 0 Then uid = Settings.UsersList.IndexOf(tmpUser)
@@ -391,6 +399,9 @@ CloseForm:
.DownloadVideos = CH_DOWN_VIDEOS.Checked
.Labels.ListAddList(UserLabels)
.ParseUserMediaOnly = CH_PARSE_USER_MEDIA.Checked
If Not CH_AUTO_DETECT_SITE.Checked Then _
DirectCast(.Self, UserDataBase).HOST.Source.UserOptions(MyExchangeOptions, False)
DirectCast(.Self, UserDataBase).ExchangeOptionsSet(MyExchangeOptions)
.UpdateUserInformation()
End With
Added += 1

80
SCrawler/FDatePickerForm.Designer.vb generated Normal file
View File

@@ -0,0 +1,80 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class FDatePickerForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Me.DT = New System.Windows.Forms.DateTimePicker()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DT)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(209, 47)
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(209, 47)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'DT
'
Me.DT.Dock = System.Windows.Forms.DockStyle.Fill
Me.DT.Location = New System.Drawing.Point(0, 0)
Me.DT.Name = "DT"
Me.DT.ShowCheckBox = True
Me.DT.Size = New System.Drawing.Size(209, 20)
Me.DT.TabIndex = 0
'
'FDatePickerForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(209, 47)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(225, 86)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(225, 86)
Me.Name = "FDatePickerForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Date limit"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents DT As DateTimePicker
End Class

123
SCrawler/FDatePickerForm.resx Normal file
View File

@@ -0,0 +1,123 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

50
SCrawler/FDatePickerForm.vb Normal file
View File

@@ -0,0 +1,50 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Friend Class FDatePickerForm : Implements IOkCancelDeleteToolbar
Private MyDefs As DefaultFormProps
Friend ReadOnly Property SelectedDate As Date?
Get
If DT.Checked Then Return DT.Value.Date Else Return Nothing
End Get
End Property
Friend Sub New()
InitializeComponent()
End Sub
Private Sub FDatePickerForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
MyDefs = New DefaultFormProps
With MyDefs
.MyViewInitialize(Me, Settings.Design, True)
.AddOkCancelToolbar()
.DelegateClosingChecker()
If Settings.LastUpdatedDate.HasValue Then
DT.Checked = True
DT.Value = Settings.LastUpdatedDate.Value.Date
Else
DT.Checked = False
End If
.EndLoaderOperations()
MyDefs.MyOkCancel.EnableOK = True
End With
Catch ex As Exception
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
MyDefs.CloseForm()
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
Private Sub ToolbarBttDelete() Implements IOkCancelDeleteToolbar.ToolbarBttDelete
MyDefs.CloseForm(DialogResult.Abort)
End Sub
End Class

11
SCrawler/LabelsKeeper.vb
View File

@@ -52,7 +52,7 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
LabelsList.Sort()
TextSaver.SaveTextToFile(LabelsList.ListToString(, vbNewLine), LabelsFile, True, False, EDP.SendInLog)
Else
If LabelsFile.Exists Then LabelsFile.Delete(,,, EDP.SendInLog)
LabelsFile.Delete(, Settings.DeleteMode, EDP.SendInLog)
End If
End Sub
Friend Overloads Sub Add(ByVal _Item As String) Implements ICollection(Of String).Add
@@ -65,10 +65,10 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
If UpdateMainFrame Then RaiseEvent NewLabelAdded()
End If
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of String))
Friend Sub AddRange(ByVal _Items As IEnumerable(Of String), ByVal UpdateMainFrame As Boolean)
If _Items.ListExists Then
For Each i$ In _Items : Add(i, False) : Next
RaiseEvent NewLabelAdded()
If UpdateMainFrame Then RaiseEvent NewLabelAdded()
End If
End Sub
Friend Function Contains(ByVal _Item As String) As Boolean Implements ICollection(Of String).Contains
@@ -93,10 +93,7 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
Clear()
CurrentSelection.Clear()
End If
If disposing Then Clear() : CurrentSelection.Clear()
disposedValue = True
End If
End Sub

187
SCrawler/ListImagesLoader.vb Normal file
View File

@@ -0,0 +1,187 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API
Imports SCrawler.API.Base
Friend Class ListImagesLoader
Private ReadOnly Property MyList As ListView
Private Class UserOption : Implements IComparable(Of UserOption)
Friend ReadOnly User As IUserData
Friend ReadOnly LVI As ListViewItem
Friend Index As Integer
Friend ReadOnly Property Key As String
Get
Return LVI.Name
End Get
End Property
Friend [Image] As Image
Friend Sub New(ByVal u As IUserData, ByVal l As ListView, ByVal GetImage As Boolean)
User = u
LVI = u.GetLVI(l)
Index = u.Index
If GetImage Then Image = u.GetPicture
End Sub
Friend Sub UpdateImage()
Image = User.GetPicture
End Sub
Friend Function CompareTo(ByVal Other As UserOption) As Integer Implements IComparable(Of UserOption).CompareTo
Return Index.CompareTo(Other.Index)
End Function
End Class
Friend Sub New(ByRef l As ListView)
MyList = l
End Sub
Friend Sub Update()
Dim a As Action = Sub()
With MyList
.Items.Clear()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.LargeImageList = New ImageList
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.SmallImageList = New ImageList
If Settings.ViewModeIsPicture Then
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeigh.Value, 100) * 75, Settings.MaxLargeImageHeigh.Value)
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeigh.Value, 100) * 75, Settings.MaxSmallImageHeigh.Value)
End If
End With
End Sub
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
If Settings.Users.Count > 0 Then
Settings.Users.Sort()
Dim v As View = Settings.ViewMode.Value
Dim i%
With MyList
MyList.BeginUpdate()
If Settings.FastProfilesLoading Then
Settings.Users.ListReindex
Dim UData As List(Of UserOption)
If Settings.ViewModeIsPicture Then
UData = GetUsersWithImages()
If UData.ListExists Then
UData.Sort()
Select Case v
Case View.LargeIcon : .LargeImageList.Images.AddRange(UData.Select(Function(u) u.Image).ToArray)
Case View.SmallIcon : .SmallImageList.Images.AddRange(UData.Select(Function(u) u.Image).ToArray)
End Select
End If
Else
UData = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList, False)).ListIfNothing
If UData.ListExists Then UData.Sort()
End If
If UData.ListExists Then
If Settings.ViewModeIsPicture Then
For i = 0 To UData.Count - 1
Select Case v
Case View.LargeIcon : .LargeImageList.Images.SetKeyName(i, UData(i).Key)
Case View.SmallIcon : .SmallImageList.Images.SetKeyName(i, UData(i).Key)
End Select
Next
End If
.Items.AddRange(UData.Select(Function(u) u.LVI).ToArray)
UData.Clear()
End If
Else
Dim t As New List(Of Task)
For Each User As IUserData In Settings.Users
If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True)))
Else
UpdateUser(User, True)
End If
Next
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
End If
End With
MyList.EndUpdate()
End If
End Sub
Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
Try
Dim a As Action
If Add Then
a = Sub()
With MyList
Select Case Settings.ViewMode.Value
Case View.LargeIcon : .LargeImageList.Images.Add(User.Key, User.GetPicture())
Case View.SmallIcon : .SmallImageList.Images.Add(User.Key, User.GetPicture())
End Select
.Items.Add(User.GetLVI(MyList))
End With
End Sub
Else
a = Sub()
With MyList
Dim i% = .Items.IndexOfKey(User.Key)
Dim ImgIndx%
If i >= 0 Then
Select Case Settings.ViewMode.Value
Case View.LargeIcon
ImgIndx = .LargeImageList.Images.IndexOfKey(User.Key)
If ImgIndx >= 0 Then .LargeImageList.Images(ImgIndx) = User.GetPicture()
Case View.SmallIcon
ImgIndx = .SmallImageList.Images.IndexOfKey(User.Key)
If ImgIndx >= 0 Then .SmallImageList.Images(ImgIndx) = User.GetPicture()
End Select
With .Items(i) : .Text = User.ToString() : .Group = User.GetLVIGroup(MyList) : End With
ApplyLVIColor(User, .Items(i), False)
End If
End With
End Sub
End If
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
Catch ex As Exception
End Try
End Sub
Friend Shared Function ApplyLVIColor(ByVal User As IUserData, ByVal LVI As ListViewItem, ByVal IsInit As Boolean) As ListViewItem
With LVI
If Not User.Exists Then
.BackColor = ColorBttDeleteBack
.ForeColor = ColorBttDeleteFore
ElseIf User.Suspended Then
.BackColor = ColorBttEditBack
.ForeColor = ColorBttEditFore
ElseIf CheckUserCollection(User) Then
.BackColor = Color.LightSkyBlue
.ForeColor = Color.MidnightBlue
ElseIf Not IsInit Then
.BackColor = SystemColors.Window
.ForeColor = SystemColors.WindowText
End If
End With
Return LVI
End Function
Private Shared Function CheckUserCollection(ByVal User As IUserData) As Boolean
If User.IsCollection Then
With DirectCast(User, UserDataBind)
If .Count > 0 Then Return .Collections.Exists(Function(c) Not c.Exists) Else Return False
End With
Else
Return False
End If
End Function
Private Function GetUsersWithImages() As List(Of UserOption)
Dim t As New List(Of Task)
Dim l As New List(Of UserOption)
For Each u As IUserData In Settings.Users
If u.FitToAddParams Then t.Add(Task.Run(Sub() l.Add(New UserOption(u, MyList, True))))
Next
If t.Count > 0 Then Task.WaitAll(t.ToArray) : t.Clear()
If l.Count > 0 Then
For i% = 0 To l.Count - 1
If l(i).Image Is Nothing Then l(i).UpdateImage()
Next
End If
Return l
End Function
End Class

165
SCrawler/MainFrame.Designer.vb generated
View File

@@ -17,7 +17,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_SETTINGS As System.Windows.Forms.ToolStripDropDownButton
Dim MENU_SETTINGS_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_2 As System.Windows.Forms.ToolStripSeparator
@@ -29,11 +28,9 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Dim MENU_VIEW_SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim MENU_VIEW_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim TRAY_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_VIEW_SEP_4 As System.Windows.Forms.ToolStripSeparator
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(MainFrame))
Me.BTT_SETTINGS_REDDIT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SETTINGS_TWITTER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SETTINGS_INSTAGRAM = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SETTINGS_REDGIFS = New System.Windows.Forms.ToolStripMenuItem()
Me.MENU_SETTINGS = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_SETTINGS = New System.Windows.Forms.ToolStripMenuItem()
Me.Toolbar_TOP = New System.Windows.Forms.ToolStrip()
Me.BTT_ADD_USER = New System.Windows.Forms.ToolStripButton()
@@ -51,15 +48,19 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_VIEW_LARGE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_SMALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_DETAILS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SITE_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SITE_SPECIFIC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_REGULAR = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_TEMP = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_DELETED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_SUSPENDED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LABELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_NO_LABELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SELECT_LABELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
Me.BTT_VERSION_INFO = New System.Windows.Forms.ToolStripButton()
Me.BTT_DONATE = New System.Windows.Forms.ToolStripButton()
@@ -67,10 +68,8 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_JOBS_COUNT = New System.Windows.Forms.ToolStripStatusLabel()
Me.LBL_STATUS = New System.Windows.Forms.ToolStripStatusLabel()
Me.PR_INST = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_JOBS_INST_COUNT = New System.Windows.Forms.ToolStripStatusLabel()
Me.LBL_STATUS_INST = New System.Windows.Forms.ToolStripStatusLabel()
Me.LIST_PROFILES = New System.Windows.Forms.ListView()
Me.COL_DEF = CType(New System.Windows.Forms.ColumnHeader(), System.Windows.Forms.ColumnHeader)
Me.USER_CONTEXT = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.BTT_CONTEXT_DOWN = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_DOWN_LIMITED = New System.Windows.Forms.ToolStripMenuItem()
@@ -91,10 +90,10 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.TRAY_CONTEXT = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_PR_INFO = New System.Windows.Forms.ToolStripStatusLabel()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_SETTINGS = New System.Windows.Forms.ToolStripDropDownButton()
MENU_SETTINGS_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_3 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
@@ -106,6 +105,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
MENU_VIEW_SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
TRAY_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW_SEP_4 = New System.Windows.Forms.ToolStripSeparator()
Me.Toolbar_TOP.SuspendLayout()
Me.Toolbar_BOTTOM.SuspendLayout()
Me.USER_CONTEXT.SuspendLayout()
@@ -127,53 +127,10 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(218, 6)
'
'MENU_SETTINGS
'
MENU_SETTINGS.AutoToolTip = False
MENU_SETTINGS.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_SETTINGS_REDDIT, Me.BTT_SETTINGS_TWITTER, Me.BTT_SETTINGS_INSTAGRAM, Me.BTT_SETTINGS_REDGIFS, MENU_SETTINGS_SEP_1, Me.BTT_SETTINGS})
MENU_SETTINGS.ImageTransparentColor = System.Drawing.Color.Magenta
MENU_SETTINGS.Name = "MENU_SETTINGS"
MENU_SETTINGS.Size = New System.Drawing.Size(62, 22)
MENU_SETTINGS.Text = "Settings"
'
'BTT_SETTINGS_REDDIT
'
Me.BTT_SETTINGS_REDDIT.Image = Global.SCrawler.My.Resources.Resources.RedditPic512
Me.BTT_SETTINGS_REDDIT.Name = "BTT_SETTINGS_REDDIT"
Me.BTT_SETTINGS_REDDIT.Size = New System.Drawing.Size(127, 22)
Me.BTT_SETTINGS_REDDIT.Text = "Reddit"
'
'BTT_SETTINGS_TWITTER
'
Me.BTT_SETTINGS_TWITTER.Image = Global.SCrawler.My.Resources.Resources.TwitterPic400
Me.BTT_SETTINGS_TWITTER.Name = "BTT_SETTINGS_TWITTER"
Me.BTT_SETTINGS_TWITTER.Size = New System.Drawing.Size(127, 22)
Me.BTT_SETTINGS_TWITTER.Text = "Twitter"
'
'BTT_SETTINGS_INSTAGRAM
'
Me.BTT_SETTINGS_INSTAGRAM.Image = Global.SCrawler.My.Resources.Resources.InstagramPic76
Me.BTT_SETTINGS_INSTAGRAM.Name = "BTT_SETTINGS_INSTAGRAM"
Me.BTT_SETTINGS_INSTAGRAM.Size = New System.Drawing.Size(127, 22)
Me.BTT_SETTINGS_INSTAGRAM.Text = "Instagram"
'
'BTT_SETTINGS_REDGIFS
'
Me.BTT_SETTINGS_REDGIFS.Name = "BTT_SETTINGS_REDGIFS"
Me.BTT_SETTINGS_REDGIFS.Size = New System.Drawing.Size(127, 22)
Me.BTT_SETTINGS_REDGIFS.Text = "RedGifs"
'
'MENU_SETTINGS_SEP_1
'
MENU_SETTINGS_SEP_1.Name = "MENU_SETTINGS_SEP_1"
MENU_SETTINGS_SEP_1.Size = New System.Drawing.Size(124, 6)
'
'BTT_SETTINGS
'
Me.BTT_SETTINGS.Image = Global.SCrawler.My.Resources.Resources.SettingsPic_16
Me.BTT_SETTINGS.Name = "BTT_SETTINGS"
Me.BTT_SETTINGS.Size = New System.Drawing.Size(127, 22)
Me.BTT_SETTINGS.Text = "Settings"
MENU_SETTINGS_SEP_1.Size = New System.Drawing.Size(113, 6)
'
'SEP_3
'
@@ -225,10 +182,31 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
TRAY_SEP_1.Name = "TRAY_SEP_1"
TRAY_SEP_1.Size = New System.Drawing.Size(130, 6)
'
'MENU_VIEW_SEP_4
'
MENU_VIEW_SEP_4.Name = "MENU_VIEW_SEP_4"
MENU_VIEW_SEP_4.Size = New System.Drawing.Size(141, 6)
'
'MENU_SETTINGS
'
Me.MENU_SETTINGS.AutoToolTip = False
Me.MENU_SETTINGS.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {MENU_SETTINGS_SEP_1, Me.BTT_SETTINGS})
Me.MENU_SETTINGS.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_SETTINGS.Name = "MENU_SETTINGS"
Me.MENU_SETTINGS.Size = New System.Drawing.Size(62, 22)
Me.MENU_SETTINGS.Text = "Settings"
'
'BTT_SETTINGS
'
Me.BTT_SETTINGS.Image = Global.SCrawler.My.Resources.Resources.SettingsPic_16
Me.BTT_SETTINGS.Name = "BTT_SETTINGS"
Me.BTT_SETTINGS.Size = New System.Drawing.Size(116, 22)
Me.BTT_SETTINGS.Text = "Settings"
'
'Toolbar_TOP
'
Me.Toolbar_TOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.Toolbar_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {MENU_SETTINGS, SEP_1, Me.BTT_ADD_USER, Me.BTT_EDIT_USER, Me.BTT_DELETE_USER, Me.BTT_REFRESH, Me.BTT_SHOW_INFO, Me.BTT_CHANNELS, Me.BTT_DOWN_SAVED, SEP_2, Me.BTT_DOWN_SELECTED, Me.BTT_DOWN_ALL, Me.BTT_DOWN_VIDEO, Me.BTT_DOWN_STOP, SEP_3, Me.MENU_VIEW, SEP_4, Me.BTT_LOG, Me.BTT_VERSION_INFO, Me.BTT_DONATE})
Me.Toolbar_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_SETTINGS, SEP_1, Me.BTT_ADD_USER, Me.BTT_EDIT_USER, Me.BTT_DELETE_USER, Me.BTT_REFRESH, Me.BTT_SHOW_INFO, Me.BTT_CHANNELS, Me.BTT_DOWN_SAVED, SEP_2, Me.BTT_DOWN_SELECTED, Me.BTT_DOWN_ALL, Me.BTT_DOWN_VIDEO, Me.BTT_DOWN_STOP, SEP_3, Me.MENU_VIEW, SEP_4, Me.BTT_LOG, Me.BTT_VERSION_INFO, Me.BTT_DONATE})
Me.Toolbar_TOP.Location = New System.Drawing.Point(0, 0)
Me.Toolbar_TOP.Name = "Toolbar_TOP"
Me.Toolbar_TOP.Size = New System.Drawing.Size(934, 25)
@@ -339,7 +317,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'
Me.MENU_VIEW.AutoToolTip = False
Me.MENU_VIEW.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_VIEW_LARGE, Me.BTT_VIEW_SMALL, Me.BTT_VIEW_LIST, MENU_VIEW_SEP_1, Me.BTT_SITE_ALL, Me.BTT_SITE_SPECIFIC, MENU_VIEW_SEP_2, Me.BTT_SHOW_ALL, Me.BTT_SHOW_REGULAR, Me.BTT_SHOW_TEMP, Me.BTT_SHOW_FAV, Me.BTT_SHOW_LABELS, Me.BTT_SHOW_NO_LABELS, MENU_VIEW_SEP_3, Me.BTT_SELECT_LABELS})
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_VIEW_LARGE, Me.BTT_VIEW_SMALL, Me.BTT_VIEW_LIST, Me.BTT_VIEW_DETAILS, MENU_VIEW_SEP_1, Me.BTT_SITE_ALL, Me.BTT_SITE_SPECIFIC, MENU_VIEW_SEP_2, Me.BTT_SHOW_ALL, Me.BTT_SHOW_REGULAR, Me.BTT_SHOW_TEMP, Me.BTT_SHOW_FAV, Me.BTT_SHOW_DELETED, Me.BTT_SHOW_SUSPENDED, Me.BTT_SHOW_LABELS, Me.BTT_SHOW_NO_LABELS, MENU_VIEW_SEP_3, Me.BTT_SELECT_LABELS, MENU_VIEW_SEP_4, Me.BTT_SHOW_LIMIT_DATES})
Me.MENU_VIEW.Image = CType(resources.GetObject("MENU_VIEW.Image"), System.Drawing.Image)
Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_VIEW.Name = "MENU_VIEW"
@@ -364,6 +342,12 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_VIEW_LIST.Size = New System.Drawing.Size(144, 22)
Me.BTT_VIEW_LIST.Text = "List"
'
'BTT_VIEW_DETAILS
'
Me.BTT_VIEW_DETAILS.Name = "BTT_VIEW_DETAILS"
Me.BTT_VIEW_DETAILS.Size = New System.Drawing.Size(144, 22)
Me.BTT_VIEW_DETAILS.Text = "Details"
'
'BTT_SITE_ALL
'
Me.BTT_SITE_ALL.Name = "BTT_SITE_ALL"
@@ -400,6 +384,22 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_FAV.Size = New System.Drawing.Size(144, 22)
Me.BTT_SHOW_FAV.Text = "Favorites"
'
'BTT_SHOW_DELETED
'
Me.BTT_SHOW_DELETED.BackColor = System.Drawing.Color.FromArgb(CType(CType(255, Byte), Integer), CType(CType(192, Byte), Integer), CType(CType(192, Byte), Integer))
Me.BTT_SHOW_DELETED.ForeColor = System.Drawing.Color.Maroon
Me.BTT_SHOW_DELETED.Name = "BTT_SHOW_DELETED"
Me.BTT_SHOW_DELETED.Size = New System.Drawing.Size(144, 22)
Me.BTT_SHOW_DELETED.Text = "Deleted"
'
'BTT_SHOW_SUSPENDED
'
Me.BTT_SHOW_SUSPENDED.BackColor = System.Drawing.Color.PapayaWhip
Me.BTT_SHOW_SUSPENDED.ForeColor = System.Drawing.Color.SaddleBrown
Me.BTT_SHOW_SUSPENDED.Name = "BTT_SHOW_SUSPENDED"
Me.BTT_SHOW_SUSPENDED.Size = New System.Drawing.Size(144, 22)
Me.BTT_SHOW_SUSPENDED.Text = "Suspended"
'
'BTT_SHOW_LABELS
'
Me.BTT_SHOW_LABELS.Name = "BTT_SHOW_LABELS"
@@ -418,6 +418,14 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SELECT_LABELS.Size = New System.Drawing.Size(144, 22)
Me.BTT_SELECT_LABELS.Text = "Select labels"
'
'BTT_SHOW_LIMIT_DATES
'
Me.BTT_SHOW_LIMIT_DATES.AutoToolTip = True
Me.BTT_SHOW_LIMIT_DATES.Name = "BTT_SHOW_LIMIT_DATES"
Me.BTT_SHOW_LIMIT_DATES.Size = New System.Drawing.Size(144, 22)
Me.BTT_SHOW_LIMIT_DATES.Text = "Limit dates"
Me.BTT_SHOW_LIMIT_DATES.ToolTipText = "Show profiles that haven't downloaded new data since date..."
'
'BTT_LOG
'
Me.BTT_LOG.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
@@ -452,7 +460,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'
'Toolbar_BOTTOM
'
Me.Toolbar_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.PR_MAIN, Me.LBL_JOBS_COUNT, Me.LBL_STATUS, Me.PR_INST, Me.LBL_JOBS_INST_COUNT, Me.LBL_STATUS_INST})
Me.Toolbar_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_PR_INFO, Me.PR_MAIN, Me.LBL_JOBS_COUNT, Me.LBL_STATUS})
Me.Toolbar_BOTTOM.Location = New System.Drawing.Point(0, 439)
Me.Toolbar_BOTTOM.Name = "Toolbar_BOTTOM"
Me.Toolbar_BOTTOM.Size = New System.Drawing.Size(934, 22)
@@ -474,27 +482,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.LBL_STATUS.Name = "LBL_STATUS"
Me.LBL_STATUS.Size = New System.Drawing.Size(0, 17)
'
'PR_INST
'
Me.PR_INST.Name = "PR_INST"
Me.PR_INST.Size = New System.Drawing.Size(200, 16)
Me.PR_INST.Visible = False
'
'LBL_JOBS_INST_COUNT
'
Me.LBL_JOBS_INST_COUNT.Name = "LBL_JOBS_INST_COUNT"
Me.LBL_JOBS_INST_COUNT.Size = New System.Drawing.Size(0, 17)
'
'LBL_STATUS_INST
'
Me.LBL_STATUS_INST.Name = "LBL_STATUS_INST"
Me.LBL_STATUS_INST.Size = New System.Drawing.Size(0, 17)
'
'LIST_PROFILES
'
Me.LIST_PROFILES.Activation = System.Windows.Forms.ItemActivation.OneClick
Me.LIST_PROFILES.Columns.AddRange(New System.Windows.Forms.ColumnHeader() {Me.COL_DEF})
Me.LIST_PROFILES.ContextMenuStrip = Me.USER_CONTEXT
Me.LIST_PROFILES.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_PROFILES.GridLines = True
Me.LIST_PROFILES.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
Me.LIST_PROFILES.HideSelection = False
Me.LIST_PROFILES.Location = New System.Drawing.Point(0, 25)
@@ -503,6 +497,10 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.LIST_PROFILES.TabIndex = 3
Me.LIST_PROFILES.UseCompatibleStateImageBehavior = False
'
'COL_DEF
'
Me.COL_DEF.Text = "Data"
'
'USER_CONTEXT
'
Me.USER_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.BTT_CONTEXT_DOWN_LIMITED, Me.BTT_CONTEXT_EDIT, Me.BTT_CONTEXT_DELETE, CONTEXT_SEP_1, Me.BTT_CONTEXT_FAV, Me.BTT_CONTEXT_TEMP, Me.BTT_CONTEXT_READY, Me.BTT_CONTEXT_GROUPS, Me.BTT_CONTEXT_ADD_TO_COL, Me.BTT_CONTEXT_COL_MERGE, Me.BTT_CONTEXT_CHANGE_FOLDER, CONTEXT_SEP_2, Me.BTT_CHANGE_IMAGE, CONTEXT_SEP_3, Me.BTT_CONTEXT_OPEN_PATH, CONTEXT_SEP_4, Me.BTT_CONTEXT_OPEN_SITE, CONTEXT_SEP_5, Me.BTT_CONTEXT_INFO})
@@ -643,6 +641,14 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_CLOSE.Size = New System.Drawing.Size(133, 22)
Me.BTT_TRAY_CLOSE.Text = "Close"
'
'BTT_PR_INFO
'
Me.BTT_PR_INFO.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.BTT_PR_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_PR_INFO.Name = "BTT_PR_INFO"
Me.BTT_PR_INFO.Padding = New System.Windows.Forms.Padding(0, 0, 3, 0)
Me.BTT_PR_INFO.Size = New System.Drawing.Size(19, 17)
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -666,9 +672,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.PerformLayout()
End Sub
Private WithEvents BTT_SETTINGS_REDDIT As ToolStripMenuItem
Private WithEvents BTT_SETTINGS_TWITTER As ToolStripMenuItem
Private WithEvents BTT_SETTINGS As ToolStripMenuItem
Private WithEvents BTT_ADD_USER As ToolStripButton
Private WithEvents BTT_DELETE_USER As ToolStripButton
@@ -714,18 +717,20 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents BTT_VERSION_INFO As ToolStripButton
Private WithEvents BTT_CONTEXT_DOWN_LIMITED As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_READY As ToolStripMenuItem
Private WithEvents BTT_SETTINGS_INSTAGRAM As ToolStripMenuItem
Private WithEvents BTT_SITE_ALL As ToolStripMenuItem
Private WithEvents BTT_SITE_SPECIFIC As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_CHANGE_FOLDER As ToolStripMenuItem
Private WithEvents BTT_DOWN_SAVED As ToolStripButton
Private WithEvents PR_INST As ToolStripProgressBar
Private WithEvents LBL_JOBS_INST_COUNT As ToolStripStatusLabel
Private WithEvents LBL_STATUS_INST As ToolStripStatusLabel
Private WithEvents TrayIcon As NotifyIcon
Private WithEvents TRAY_CONTEXT As ContextMenuStrip
Private WithEvents BTT_TRAY_SHOW_HIDE As ToolStripMenuItem
Private WithEvents BTT_TRAY_CLOSE As ToolStripMenuItem
Private WithEvents BTT_SETTINGS_REDGIFS As ToolStripMenuItem
Private WithEvents BTT_DONATE As ToolStripButton
Private WithEvents BTT_SHOW_DELETED As ToolStripMenuItem
Private WithEvents BTT_SHOW_SUSPENDED As ToolStripMenuItem
Private WithEvents BTT_SHOW_LIMIT_DATES As ToolStripMenuItem
Private WithEvents BTT_VIEW_DETAILS As ToolStripMenuItem
Private WithEvents COL_DEF As ColumnHeader
Private WithEvents MENU_SETTINGS As ToolStripDropDownButton
Private WithEvents BTT_PR_INFO As ToolStripStatusLabel
End Class

6
SCrawler/MainFrame.resx
View File

@@ -126,9 +126,6 @@
<metadata name="CONTEXT_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_SETTINGS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_SETTINGS_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
@@ -162,6 +159,9 @@
<metadata name="TRAY_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_VIEW_SEP_4.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="Toolbar_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>132, 17</value>
</metadata>

337
SCrawler/MainFrame.vb
View File

@@ -13,6 +13,8 @@ Imports PersonalUtilities.Forms
Imports SCrawler.API
Imports SCrawler.API.Base
Imports SCrawler.Editors
Imports SCrawler.DownloadObjects
Imports SCrawler.Plugin.Hosts
Public Class MainFrame
Private MyView As FormsView
Private ReadOnly _VideoDownloadingMode As Boolean = False
@@ -26,6 +28,13 @@ Public Class MainFrame
n.TimeSeparator = String.Empty
Twitter.DateProvider = New ADateTime(DirectCast(n.Clone, DateTimeFormatInfo)) With {.DateTimeStyle = DateTimeStyles.AssumeUniversal}
Settings = New SettingsCLS
With Settings.Plugins
If .Count > 0 Then
For i% = 0 To .Count - 1
MENU_SETTINGS.DropDownItems.Insert(MENU_SETTINGS.DropDownItems.Count - 2, .Item(i).Settings.GetSettingsButton)
Next
End If
End With
Dim Args() As String = Environment.GetCommandLineArgs
If Args.ListExists(2) AndAlso Args(1) = "v" Then
Using f As New VideosDownloaderForm : f.ShowDialog() : End Using
@@ -34,61 +43,46 @@ Public Class MainFrame
End Sub
Private Sub MainFrame_Load(sender As Object, e As EventArgs) Handles Me.Load
If _VideoDownloadingMode Then GoTo FormClosingInvoker
Settings.DeleteCachPath()
MainProgress = New Toolbars.MyProgress(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS) With {.DropCurrentProgressOnTotalChange = False, .Enabled = False}
MainProgressInst = New Toolbars.MyProgress(Toolbar_BOTTOM, PR_INST, LBL_STATUS_INST) With {.DropCurrentProgressOnTotalChange = False, .Enabled = False}
Settings.DeleteCachePath()
MainFrameObj = New MainFrameObjects(Me)
MainProgress = New Toolbars.MyProgress(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS, "Downloading profiles' data") With {
.DropCurrentProgressOnTotalChange = False, .Enabled = False}
Downloader = New TDownloader
InfoForm = New DownloadedInfoForm
MyProgressForm = New ActiveDownloadingProgress
Downloader.ReconfPool()
AddHandler Downloader.OnJobsChange, AddressOf Downloader_UpdateJobsCount
AddHandler Downloader.OnDownloading, AddressOf Downloader_OnDownloading
AddHandler Downloader.OnDownloadCountChange, AddressOf InfoForm.Downloader_OnDownloadCountChange
AddHandler Downloader.SendNotification, AddressOf NotificationMessage
AddHandler InfoForm.OnUserLooking, AddressOf Info_OnUserLooking
Settings.LoadUsers()
MyView = New FormsView(Me)
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
If Settings.CloseToTray Then TrayIcon.Visible = True
Dim gk$
With LIST_PROFILES.Groups
'Collections
gk = GetLviGroupName(Sites.Undefined, False, True, True, False)
.Add(New ListViewGroup(gk, gk))
gk = GetLviGroupName(Sites.Undefined, False, False, True, False)
.Add(New ListViewGroup(gk, gk))
gk = GetLviGroupName(Sites.Undefined, True, False, True, False)
.Add(New ListViewGroup(gk, gk))
'Channels
gk = GetLviGroupName(Sites.Undefined, False, True, False, True)
.Add(New ListViewGroup(gk, gk))
gk = GetLviGroupName(Sites.Undefined, False, False, False, True)
.Add(New ListViewGroup(gk, gk))
gk = GetLviGroupName(Sites.Undefined, True, False, False, True)
.Add(New ListViewGroup(gk, gk))
'Sites
For Each s As Sites In [Enum].GetValues(GetType(Sites))
If Not s = Sites.Undefined Then
gk = GetLviGroupName(s, False, True, False, False)
.Add(New ListViewGroup(gk, gk))
gk = GetLviGroupName(s, False, False, False, False)
.Add(New ListViewGroup(gk, gk))
gk = GetLviGroupName(s, True, False, False, False)
.Add(New ListViewGroup(gk, gk))
End If
Next
.AddRange(GetLviGroupName(Nothing, True, False)) 'collections
.AddRange(GetLviGroupName(Nothing, False, True)) 'channels
If Settings.Plugins.Count > 0 Then
For Each h As SettingsHost In Settings.Plugins.Select(Function(hh) hh.Settings) : .AddRange(GetLviGroupName(h, False, False)) : Next
End If
If Settings.Labels.Count > 0 Then Settings.Labels.ToList.ForEach(Sub(l) .Add(New ListViewGroup(l, l)))
.Add(Settings.Labels.NoLabel)
End With
With Settings
LIST_PROFILES.View = .ViewMode
SetViewButtonsCheckers(.ViewMode.Value = View.LargeIcon, .ViewMode.Value = View.SmallIcon, .ViewMode.Value = View.List)
ApplyViewPattern(.ViewMode.Value)
AddHandler .Labels.NewLabelAdded, AddressOf UpdateLabelsGroups
End With
UserListLoader = New ListImagesLoader(LIST_PROFILES)
RefillList()
UpdateLabelsGroups()
SetShowButtonsCheckers(Settings.ShowingMode.Value)
CheckVersion(False)
BTT_SITE_ALL.Checked = Settings.SelectedSites.Count = 0
BTT_SITE_SPECIFIC.Checked = Settings.SelectedSites.Count > 0
BTT_SHOW_LIMIT_DATES.Checked = Settings.LastUpdatedDate.HasValue
_UFinit = False
GoTo EndFunction
FormClosingInvoker:
@@ -145,6 +139,7 @@ DropCloseParams:
_CloseInvoked = False
Exit Sub
CloseContinue:
If Not BATCH Is Nothing Then BATCH.Dispose() : BATCH = Nothing
If Not MyMainLOG.IsEmptyString Then SaveLogToFile()
If _CloseInvoked Then Close()
CloseResume:
@@ -175,6 +170,7 @@ CloseResume:
Select Case e.KeyCode
Case Keys.Insert : BTT_ADD_USER.PerformClick()
Case Keys.Delete : DeleteSelectedUser()
Case Keys.Enter : OpenFolder()
Case Keys.F1 : BTT_VERSION_INFO.PerformClick()
Case Keys.F2 : DownloadVideoByURL()
Case Keys.F3 : EditSelectedUser()
@@ -188,92 +184,11 @@ CloseResume:
CheckVersion(True)
End Sub
Friend Sub RefillList()
Dim a As Action = Sub()
With LIST_PROFILES
.Items.Clear()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.LargeImageList = New ImageList
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.SmallImageList = New ImageList
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeigh.Value, 100) * 75, Settings.MaxLargeImageHeigh.Value)
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeigh.Value, 100) * 75, Settings.MaxSmallImageHeigh.Value)
End With
End Sub
If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke
If Settings.Users.Count > 0 Then
Settings.Users.Sort()
Dim t As New List(Of Task)
For Each User As IUserData In Settings.Users
If User.FitToAddParams Then
If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UserListUpdate(User, True)))
Else
UserListUpdate(User, True)
End If
End If
Next
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
End If
UserListLoader.Update()
GC.Collect()
End Sub
Private Sub UserListUpdate(ByVal User As IUserData, ByVal Add As Boolean)
Try
Dim a As Action
If Add Then
a = Sub()
With LIST_PROFILES
Select Case Settings.ViewMode.Value
Case View.LargeIcon : .LargeImageList.Images.Add(User.LVIKey, User.GetPicture())
Case View.SmallIcon : .SmallImageList.Images.Add(User.LVIKey, User.GetPicture())
End Select
.Items.Add(User.GetLVI(LIST_PROFILES))
If Not User.Exists Then
With .Items(.Items.Count - 1)
.BackColor = ColorBttDeleteBack
.ForeColor = ColorBttDeleteFore
End With
ElseIf User.Suspended Then
With .Items(.Items.Count - 1)
.BackColor = ColorBttEditBack
.ForeColor = ColorBttEditFore
End With
End If
End With
End Sub
Else
a = Sub()
With LIST_PROFILES
Dim i% = .Items.IndexOfKey(User.LVIKey)
Dim ImgIndx%
If i >= 0 Then
Select Case Settings.ViewMode.Value
Case View.LargeIcon
ImgIndx = .LargeImageList.Images.IndexOfKey(User.LVIKey)
If ImgIndx >= 0 Then .LargeImageList.Images(ImgIndx) = User.GetPicture()
Case View.SmallIcon
ImgIndx = .SmallImageList.Images.IndexOfKey(User.LVIKey)
If ImgIndx >= 0 Then .SmallImageList.Images(ImgIndx) = User.GetPicture()
End Select
.Items(i).Text = User.ToString
.Items(i).Group = User.GetLVIGroup(LIST_PROFILES)
If Not User.Exists Then
.Items(i).BackColor = ColorBttDeleteBack
.Items(i).ForeColor = ColorBttDeleteFore
ElseIf User.Suspended Then
.Items(i).BackColor = ColorBttEditBack
.Items(i).ForeColor = ColorBttEditFore
Else
.Items(i).BackColor = SystemColors.Window
.Items(i).ForeColor = SystemColors.WindowText
End If
End If
End With
End Sub
End If
If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke
Catch ex As Exception
End Try
UserListLoader.UpdateUser(User, Add)
End Sub
Private Sub UpdateLabelsGroups()
If Settings.Labels.NewLabelsExists Then
@@ -297,18 +212,6 @@ CloseResume:
End Sub
#Region "Toolbar buttons"
#Region "Settings"
Private Sub BTT_SETTINGS_REDDIT_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS_REDDIT.Click
Using f As New SiteEditorForm(Sites.Reddit) : f.ShowDialog() : End Using
End Sub
Private Sub BTT_SETTINGS_TWITTER_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS_TWITTER.Click
Using f As New SiteEditorForm(Sites.Twitter) : f.ShowDialog() : End Using
End Sub
Private Sub BTT_SETTINGS_INSTAGRAM_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS_INSTAGRAM.Click
Using f As New SiteEditorForm(Sites.Instagram) : f.ShowDialog() : End Using
End Sub
Private Sub BTT_SETTINGS_REDGIFS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS_REDGIFS.Click
Using f As New SiteEditorForm(Sites.RedGifs) : f.ShowDialog() : End Using
End Sub
Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
Dim mhl% = Settings.MaxLargeImageHeigh.Value
Dim mhs% = Settings.MaxSmallImageHeigh.Value
@@ -346,33 +249,18 @@ CloseResume:
.DownloadVideos = f.DownloadVideos
.FriendlyName = f.UserFriendly
.Description = f.UserDescr
If Not f.MyExchangeOptions Is Nothing Then DirectCast(.Self, UserDataBase).ExchangeOptionsSet(f.MyExchangeOptions)
.Self.Labels.ListAddList(f.UserLabels, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
.UpdateUserInformation()
End If
End With
UserListUpdate(Settings.Users.Last, True)
i = LIST_PROFILES.Items.IndexOfKey(Settings.Users(Settings.Users.Count - 1).LVIKey)
If i >= 0 Then
LIST_PROFILES.SelectedIndices.Clear()
With LIST_PROFILES.Items(i)
.Selected = True
.Focused = True
End With
LIST_PROFILES.EnsureVisible(i)
End If
FocusUser(Settings.Users(Settings.Users.Count - 1).Key)
Else
MsgBoxE($"User [{f.User.Name}] was not added")
End If
Else
i = LIST_PROFILES.Items.IndexOfKey(Settings.Users(i).LVIKey)
If i >= 0 Then
LIST_PROFILES.SelectedIndices.Clear()
With LIST_PROFILES.Items(i)
.Selected = True
.Focused = True
End With
LIST_PROFILES.EnsureVisible(i)
End If
FocusUser(Settings.Users(i).Key)
MsgBoxE($"User [{f.User.Name}] already exists", MsgBoxStyle.Exclamation)
End If
End If
@@ -435,49 +323,54 @@ CloseResume:
#End Region
#Region "View"
Private Sub BTT_VIEW_LARGE_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_LARGE.Click
LIST_PROFILES.View = View.LargeIcon
Dim b As Boolean = Not (Settings.ViewMode.Value = View.LargeIcon)
Settings.ViewMode.Value = View.LargeIcon
SetViewButtonsCheckers(True, False, False)
If b Then RefillList()
ApplyViewPattern(ViewModes.IconLarge)
End Sub
Private Sub BTT_VIEW_SMALL_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_SMALL.Click
LIST_PROFILES.View = View.SmallIcon
Dim b As Boolean = Not (Settings.ViewMode.Value = View.SmallIcon)
Settings.ViewMode.Value = View.SmallIcon
SetViewButtonsCheckers(False, True, False)
If b Then RefillList()
ApplyViewPattern(ViewModes.IconSmall)
End Sub
Private Sub BTT_VIEW_LIST_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_LIST.Click
LIST_PROFILES.View = View.List
Dim b As Boolean = Not (Settings.ViewMode.Value = View.List)
Settings.ViewMode.Value = View.List
SetViewButtonsCheckers(False, False, True)
If b Then
With LIST_PROFILES
.LargeImageList.Images.Clear()
.SmallImageList.Images.Clear()
End With
End If
ApplyViewPattern(ViewModes.List)
End Sub
Private Sub SetViewButtonsCheckers(ByVal Large As Boolean, ByVal Small As Boolean, ByVal List As Boolean)
BTT_VIEW_LARGE.Checked = Large
BTT_VIEW_SMALL.Checked = Small
BTT_VIEW_LIST.Checked = List
Private Sub BTT_VIEW_DETAILS_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_DETAILS.Click
ApplyViewPattern(ViewModes.Details)
End Sub
Private Sub ApplyViewPattern(ByVal v As ViewModes)
LIST_PROFILES.View = v
Dim b As Boolean = Not (Settings.ViewMode.Value = v)
Settings.ViewMode.Value = v
BTT_VIEW_LARGE.Checked = v = ViewModes.IconLarge
BTT_VIEW_SMALL.Checked = v = ViewModes.IconSmall
BTT_VIEW_LIST.Checked = v = ViewModes.List
BTT_VIEW_DETAILS.Checked = v = ViewModes.Details
If v = View.Details Then
LIST_PROFILES.Columns(0).Width = -2
LIST_PROFILES.FullRowSelect = True
LIST_PROFILES.GridLines = True
End If
If b Then
If Settings.ViewModeIsPicture Then
With LIST_PROFILES : .LargeImageList.Images.Clear() : .SmallImageList.Images.Clear() : End With
End If
RefillList()
End If
End Sub
#End Region
#Region "View Site"
Private Sub BTT_SITE_ALL_Click(sender As Object, e As EventArgs) Handles BTT_SITE_ALL.Click
Settings.SelectedSites = Nothing
If Not BTT_SITE_ALL.Checked Then Settings.SelectedSites = Nothing : RefillList()
Settings.SelectedSites.Clear()
If Not BTT_SITE_ALL.Checked Then RefillList()
BTT_SITE_ALL.Checked = True
BTT_SITE_SPECIFIC.Checked = False
End Sub
Private Sub BTT_SITE_SPECIFIC_Click(sender As Object, e As EventArgs) Handles BTT_SITE_SPECIFIC.Click
Using f As New SiteSelectionForm(Settings.SelectedSites)
Using f As New SiteSelectionForm(Settings.SelectedSites.ValuesList)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Settings.SelectedSites = f.SelectedSites
Settings.SelectedSites.Clear()
Settings.SelectedSites.AddRange(f.SelectedSites)
BTT_SITE_SPECIFIC.Checked = Settings.SelectedSites.Count > 0
BTT_SITE_ALL.Checked = Settings.SelectedSites.Count = 0
RefillList()
@@ -498,6 +391,12 @@ CloseResume:
Private Sub BTT_SHOW_FAV_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_FAV.Click
SetShowButtonsCheckers(ShowingModes.Favorite)
End Sub
Private Sub BTT_SHOW_DELETED_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_DELETED.Click
SetShowButtonsCheckers(ShowingModes.Deleted)
End Sub
Private Sub BTT_SHOW_SUSPENDED_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_SUSPENDED.Click
SetShowButtonsCheckers(ShowingModes.Suspended)
End Sub
Private Sub BTT_SHOW_LABELS_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_LABELS.Click
SetShowButtonsCheckers(ShowingModes.Labels)
End Sub
@@ -509,6 +408,8 @@ CloseResume:
BTT_SHOW_REGULAR.Checked = m = ShowingModes.Regular
BTT_SHOW_TEMP.Checked = m = ShowingModes.Temporary
BTT_SHOW_FAV.Checked = m = ShowingModes.Favorite
BTT_SHOW_DELETED.Checked = m = ShowingModes.Deleted
BTT_SHOW_SUSPENDED.Checked = m = ShowingModes.Suspended
BTT_SHOW_LABELS.Checked = m = ShowingModes.Labels
BTT_SHOW_NO_LABELS.Checked = m = ShowingModes.NoLabels
BTT_SELECT_LABELS.Enabled = BTT_SHOW_LABELS.Checked
@@ -559,12 +460,34 @@ CloseResume:
End If
End Using
End Sub
Private Sub BTT_SHOW_LIMIT_DATES_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_LIMIT_DATES.Click
Dim r As Boolean = False
Dim snd As Action(Of Date?) = Sub(ByVal d As Date?)
With Settings.LastUpdatedDate
If .HasValue And d.HasValue Then
r = Not .Value.Date = d.Value.Date
Else
r = True
End If
End With
Settings.LastUpdatedDate = d
End Sub
Using f As New FDatePickerForm
f.ShowDialog()
Select Case f.DialogResult
Case DialogResult.Abort : snd(Nothing)
Case DialogResult.OK : snd(f.SelectedDate)
End Select
End Using
BTT_SHOW_LIMIT_DATES.Checked = Settings.LastUpdatedDate.HasValue
If r Then RefillList()
End Sub
#End Region
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(Settings.Design)
End Sub
Private Sub BTT_DONATE_Click(sender As Object, e As EventArgs) Handles BTT_DONATE.Click
Try : Process.Start("https://ko-fi.com/andyprogram") : Catch : End Try
Try : Process.Start("https://github.com/AAndyProgram/SCrawler/HowToSupport.md") : Catch : End Try
End Sub
#Region "List functions"
Private _LatestSelected As Integer = -1
@@ -641,7 +564,7 @@ CloseResume:
If .Count > 0 Then .Collections.ForEach(Sub(uu) uu.Labels.ListAddList(f.LabelsList, lp))
End With
Else
u.Self.Labels.ListAddList(f.LabelsList, lp)
u.Labels.ListAddList(f.LabelsList, lp)
End If
u.UpdateUserInformation()
End Sub)
@@ -664,7 +587,8 @@ CloseResume:
Private Sub BTT_CHANGE_IMAGE_Click(sender As Object, e As EventArgs) Handles BTT_CHANGE_IMAGE.Click
Dim user As IUserData = GetSelectedUser()
If Not user Is Nothing Then
Dim f As SFile = SFile.SelectFiles(user.File, False, "Select new user picture", "Pictures|*.jpeg;*.jpg;*.png").FirstOrDefault
Dim f As SFile = SFile.SelectFiles(user.File.CutPath(IIf(user.IsCollection, 2, 1)), False, "Select new user picture",
"Pictures|*.jpeg;*.jpg;*.png|GIF|*.gif|All Files|*.*").FirstOrDefault
If Not f.IsEmptyString Then
user.SetPicture(f)
UserListUpdate(user, False)
@@ -689,22 +613,18 @@ CloseResume:
Dim Added As Boolean = i < 0
If i < 0 Then
.Users.Add(New UserDataBind(f.Collection))
CollectionHandler(DirectCast(.Users.Last, UserDataBind))
i = .Users.Count - 1
End If
Try
DirectCast(.Users(i), UserDataBind).Add(user)
RemoveUserFromList(user)
i = .Users.FindIndex(fCol)
If i >= 0 Then UserListUpdate(.Users(i), Added) Else RefillList()
If i >= 0 Then UserListUpdate(.Users(i), Added)
MsgBoxE($"[{user.Name}] was added to collection [{f.Collection}]")
Catch ex As InvalidOperationException
i = .Users.FindIndex(fCol)
If i >= 0 Then
If DirectCast(.Users(i), UserDataBind).Count = 0 Then
.Users(i).Dispose()
.Users.RemoveAt(i)
End If
End If
If i >= 0 AndAlso DirectCast(.Users(i), UserDataBind).Count = 0 Then .Users(i).Dispose() : .Users.RemoveAt(i)
End Try
End With
End If
@@ -745,7 +665,7 @@ CloseResume:
If .Count = 0 Then
Throw New ArgumentOutOfRangeException("Collection", "Collection is empty")
Else
With DirectCast(.Collections(0).Self, UserDataBase)
With DirectCast(.Collections(0), UserDataBase)
If Not .User.Merged Then CutOption = 2
End With
End If
@@ -764,14 +684,14 @@ CloseResume:
(Not NewDest.Exists(SFO.Path, False) OrElse
(
SFile.GetFiles(NewDest,, IO.SearchOption.AllDirectories, EDP.ThrowException).ListIfNothing.Count = 0 AndAlso
NewDest.Delete(SFO.Path, False, False, EDP.ThrowException) AndAlso
NewDest.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException) AndAlso
Not NewDest.Exists(SFO.Path, False)
)
) Then
NewDest.CutPath.Exists(SFO.Path)
IO.Directory.Move(CurrDir.Path, NewDest.Path)
Dim ApplyChanges As Action(Of IUserData) = Sub(ByVal __user As IUserData)
With DirectCast(__user.Self, UserDataBase)
With DirectCast(__user, UserDataBase)
Dim u As UserInfo = .User.Clone
Settings.UsersList.Remove(u)
Dim d As SFile = Nothing
@@ -820,7 +740,7 @@ CloseResume:
End Sub
Private Sub BTT_CONTEXT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_INFO.Click
Dim user As IUserData = GetSelectedUser()
If Not user Is Nothing Then MsgBoxE(DirectCast(user.Self, UserDataBase).GetUserInformation())
If Not user Is Nothing Then MsgBoxE(DirectCast(user, UserDataBase).GetUserInformation())
End Sub
Private Sub USER_CONTEXT_VisibleChanged(sender As Object, e As EventArgs) Handles USER_CONTEXT.VisibleChanged
Try
@@ -850,7 +770,7 @@ CloseResume:
Private Function GetSelectedUser() As IUserData
If _LatestSelected >= 0 And _LatestSelected <= LIST_PROFILES.Items.Count - 1 Then
Dim k$ = LIST_PROFILES.Items(_LatestSelected).Name
Dim i% = Settings.Users.FindIndex(Function(u) u.LVIKey = k)
Dim i% = Settings.Users.FindIndex(Function(u) u.Key = k)
If i >= 0 Then
Return Settings.Users(i)
Else
@@ -868,7 +788,7 @@ CloseResume:
Dim indx%
For i% = 0 To .SelectedIndices.Count - 1
k = .Items(.SelectedIndices(i)).Name
indx = Settings.Users.FindIndex(Function(u) u.LVIKey = k)
indx = Settings.Users.FindIndex(Function(u) u.Key = k)
If i >= 0 Then l.Add(Settings.Users(indx))
Next
Return l
@@ -880,7 +800,7 @@ CloseResume:
End Try
End Function
Private Overloads Sub RemoveUserFromList(ByVal _User As IUserData)
RemoveUserFromList(LIST_PROFILES.Items.IndexOfKey(_User.LVIKey), _User.LVIKey)
RemoveUserFromList(LIST_PROFILES.Items.IndexOfKey(_User.Key), _User.Key)
End Sub
Private Overloads Sub RemoveUserFromList(ByVal _Index As Integer, ByVal Key As String)
Dim a As Action = Sub()
@@ -952,10 +872,10 @@ CloseResume:
If banUser Then Settings.BlackList.ListAddValue(New UserBan(user.Name, reason), l) : b = True
If user.IsCollection Then
With DirectCast(user, UserDataBind)
If .Count > 0 Then .Collections.ForEach(Sub(c) Settings.UsersList.Remove(DirectCast(c.Self, UserDataBase).User))
If .Count > 0 Then .Collections.ForEach(Sub(c) Settings.UsersList.Remove(DirectCast(c, UserDataBase).User))
End With
Else
Settings.UsersList.Remove(DirectCast(user.Self, UserDataBase).User)
Settings.UsersList.Remove(DirectCast(user, UserDataBase).User)
End If
Settings.Users.Remove(user)
Settings.UpdateUsersList()
@@ -997,6 +917,14 @@ CloseResume:
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on trying to delete user / collection")
End Try
End Sub
Friend Sub UserRemovedFromCollection(ByVal User As IUserData)
If LIST_PROFILES.Items.Count = 0 OrElse Not LIST_PROFILES.Items.ContainsKey(User.Key) Then UserListUpdate(User, True)
End Sub
Friend Sub CollectionRemoved(ByVal User As IUserData)
With LIST_PROFILES.Items
If .Count > 0 AndAlso .ContainsKey(User.Key) Then .RemoveByKey(User.Key)
End With
End Sub
Private Sub DownloadSelectedUser(ByVal UseLimits As Boolean)
Dim users As List(Of IUserData) = GetSelectedUserArray()
If users.ListExists Then
@@ -1044,17 +972,27 @@ ResumeDownloadingOperation:
If Not user Is Nothing Then user.OpenFolder()
End Sub
#End Region
Private Sub Info_OnUserLooking(ByVal Key As String)
FocusUser(Key, True)
End Sub
Private Sub FocusUser(ByVal Key As String, Optional ByVal ActivateMe As Boolean = False)
Dim i% = LIST_PROFILES.Items.IndexOfKey(Key)
If i >= 0 Then
LIST_PROFILES.Select()
LIST_PROFILES.SelectedIndices.Clear()
With LIST_PROFILES.Items(i) : .Selected = True : .Focused = True : End With
LIST_PROFILES.EnsureVisible(i)
If ActivateMe Then
If Visible Then BringToFront() Else Visible = True
End If
End If
End Sub
Friend Sub User_OnUserUpdated(ByVal User As IUserData)
UserListUpdate(User, False)
End Sub
Private _LogColorChanged As Boolean = False
Private Sub Downloader_UpdateJobsCount(ByVal Site As Sites, ByVal TotalCount As Integer)
Dim a As Action
If Site = Sites.Instagram Then
a = Sub() LBL_JOBS_INST_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]")
Else
a = Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]")
End If
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
a = Sub() BTT_LOG.ControlChangeColor(False)
@@ -1073,4 +1011,7 @@ ResumeDownloadingOperation:
Private Sub NotificationMessage(ByVal Message As String)
If Settings.ShowNotifications Then TrayIcon.ShowBalloonTip(2000, TrayIcon.BalloonTipTitle, Message, ToolTipIcon.Info)
End Sub
Private Sub BTT_PR_INFO_Click(sender As Object, e As EventArgs) Handles BTT_PR_INFO.Click
If MyProgressForm.Visible Then MyProgressForm.BringToFront() Else MyProgressForm.Show()
End Sub
End Class

37
SCrawler/MainFrameObjects.vb Normal file
View File

@@ -0,0 +1,37 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API
Imports SCrawler.API.Base
Friend Class MainFrameObjects
Private ReadOnly Property MF As MainFrame
Friend Sub New(ByRef f As MainFrame)
MF = f
End Sub
Friend Sub ImageHandler(ByVal User As IUserData)
ImageHandler(User, False)
ImageHandler(User, True)
End Sub
Friend Sub ImageHandler(ByVal User As IUserData, ByVal Add As Boolean)
Try
If Add Then
AddHandler User.OnUserUpdated, AddressOf MF.User_OnUserUpdated
Else
RemoveHandler User.OnUserUpdated, AddressOf MF.User_OnUserUpdated
End If
Catch ex As Exception
End Try
End Sub
Friend Sub CollectionHandler(ByVal [Collection] As UserDataBind)
Try
AddHandler Collection.OnCollectionSelfRemoved, AddressOf MF.CollectionRemoved
AddHandler Collection.OnUserRemoved, AddressOf MF.UserRemovedFromCollection
Catch ex As Exception
End Try
End Sub
End Class

197
SCrawler/MainMod.vb
View File

@@ -7,11 +7,16 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Hosts
Imports SCrawler.DownloadObjects
Imports DownOptions = SCrawler.Plugin.ISiteSettings.Download
Friend Module MainMod
Friend Settings As SettingsCLS
Friend Const SettingsFolderName As String = "Settings"
@@ -22,10 +27,38 @@ Friend Module MainMod
Friend Const CannelsLabelName As String = "Channels"
Friend Const LVI_CollectionOption As String = "Collection"
Friend Const LVI_ChannelOption As String = "Channel"
Friend Property BATCH As BatchExecutor
Private _BatchLogSent As Boolean = False
''' <param name="e"><see cref="EDP.None"/></param>
Friend Sub GlobalOpenPath(ByVal f As SFile, Optional ByVal e As ErrorsDescriber = Nothing)
Dim b As Boolean = False
If Not e.Exists Then e = EDP.None
Try
If f.Exists(SFO.Path, False) Then
If Settings.OpenFolderInOtherProgram.Attribute.Value AndAlso Not Settings.OpenFolderInOtherProgram.IsEmptyString Then
If BATCH Is Nothing Then BATCH = New BatchExecutor With {.RedirectStandardError = True}
b = True
With BATCH
.Reset()
.Execute({String.Format(Settings.OpenFolderInOtherProgram.Value, f.PathWithSeparator)}, EDP.SendInLog + EDP.ThrowException)
If .HasError Or Not .ErrorOutput.IsEmptyString Then Throw New Exception(.ErrorOutput, .ErrorException)
End With
Else
f.Open(SFO.Path, e)
End If
End If
Catch ex As Exception
If b Then
If Not _BatchLogSent Then ErrorsDescriber.Execute(EDP.SendInLog, ex, $"GlobalOpenPath({f.Path})") : _BatchLogSent = True
f.Open(SFO.Path, e)
End If
End Try
End Sub
Friend Enum ViewModes As Integer
IconLarge = 0
IconSmall = 2
List = 3
IconLarge = View.LargeIcon
IconSmall = View.SmallIcon
List = View.Tile
Details = View.Details
End Enum
Friend Enum ShowingModes As Integer
All = 0
@@ -34,11 +67,17 @@ Friend Module MainMod
Favorite = 100
Labels = 500
NoLabels = 1000
Deleted = 10000
Suspended = 12000
End Enum
Friend Downloader As TDownloader
Friend InfoForm As DownloadedInfoForm
Friend VideoDownloader As VideosDownloaderForm
Friend UserListLoader As ListImagesLoader
Friend MyProgressForm As ActiveDownloadingProgress
Friend MainFrameObj As MainFrameObjects
Friend ReadOnly ParsersDataDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Friend ReadOnly LogConnector As New LogHost
#Region "File name operations"
Friend FileDateAppenderProvider As IFormatProvider
''' <summary>File, Date</summary>
@@ -51,8 +90,18 @@ Friend Module MainMod
End Class
#End Region
Friend Property MainProgress As MyProgress
Friend Property MainProgressInst As MyProgress
Friend Function GetLviGroupName(ByVal Site As Sites, ByVal Temp As Boolean, ByVal Fav As Boolean,
Friend Function GetLviGroupName(ByVal Host As SettingsHost, ByVal IsCollection As Boolean, ByVal IsChannel As Boolean) As ListViewGroup()
Dim l As New List(Of ListViewGroup)
Dim t$
t = GetLviGroupName(Host, False, True, IsCollection, IsChannel)
l.Add(New ListViewGroup(t, t))
t = GetLviGroupName(Host, False, False, IsCollection, IsChannel)
l.Add(New ListViewGroup(t, t))
t = GetLviGroupName(Host, True, False, IsCollection, IsChannel)
l.Add(New ListViewGroup(t, t))
Return l.ToArray
End Function
Friend Function GetLviGroupName(ByVal Host As SettingsHost, ByVal Temp As Boolean, ByVal Fav As Boolean,
ByVal IsCollection As Boolean, ByVal IsChannel As Boolean) As String
Dim Opt$ = String.Empty
If Temp Then
@@ -66,50 +115,61 @@ Friend Module MainMod
ElseIf IsChannel Then
Return $"{LVI_ChannelOption}{Opt}"
Else
Return $"{Site}{Opt}"
Return $"{If(Host?.Name, String.Empty)}{Opt}"
End If
End Function
Friend Enum Sites As Integer
Undefined = 0
Reddit = 1
Twitter = 2
Instagram = 3
RedGifs = 4
End Enum
Friend Structure UserInfo : Implements IComparable(Of UserInfo), IEquatable(Of UserInfo), ICloneable
Friend Structure UserInfo : Implements IComparable(Of UserInfo), IEquatable(Of UserInfo), ICloneable, IEContainerProvider
Friend Const Name_Site As String = "Site"
Friend Const Name_Plugin As String = "Plugin"
Friend Const Name_Collection As String = "Collection"
Friend Const Name_Merged As String = "Merged"
Friend Const Name_IsChannel As String = "IsChannel"
Friend Const Name_SpecialPath As String = "SpecialPath"
Friend Name As String
Friend Site As Sites
Friend Site As String
Friend Plugin As String
Friend File As SFile
Friend SpecialPath As SFile
Friend Merged As Boolean
Friend IncludedInCollection As Boolean
Friend CollectionName As String
Friend IsChannel As Boolean
Friend Sub New(ByVal _Name As String, ByVal s As Sites, Optional ByVal Collection As String = Nothing,
Friend [Protected] As Boolean
Friend ReadOnly Property DownloadOption As DownOptions
Get
If IsChannel Then
Return DownOptions.Channel
Else
Return DownOptions.Main
End If
End Get
End Property
Friend Sub New(ByVal _Name As String, ByVal Host As SettingsHost, Optional ByVal Collection As String = Nothing,
Optional ByVal _Merged As Boolean = False, Optional ByVal _SpecialPath As SFile = Nothing)
Name = _Name
Site = s
Site = Host.Name
Plugin = Host.Key
IncludedInCollection = Not Collection.IsEmptyString
CollectionName = Collection
Merged = _Merged
SpecialPath = _SpecialPath
UpdateUserFile()
End Sub
Friend Sub New(ByVal x As EContainer)
Me.New(x.Value,
x.Attribute(Name_Site).Value.FromXML(Of Integer)(CInt(Sites.Undefined)),
x.Attribute(Name_Collection).Value, x.Attribute(Name_Merged).Value.FromXML(Of Boolean)(False),
SFile.GetPath(x.Attribute(Name_SpecialPath).Value))
Private Sub New(ByVal x As EContainer)
Name = x.Value
Site = x.Attribute(Name_Site).Value
Plugin = x.Attribute(Name_Plugin).Value
CollectionName = x.Attribute(Name_Collection).Value
IncludedInCollection = Not CollectionName.IsEmptyString
Merged = x.Attribute(Name_Merged).Value.FromXML(Of Boolean)(False)
SpecialPath = SFile.GetPath(x.Attribute(Name_SpecialPath).Value)
IsChannel = x.Attribute(Name_IsChannel).Value.FromXML(Of Boolean)(False)
'UpdateUserFile()
End Sub
Friend Sub New(ByVal c As Reddit.Channel)
Name = c.Name
Site = Sites.Reddit
Site = Reddit.RedditSite
Plugin = Reddit.RedditSiteKey
File = c.File
IsChannel = True
End Sub
@@ -137,6 +197,7 @@ Friend Module MainMod
}
End Sub
Private Function GetFilePathByParams() As String
If [Protected] Then Return String.Empty
If Not SpecialPath.IsEmptyString Then
Return $"{SpecialPath.PathWithSeparator}{SettingsFolderName}"
ElseIf Merged And IncludedInCollection Then
@@ -144,13 +205,18 @@ Friend Module MainMod
Else
If IncludedInCollection Then
Return $"{Settings.CollectionsPathF.PathNoSeparator}\{CollectionName}\{Site}_{Name}\{SettingsFolderName}"
ElseIf Not Settings(Plugin) Is Nothing Then
Return $"{Settings(Plugin).Path.PathNoSeparator}\{Name}\{SettingsFolderName}"
Else
Return $"{Settings(Site).Path.PathNoSeparator}\{Name}\{SettingsFolderName}"
Dim s$ = Site.ToLower
Dim i% = Settings.Plugins.FindIndex(Function(p) p.Name.ToLower = s)
If i >= 0 Then Return $"{Settings.Plugins(i).Settings.Path.PathNoSeparator}\{Name}\{SettingsFolderName}" Else Return String.Empty
End If
End If
End Function
Friend Function GetContainer() As EContainer
Return New EContainer("User", Name, {New EAttribute(Name_Site, CInt(Site)),
Friend Function GetContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer("User", Name, {New EAttribute(Name_Site, Site),
New EAttribute(Name_Plugin, Plugin),
New EAttribute(Name_Collection, CollectionName),
New EAttribute(Name_Merged, Merged.BoolToInteger),
New EAttribute(Name_IsChannel, IsChannel.BoolToInteger),
@@ -160,7 +226,7 @@ Friend Module MainMod
If Site = Other.Site Then
Return Name.CompareTo(Other.Name)
Else
Return CInt(Site).CompareTo(CInt(Other.Site))
Return Site.CompareTo(Other.Site)
End If
End Function
Friend Overloads Function Equals(ByVal Other As UserInfo) As Boolean Implements IEquatable(Of UserInfo).Equals
@@ -173,12 +239,14 @@ Friend Module MainMod
Return New UserInfo With {
.Name = Name,
.Site = Site,
.Plugin = Plugin,
.File = File,
.SpecialPath = SpecialPath,
.Merged = Merged,
.IncludedInCollection = IncludedInCollection,
.CollectionName = CollectionName,
.IsChannel = IsChannel
.IsChannel = IsChannel,
.[Protected] = [Protected]
}
End Function
End Structure
@@ -188,20 +256,10 @@ Friend Module MainMod
ImageHandler(User, True)
End Sub
Friend Sub ImageHandler(ByVal User As IUserData, ByVal Add As Boolean)
Try
If Add Then
AddHandler User.Self.OnUserUpdated, AddressOf MainFrame.User_OnUserUpdated
Else
RemoveHandler User.Self.OnUserUpdated, AddressOf MainFrame.User_OnUserUpdated
End If
Catch ex As Exception
End Try
MainFrameObj.ImageHandler(User, Add)
End Sub
Friend Sub CollectionHandler(ByVal [Collection] As UserDataBind)
Try
AddHandler Collection.OnCollectionSelfRemoved, AddressOf MainFrame.RefillList
Catch ex As Exception
End Try
MainFrameObj.CollectionHandler(Collection)
End Sub
#End Region
#Region "Standalone video download functions"
@@ -211,8 +269,7 @@ Friend Module MainMod
Return b
End Function
Friend Function GetNewVideoURL() As String
Dim b$ = GetCurrentBuffer()
Dim URL$ = InputBoxE("Enter video URL:", "Download video by URL", b)
Dim URL$ = InputBoxE("Enter video URL:", "Download video by URL", GetCurrentBuffer())
If Not URL.IsEmptyString Then Return URL Else Return String.Empty
End Function
Friend Sub DownloadVideoByURL()
@@ -229,27 +286,34 @@ Friend Module MainMod
Dim Result As Boolean = False
If Not URL.IsEmptyString Then
Dim um As IEnumerable(Of UserMedia) = Nothing
Dim site As Sites
Dim IsImgur As Boolean = False
If URL.Contains("twitter") Then
um = Twitter.UserData.GetVideoInfo(URL)
site = Sites.Twitter
ElseIf URL.Contains("redgifs") Then
um = Reddit.UserData.GetVideoInfo(URL)
site = Sites.Reddit
ElseIf URL.Contains("instagram.com") Then
um = Instagram.UserData.GetVideoInfo(URL)
site = Sites.Instagram
ElseIf URL.Contains("imgur.com") Then
um = Imgur.Envir.GetVideoInfo(URL)
IsImgur = True
Else
MsgBoxE("Site of video URL does not recognized" & vbCr & "Operation canceled", MsgBoxStyle.Exclamation, e)
Return False
Dim found As Boolean = False
Dim d As Plugin.ExchangeOptions
If Settings.Plugins.Count > 0 Then
For Each p As PluginHost In Settings.Plugins
d = p.Settings.IsMyImageVideo(URL)
If d.Exists Then
um = Settings(d.HostKey).GetSpecialData(URL)
found = True
Exit For
End If
Next
End If
If Not found Then
If URL.Contains("gfycat") Then
um = Gfycat.Envir.GetVideoInfo(URL)
ElseIf URL.Contains("imgur.com") Then
um = Imgur.Envir.GetVideoInfo(URL)
Else
MsgBoxE("Site of video URL does not recognized" & vbCr & "Operation canceled", MsgBoxStyle.Exclamation, e)
Return False
End If
End If
If um.ListExists Then
Dim f As SFile, ff As SFile
Dim dURL$
Dim FileDownloaded As Boolean = False
For Each u As UserMedia In um
If Not u.URL.IsEmptyString Or Not u.URL_BASE.IsEmptyString Then
f = u.File
@@ -259,23 +323,18 @@ Friend Module MainMod
Settings.LatestSavingPath.Value.Exists(SFO.Path, False) Then f.Path = Settings.LatestSavingPath.Value
If AskForPath OrElse Not f.Exists(SFO.Path, False) Then
#Disable Warning BC40000
If site = Sites.Instagram Or IsImgur Then
ff = SFile.SaveAs(f, "Files destination",,,, EDP.ReturnValue)
If Not ff.IsEmptyString Then
f.Path = ff.Path
Else
f = Nothing
End If
ff = SFile.SaveAs(f, "Files destination",,,, EDP.ReturnValue)
If Not ff.IsEmptyString Then
f.Path = ff.Path
Else
f = SFile.SaveAs(f, "Video file destination", True, "mp4", "Video|*.mp4|All files|*.*", EDP.ReturnValue)
f = Nothing
End If
#Enable Warning
AskForPath = False
End If
If Not f.IsEmptyString Then
Settings.LatestSavingPath.Value = f.PathWithSeparator
Dim dURL$
Dim FileDownloaded As Boolean = False
FileDownloaded = False
Using w As New Net.WebClient
For i% = 0 To 1
If i = 0 Then dURL = u.URL Else dURL = u.URL_BASE

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

12
SCrawler/PluginsEnvironment/Attributes/AttributesInternal.vb Normal file
View File

@@ -0,0 +1,12 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace Plugin.Attributes
<AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=False)> Friend NotInheritable Class UseClassAsIs : Inherits Attribute
End Class
End Namespace

13
SCrawler/PluginsEnvironment/Hosts/IResponserContainer.vb Normal file
View File

@@ -0,0 +1,13 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace Plugin
Friend Interface IResponserContainer
ReadOnly Property Responser As PersonalUtilities.Tools.WEB.Response
End Interface
End Namespace

20
SCrawler/PluginsEnvironment/Hosts/LogHost.vb Normal file
View File

@@ -0,0 +1,20 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace Plugin.Hosts
Friend Class LogHost : Implements ILogProvider
Friend Sub Add(ByVal Message As String) Implements ILogProvider.Add
MyMainLOG = Message
End Sub
Friend Sub Add(ByVal ex As Exception, ByVal Message As String,
Optional ByVal ShowMainMsg As Boolean = False, Optional ByVal ShowErrorMsg As Boolean = False,
Optional ByVal SendInLog As Boolean = True) Implements ILogProvider.Add
ErrorsDescriber.Execute(New ErrorsDescriber(ShowMainMsg, ShowErrorMsg, SendInLog), ex, Message)
End Sub
End Class
End Namespace

101
SCrawler/PluginsEnvironment/Hosts/PluginHost.vb Normal file
View File

@@ -0,0 +1,101 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Reflection
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Tools.WEB.GitHub
Namespace Plugin.Hosts
Friend Class PluginHost
Friend ReadOnly Property Settings As SettingsHost
Friend ReadOnly Property Name As String
Get
Return Settings.Name
End Get
End Property
Friend ReadOnly Property Key As String
Get
Return Settings.Key
End Get
End Property
Friend ReadOnly Property Exists As Boolean
Get
Return Not Settings Is Nothing
End Get
End Property
Private ReadOnly GitHubInfo As Github
Private ReadOnly AssemblyVersion As Version
Friend ReadOnly Property HasNewVersion As Boolean
Get
If Not GitHubInfo Is Nothing Then
Return NewVersionExists(AssemblyVersion, GitHubInfo.UserName, GitHubInfo.Repository)
Else
Return False
End If
End Get
End Property
Friend ReadOnly Property HasError As Boolean
Private Sub New(ByVal s As ISiteSettings, ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean), ByRef _Vids As XMLValue(Of Boolean))
Settings = New SettingsHost(s, _XML, GlobalPath, _Temp, _Imgs, _Vids)
End Sub
Private Sub New(ByVal AssemblyFile As SFile, ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean), ByRef _Vids As XMLValue(Of Boolean))
Try
Dim a As Assembly = Assembly.Load(AssemblyName.GetAssemblyName(AssemblyFile))
If Not a Is Nothing Then
GitHubInfo = a.GetCustomAttribute(Of Github)()
AssemblyVersion = New Version(FileVersionInfo.GetVersionInfo(a.Location).FileVersion)
Dim t() As Type = a.GetTypes
If t.ListExists Then
Dim tSettings$ = GetType(ISiteSettings).FullName
For Each tt As Type In t
If tt.IsInterface Or tt.IsAbstract Then
Continue For
Else
If Not tt.GetInterface(tSettings) Is Nothing Then
Settings = New SettingsHost(Activator.CreateInstance(tt), _XML, GlobalPath, _Temp, _Imgs, _Vids)
End If
End If
Next
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[PluginHost.New]")
_HasError = True
End Try
End Sub
Friend Shared Function GetMyHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean),
ByRef _Vids As XMLValue(Of Boolean)) As IEnumerable(Of PluginHost)
Return {New PluginHost(New API.Reddit.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.Twitter.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.Instagram.SiteSettings(_XML, GlobalPath), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.RedGifs.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)}
End Function
Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean),
ByRef _Vids As XMLValue(Of Boolean)) As IEnumerable(Of PluginHost)
Try
Dim pList As New List(Of PluginHost)
Dim PluginsDir As SFile = SFile.GetPath($"{Application.StartupPath.CSFilePSN}\Plugins")
PluginsDir.Exists(SFO.Path)
Dim fList As List(Of SFile) = SFile.GetFiles(PluginsDir, "*.dll",, EDP.ReturnValue).ListIfNothing
If fList.Count > 0 Then
For Each f As SFile In fList : pList.Add(New PluginHost(f, _XML, GlobalPath, _Temp, _Imgs, _Vids)) : Next
pList.RemoveAll(Function(p) Not p.Exists Or p.HasError)
End If
Return pList
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[PluginHost.GetPluginsHosts]")
Return Nothing
End Try
End Function
End Class
End Namespace

204
SCrawler/PluginsEnvironment/Hosts/PropertyValueHost.vb Normal file
View File

@@ -0,0 +1,204 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls
Imports PersonalUtilities.Forms.Controls.Base
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Imports SCrawler.Plugin.Attributes
Imports System.Reflection
Namespace Plugin.Hosts
Friend Class PropertyValueHost : Implements IPropertyValue, IComparable(Of PropertyValueHost)
Friend Event OnPropertyUpdateRequested(ByVal Sender As PropertyValueHost)
Private Event ValueChanged As IPropertyValue.ValueChangedEventHandler Implements IPropertyValue.ValueChanged
Private _Type As Type
Friend Property [Type] As Type Implements IPropertyValue.Type
Get
Return If(ExternalValue?.Type, _Type)
End Get
Set(ByVal t As Type)
_Type = t
End Set
End Property
#Region "Control"
Friend Property Control As Control
Private ReadOnly ControlNumber As Integer = -1
Friend ReadOnly Property ControlHeight As Integer
Get
If Not Control Is Nothing Then
Return IIf(TypeOf Control Is CheckBox, 25, 28)
Else
Return 0
End If
End Get
End Property
Friend Sub CreateControl(Optional ByVal TT As ToolTip = Nothing)
With Options
If Type Is GetType(Boolean) Then
Control = New CheckBox
If Not .ControlToolTip.IsEmptyString And Not TT Is Nothing Then TT.SetToolTip(Control, .ControlToolTip)
DirectCast(Control, CheckBox).ThreeState = .ThreeStates
DirectCast(Control, CheckBox).Text = .ControlText
If .ThreeStates Then
DirectCast(Control, CheckBox).CheckState = CInt(AConvert(Of Integer)(Value, CInt(CheckState.Indeterminate)))
Else
DirectCast(Control, CheckBox).Checked = CBool(AConvert(Of Boolean)(Value, False))
End If
If .LeftOffset > 0 Then Control.Padding = New PaddingE(Control.Padding) With {.Left = Options.LeftOffset}
Else
Control = New TextBoxExtended
With DirectCast(Control, TextBoxExtended)
.CaptionText = Options.ControlText
.CaptionToolTipEnabled = Not Options.ControlToolTip.IsEmptyString
If Options.LeftOffset > 0 Then .CaptionWidth = Options.LeftOffset
If Not Options.ControlToolTip.IsEmptyString Then .CaptionToolTipText = Options.ControlToolTip : .CaptionToolTipEnabled = True
.Text = CStr(AConvert(Of String)(Value, String.Empty))
With .Buttons
.BeginInit()
If Not Source Is Nothing And Not UpdateMethod Is Nothing Then .Add(New ActionButton(ADB.Refresh))
.Add(ADB.Clear)
.EndInit(True)
End With
AddHandler .ActionOnButtonClick, AddressOf TextBoxClick
End With
End If
Control.Tag = Name
Control.Dock = DockStyle.Fill
End With
End Sub
Friend Sub DisposeControl()
If Not Control Is Nothing Then Control.Dispose() : Control = Nothing
End Sub
Private Sub TextBoxClick(ByVal Sender As ActionButton)
Try
If Sender.DefaultButton = ADB.Refresh AndAlso Not Source Is Nothing AndAlso Not UpdateMethod Is Nothing Then
If CBool(UpdateMethod.Invoke(Source, Nothing)) Then
RaiseEvent OnPropertyUpdateRequested(Me)
DirectCast(Control, TextBoxExtended).Text = CStr(AConvert(Of String)(Value, String.Empty))
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"Updating [{Name}] property")
End Try
End Sub
Friend Sub UpdateValueByControl()
If Not Control Is Nothing Then
If TypeOf Control Is CheckBox Then
With DirectCast(Control, CheckBox)
If Options.ThreeStates Then Value = CInt(.CheckState) Else Value = .Checked
End With
Else
Value = AConvert(DirectCast(Control, TextBoxExtended).Text, AModes.Var, [Type],,,, ProviderValue)
End If
End If
End Sub
Friend Function GetControlValue() As Object
If Not Control Is Nothing Then
If TypeOf Control Is CheckBox Then
With DirectCast(Control, CheckBox)
If Options.ThreeStates Then Return CInt(.CheckState) Else Return .Checked
End With
Else
Return AConvert(DirectCast(Control, TextBoxExtended).Text, AModes.Var, [Type],,,, ProviderValue)
End If
Else
Return Nothing
End If
End Function
#End Region
#Region "Compatibility"
Private ReadOnly Source As Object
Friend ReadOnly Name As String
Private ReadOnly _XmlName As String
Friend ReadOnly Options As PropertyOption
#Region "Providers"
Friend Property ProviderFieldsChecker As IFormatProvider
Friend Property ProviderValue As IFormatProvider
Friend Sub SetProvider(ByVal Provider As IFormatProvider, ByVal FC As Boolean)
If FC Then ProviderFieldsChecker = Provider Else ProviderValue = Provider
End Sub
#End Region
Friend PropertiesChecking As String()
Friend PropertiesCheckingMethod As MethodInfo
Private UpdateMethod As MethodInfo
Private _UpdateDependencies As String() = Nothing
Friend ReadOnly Property UpdateDependencies As String()
Get
Return _UpdateDependencies
End Get
End Property
Friend Sub SetUpdateMethod(ByVal m As MethodInfo, ByVal Dependencies As String())
UpdateMethod = m
_UpdateDependencies = Dependencies
End Sub
Friend ReadOnly IsTaskCounter As Boolean
#End Region
Friend ReadOnly Exists As Boolean = False
#Region "Initializer"
Friend Sub New(ByRef PropertySource As Object, ByVal Member As MemberInfo)
Source = PropertySource
Name = Member.Name
ControlNumber = If(Member.GetCustomAttribute(Of ControlNumber)()?.PropertyNumber, -1)
If DirectCast(Member, PropertyInfo).PropertyType Is GetType(PropertyValue) Then
ExternalValue = DirectCast(DirectCast(Member, PropertyInfo).GetValue(Source), PropertyValue)
_Value = ExternalValue.Value
AddHandler ExternalValue.ValueChanged, AddressOf ExternalValueChanged
Options = Member.GetCustomAttribute(Of PropertyOption)()
IsTaskCounter = Not Member.GetCustomAttribute(Of TaskCounter)() Is Nothing
_XmlName = If(Member.GetCustomAttribute(Of PXML)()?.ElementName, String.Empty)
If Not _XmlName.IsEmptyString Then XValue = XMLValueBase.CreateInstance([Type])
Exists = True
End If
End Sub
Friend Sub SetXmlEnvironment(ByRef Container As Object, Optional ByVal _Nodes() As String = Nothing,
Optional ByVal FormatProvider As IFormatProvider = Nothing)
If Not _XmlName.IsEmptyString And Not XValue Is Nothing Then
XValue.SetEnvironment(_XmlName, _Value, Container, _Nodes, If(ProviderValue, FormatProvider))
Value(False) = XValue.Value
End If
End Sub
#End Region
#Region "Value"
Private ReadOnly Property ExternalValue As PropertyValue
Friend ReadOnly Property XValue As IXMLValue
Private _Value As Object
Friend Overloads Property Value As Object Implements IPropertyValue.Value
Get
Return _Value
End Get
Set(ByVal NewValue As Object)
Value(True) = NewValue
End Set
End Property
Private Overloads WriteOnly Property Value(ByVal UpdateXML As Boolean) As Object
Set(ByVal NewValue As Object)
_Value = NewValue
If Not ExternalValue Is Nothing And Not _ExternalInvoked Then ExternalValue.Value = _Value
If UpdateXML And Not XValue Is Nothing Then XValue.Value = NewValue
RaiseEvent ValueChanged(_Value)
End Set
End Property
Private _ExternalInvoked As Boolean = False
Private Sub ExternalValueChanged(ByVal NewValue As Object)
If Not _ExternalInvoked Then
_ExternalInvoked = True
Value = NewValue
_ExternalInvoked = False
End If
End Sub
#End Region
#Region "IComparable Support"
Private Function CompareTo(ByVal Other As PropertyValueHost) As Integer Implements IComparable(Of PropertyValueHost).CompareTo
Return ControlNumber.CompareTo(Other.ControlNumber)
End Function
#End Region
End Class
End Namespace

321
SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb Normal file
View File

@@ -0,0 +1,321 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Reflection
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace Plugin.Hosts
Friend Class SettingsHost
#Region "Controls"
Private WithEvents BTT_SETTINGS As ToolStripMenuItem
Private WithEvents BTT_SETTINGS_INTERNAL As Button
Private ReadOnly SpecialFormAttribute As SpecialForm = Nothing
Friend Function GetSettingsButton() As ToolStripItem
BTT_SETTINGS = New ToolStripMenuItem With {.Text = Source.Site}
If Not Source.Image Is Nothing Then BTT_SETTINGS.Image = Source.Image
Return BTT_SETTINGS
End Function
Friend Function GetSettingsButtonInternal() As Button
If Not SpecialFormAttribute Is Nothing AndAlso SpecialFormAttribute.SettingsForm Then
BTT_SETTINGS_INTERNAL = New Button With {.Text = "Other settings", .Dock = DockStyle.Right}
Return BTT_SETTINGS_INTERNAL
Else
Return Nothing
End If
End Function
Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
Try
Using f As New Editors.SiteEditorForm(Me) : f.ShowDialog() : End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "[Plugin.Hosts.SettingsHost.OpenSettingsForm]")
End Try
End Sub
Private Sub BTT_SETTINGS_INTERNAL_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS_INTERNAL.Click
Try
If Not SpecialFormAttribute Is Nothing AndAlso SpecialFormAttribute.SettingsForm Then Source.OpenSettingsForm()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "[Plugin.Hosts.SettingsHost.OpenSettingsForm(Button)]")
End Try
End Sub
#End Region
#Region "Host declarations"
Friend ReadOnly Property Source As ISiteSettings
Friend ReadOnly Property PropList As List(Of PropertyValueHost)
Friend ReadOnly Property Name As String
Get
Return Source.Site
End Get
End Property
Private ReadOnly _Key As String
Friend ReadOnly Property Key As String
Get
Return IIf(_Key.IsEmptyString, Name, _Key)
End Get
End Property
Friend ReadOnly Property IsMyClass As Boolean = False
Friend ReadOnly Property IsSeparatedTasks As Boolean = False
Friend ReadOnly Property IsSavedPostsCompatible As Boolean = False
Private ReadOnly _TaskCountDefined As Integer? = Nothing
Friend ReadOnly Property TaskCount As Integer
Get
If IsSeparatedTasks Then
If PropList.Count > 0 Then
Dim i% = PropList.FindIndex(Function(p) p.IsTaskCounter)
If i >= 0 Then Return CInt(PropList(i).Value)
End If
If _TaskCountDefined.HasValue Then Return _TaskCountDefined.Value
End If
Return Settings.MaxUsersJobsCount
End Get
End Property
Friend ReadOnly Property HasSpecialOptions As Boolean = False
#End Region
#Region "Base properties compatibility"
Friend ReadOnly Property Temporary As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadImages As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadVideos As XMLValue(Of Boolean)
Private ReadOnly _Path As XMLValue(Of SFile)
Friend Property Path(Optional ByVal SetProp As Boolean = True) As SFile
Get
If _Path.IsEmptyString Then
Dim tmpPath As SFile = SFile.GetPath($"{Settings.GlobalPath.Value.PathWithSeparator}{Source.Site}")
If SetProp Then _Path.Value = tmpPath Else Return tmpPath
End If
Return _Path.Value
End Get
Set(ByVal NewPath As SFile)
_Path.Value = NewPath
End Set
End Property
Private ReadOnly _SavedPostsPath As XMLValue(Of SFile)
Friend Property SavedPostsPath(Optional ByVal GetAny As Boolean = True) As SFile
Get
If Not _SavedPostsPath.Value.IsEmptyString Then
Return _SavedPostsPath.Value
Else
If GetAny Then
Return $"{Path.PathNoSeparator}\!Saved\"
Else
Return Nothing
End If
End If
End Get
Set(ByVal NewPath As SFile)
_SavedPostsPath.Value = NewPath
End Set
End Property
Friend ReadOnly Property GetUserMediaOnly As XMLValue(Of Boolean)
#End Region
#Region "Host internal functions"
Private Sub PropHost_OnPropertyUpdateRequested(ByVal Sender As PropertyValueHost)
If Sender.UpdateDependencies.ListExists Then
Settings.BeginUpdate()
For Each p As PropertyValueHost In PropList
If Sender.UpdateDependencies.Contains(p.Name) Then p.UpdateValueByControl()
Next
Settings.EndUpdate()
End If
End Sub
#End Region
Friend Sub New(ByVal Plugin As ISiteSettings, ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean), ByRef _Vids As XMLValue(Of Boolean))
Source = Plugin
PropList = New List(Of PropertyValueHost)
Dim ClsAttr As IEnumerable(Of Attribute) = Source.GetType.GetCustomAttributes
If ClsAttr.ListExists Then
For Each a As Attribute In ClsAttr
If TypeOf a Is Manifest Then
_Key = DirectCast(a, Manifest).GUID
ElseIf TypeOf a Is UseClassAsIs Then
IsMyClass = True
ElseIf TypeOf a Is SeparatedTasks Then
IsSeparatedTasks = True
With DirectCast(a, SeparatedTasks)
If .TasksCount > 0 Then _TaskCountDefined = .TasksCount
End With
ElseIf TypeOf a Is SavedPosts Then
IsSavedPostsCompatible = True
ElseIf TypeOf a Is SpecialForm Then
With DirectCast(a, SpecialForm)
If .SettingsForm Then
SpecialFormAttribute = a
Else
HasSpecialOptions = True
End If
End With
End If
Next
End If
Dim i%
Source.BeginInit()
Dim n() As String = {SettingsCLS.Name_Node_Sites, Name}
If If(_XML(n)?.Count, 0) > 0 Then Source.Load(_XML(n).ToKeyValuePair)
Dim Members As IEnumerable(Of MemberInfo) = Plugin.GetType.GetTypeInfo.DeclaredMembers
If Members.ListExists Then
Dim Updaters As New List(Of MemberInfo)
Dim Providers As New List(Of MemberInfo)
Dim PropCheckers As New List(Of MemberInfo)
Dim m As MemberInfo
For Each m In Members
If m.MemberType = MemberTypes.Property Then PropList.Add(New PropertyValueHost(Source, m))
With m.GetCustomAttributes()
If .ListExists Then
If m.MemberType = MemberTypes.Method Then
For i = 0 To .Count - 1
If .ElementAt(i).GetType Is GetType(PropertyUpdater) Then
Updaters.Add(m)
ElseIf .ElementAt(i).GetType Is GetType(PropertiesDataChecker) Then
PropCheckers.Add(m)
End If
Next
ElseIf m.MemberType = MemberTypes.Property Then
If Not m.GetCustomAttribute(Of Provider)() Is Nothing Then Providers.Add(m)
End If
End If
End With
Next
PropList.RemoveAll(Function(p) Not p.Exists)
If Updaters.Count > 0 Then
Dim up As PropertyUpdater
For Each m In Updaters
up = m.GetCustomAttribute(Of PropertyUpdater)()
i = PropList.FindIndex(Function(p) p.Name = up.Name)
If i >= 0 Then PropList(i).SetUpdateMethod(DirectCast(m, MethodInfo), up.Dependencies)
Next
Updaters.Clear()
End If
If Providers.Count > 0 Then
Dim prov As Provider
For Each m In Providers
prov = m.GetCustomAttribute(Of Provider)()
i = PropList.FindIndex(Function(p) p.Name = prov.Name)
If i >= 0 Then
PropList(i).SetProvider(DirectCast(DirectCast(m, PropertyInfo).GetValue(Source), IFormatProvider),
m.GetCustomAttribute(Of Provider)().FieldsChecker)
End If
Next
Providers.Clear()
End If
If PropCheckers.Count > 0 Then
Dim pc As PropertiesDataChecker
For Each m In PropCheckers
pc = m.GetCustomAttribute(Of PropertiesDataChecker)()
If pc.ComparableNames.ListExists Then
i = PropList.FindIndex(Function(p) p.Name = pc.ComparableNames(0))
If i >= 0 Then
With PropList(i)
.PropertiesChecking = pc.ComparableNames
.PropertiesCheckingMethod = DirectCast(m, MethodInfo)
End With
End If
End If
Next
PropCheckers.Clear()
End If
End If
_Path = New XMLValue(Of SFile)("Path",, _XML, n, New XMLValueBase.ToFilePath)
_SavedPostsPath = New XMLValue(Of SFile)("SavedPostsPath",, _XML, n, New XMLValueBase.ToFilePath)
Temporary = New XMLValue(Of Boolean)
Temporary.SetExtended("Temporary", False, _XML, n)
Temporary.SetDefault(_Temp)
DownloadImages = New XMLValue(Of Boolean)
DownloadImages.SetExtended("DownloadImages", True, _XML, n)
DownloadImages.SetDefault(_Imgs)
DownloadVideos = New XMLValue(Of Boolean)
DownloadVideos.SetExtended("DownloadVideos", True, _XML, n)
DownloadVideos.SetDefault(_Vids)
GetUserMediaOnly = New XMLValue(Of Boolean)("GetUserMediaOnly", True, _XML, n)
If PropList.Count > 0 Then
For Each p As PropertyValueHost In PropList
p.SetXmlEnvironment(_XML, n)
AddHandler p.OnPropertyUpdateRequested, AddressOf PropHost_OnPropertyUpdateRequested
Next
End If
Source.EndInit()
End Sub
#Region "Forks"
Friend Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim s As ExchangeOptions = Source.IsMyUser(UserURL)
If Not s.UserName.IsEmptyString Then s.HostKey = Key
Return s
End Function
Friend Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
Dim s As ExchangeOptions = Source.IsMyImageVideo(URL)
If s.Exists Then s.SiteName = Name : s.HostKey = Key
Return s
End Function
Friend Function GetSpecialData(ByVal URL As String) As IEnumerable(Of UserMedia)
If IsMyClass Then
Return DirectCast(Source, SiteSettingsBase).GetSpecialDataF(URL)
Else
Dim um As IEnumerable(Of IPluginUserMedia) = Source.GetSpecialData(URL)
If um.ListExists Then
Dim u As New List(Of UserMedia)
For Each d As IPluginUserMedia In um : u.Add(New UserMedia(d)) : Next
Return u
End If
Return Nothing
End If
End Function
Friend Function GetInstance(ByVal What As Download, ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True,
Optional ByVal AttachUserInfo As Boolean = True) As IUserData
Dim p As IPluginContentProvider = Source.GetInstance(What)
If Not p Is Nothing Then
Dim pp As IUserData
If IsMyClass Then pp = p Else pp = New UserDataHost(p)
pp.SetEnvironment(Me, u, _LoadUserInformation, AttachUserInfo)
Return pp
Else
Throw New ArgumentNullException("IPluginContentProvider", $"Plugin [{Key}] does not provide user instance")
End If
End Function
Private _AvailableValue As Boolean = True
Private _AvailableAsked As Boolean = False
Private _ActiveTaskCount As Integer = 0
Friend Function Available(ByVal What As Download) As Boolean
If Not _AvailableAsked Then
_AvailableValue = Source.Available(What)
_AvailableAsked = True
End If
Return _AvailableValue
End Function
Friend Sub DownloadStarted(ByVal What As Download)
_ActiveTaskCount += 1
Source.DownloadStarted(What)
End Sub
Friend Sub BeforeStartDownload(ByVal User As IUserData, ByVal What As Download)
Source.BeforeStartDownload(ConvertUser(User), What)
End Sub
Friend Sub AfterDownload(ByVal User As IUserData, ByVal What As Download)
Source.AfterDownload(ConvertUser(User), What)
End Sub
Friend Sub DownloadDone(ByVal What As Download)
_ActiveTaskCount -= 1
If _ActiveTaskCount = 0 Then _AvailableAsked = False
Source.DownloadDone(What)
End Sub
Private Function ConvertUser(ByVal User As IUserData) As Object
If IsMyClass Then Return User Else Return DirectCast(User, UserDataBase).ExternalPlugin
End Function
#End Region
End Class
End Namespace

86
SCrawler/PluginsEnvironment/Hosts/UserDataHost.vb Normal file
View File

@@ -0,0 +1,86 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports System.Threading
Imports System.Reflection
Namespace Plugin.Hosts
Friend Class UserDataHost : Inherits UserDataBase
Private ReadOnly UseInternalDownloader As Boolean
Friend Overrides Function ExchangeOptionsGet() As Object
Return ExternalPlugin.ExchangeOptionsGet
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
ExternalPlugin.ExchangeOptionsSet(Obj)
End Sub
Friend Sub New(ByVal SourceClass As IPluginContentProvider)
ExternalPlugin = SourceClass
UseInternalDownloader = Not ExternalPlugin.GetType.GetCustomAttribute(Of Attributes.UseInternalDownloader)() Is Nothing
AddHandler ExternalPlugin.ProgressChanged, AddressOf ExternalPlugin_ProgressChanged
AddHandler ExternalPlugin.TotalCountChanged, AddressOf ExternalPlugin_TotalCountChanged
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
ExternalPlugin.XmlFieldsSet(Container.ToKeyValuePair)
Else
Dim fl As List(Of KeyValuePair(Of String, String)) = ExternalPlugin.XmlFieldsGet
If fl.ListExists Then
For Each fle As KeyValuePair(Of String, String) In fl : Container.Add(fle.Key, fle.Value) : Next
fl.Clear()
End If
End If
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
With ExternalPlugin
.Settings = HOST.Source
.Thrower = Me
.LogProvider = LogConnector
.Name = Name
.ID = ID
.ParseUserMediaOnly = ParseUserMediaOnly
.UserDescription = UserDescription
.UserExists = .UserExists
.UserSuspended = UserSuspended
.IsSavedPosts = IsSavedPosts
.SeparateVideoFolder = SeparateVideoFolderF
.DataPath = MyFile.CutPath.PathNoSeparator
.PostsNumberLimit = DownloadTopCount
If _ContentList.Count > 0 Then ExternalPlugin.ExistingContentList = _ContentList.Select(Function(u) u.PluginUserMedia).ToList
ExternalPlugin.TempPostsList = ListAddList(Nothing, _TempPostsList)
.GetMedia()
If .TempMediaList.ListExists Then _TempMediaList.ListAddList(.TempMediaList.Select(Function(tm) New UserMedia(tm)), LNC)
If Not .Name = Name Then Name = .Name
ID = .ID
UserDescription = .UserDescription
UserExists = .UserExists
UserSuspended = .UserSuspended
End With
End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
If UseInternalDownloader Then DownloadContentDefault(Token) Else ExternalPlugin.Download()
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
LogError(ex, Message)
HasError = True
Return 0
End Function
Private Sub ExternalPlugin_ProgressChanged(ByVal Count As Integer)
Progress.Perform(Count)
End Sub
Private Sub ExternalPlugin_TotalCountChanged(ByVal Count As Integer)
Progress.TotalCount += Count
End Sub
End Class
End Namespace

76
SCrawler/SCrawler.vbproj
View File

@@ -134,22 +134,45 @@
</ItemGroup>
<ItemGroup>
<Compile Include="API\Base\Declarations.vb" />
<Compile Include="API\Base\SiteSettings.vb" />
<Compile Include="API\Base\DownDetector.vb" />
<Compile Include="API\Base\ProfileSaved.vb" />
<Compile Include="API\Base\SiteSettingsBase.vb" />
<Compile Include="API\Base\Structures.vb" />
<Compile Include="API\Instagram\AuthNullException.vb" />
<Compile Include="API\Instagram\EditorExchangeOptions.vb" />
<Compile Include="API\Instagram\ExitException.vb" />
<Compile Include="API\Instagram\OptionsForm.Designer.vb">
<DependentUpon>OptionsForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Instagram\OptionsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Download\ActiveDownloadingProgress.Designer.vb">
<DependentUpon>ActiveDownloadingProgress.vb</DependentUpon>
</Compile>
<Compile Include="Download\ActiveDownloadingProgress.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Download\DownloadProgress.vb" />
<Compile Include="MainFrameObjects.vb" />
<Compile Include="PluginsEnvironment\Hosts\UserDataHost.vb" />
<Compile Include="API\Base\UserDataBase.vb" />
<Compile Include="API\Gfycat\Envir.vb" />
<Compile Include="API\Imgur\Envir.vb" />
<Compile Include="API\Instagram\Declarations.vb" />
<Compile Include="API\Instagram\ProfileSaved.vb" />
<Compile Include="API\Instagram\SiteSettings.vb" />
<Compile Include="API\Instagram\UserData.vb" />
<Compile Include="API\Reddit\Channel.vb" />
<Compile Include="API\Reddit\ChannelsCollection.vb" />
<Compile Include="API\Reddit\Declarations.vb" />
<Compile Include="API\Reddit\M3U8.vb" />
<Compile Include="API\Reddit\ProfileSaved.vb" />
<Compile Include="API\Reddit\SiteSettings.vb" />
<Compile Include="API\Reddit\UserData.vb" />
<Compile Include="API\Redgifs\Declarations.vb" />
<Compile Include="API\Redgifs\SiteSettings.vb" />
<Compile Include="API\Redgifs\UserData.vb" />
<Compile Include="API\Twitter\Declarations.vb" />
<Compile Include="API\Twitter\SiteSettings.vb" />
<Compile Include="API\Twitter\UserData.vb" />
<Compile Include="API\UserDataBind.vb" />
<Compile Include="Channels\ChannelsStatsForm.Designer.vb">
@@ -164,16 +187,16 @@
<Compile Include="Channels\ChannelViewForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="DownloadedInfoForm.Designer.vb">
<Compile Include="Download\DownloadedInfoForm.Designer.vb">
<DependentUpon>DownloadedInfoForm.vb</DependentUpon>
</Compile>
<Compile Include="DownloadedInfoForm.vb">
<Compile Include="Download\DownloadedInfoForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="DownloadSavedPostsForm.Designer.vb">
<Compile Include="Download\DownloadSavedPostsForm.Designer.vb">
<DependentUpon>DownloadSavedPostsForm.vb</DependentUpon>
</Compile>
<Compile Include="DownloadSavedPostsForm.vb">
<Compile Include="Download\DownloadSavedPostsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Editors\CollectionEditorForm.Designer.vb">
@@ -215,7 +238,14 @@
<Compile Include="Editors\UserCreatorForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="FDatePickerForm.Designer.vb">
<DependentUpon>FDatePickerForm.vb</DependentUpon>
</Compile>
<Compile Include="FDatePickerForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="LabelsKeeper.vb" />
<Compile Include="ListImagesLoader.vb" />
<Compile Include="MainFrame.vb">
<SubType>Form</SubType>
</Compile>
@@ -240,27 +270,39 @@
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="PluginsEnvironment\Attributes\AttributesInternal.vb" />
<Compile Include="PluginsEnvironment\Hosts\IResponserContainer.vb" />
<Compile Include="PluginsEnvironment\Hosts\LogHost.vb" />
<Compile Include="PluginsEnvironment\Hosts\PropertyValueHost.vb" />
<Compile Include="PluginsEnvironment\Hosts\PluginHost.vb" />
<Compile Include="PluginsEnvironment\Hosts\SettingsHost.vb" />
<Compile Include="SettingsCLS.vb" />
<Compile Include="TDownloader.vb" />
<Compile Include="Download\TDownloader.vb" />
<Compile Include="UserImage.vb" />
<Compile Include="VideosDownloaderForm.Designer.vb">
<Compile Include="Download\VideosDownloaderForm.Designer.vb">
<DependentUpon>VideosDownloaderForm.vb</DependentUpon>
</Compile>
<Compile Include="VideosDownloaderForm.vb">
<Compile Include="Download\VideosDownloaderForm.vb">
<SubType>Form</SubType>
</Compile>
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="API\Instagram\OptionsForm.resx">
<DependentUpon>OptionsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Channels\ChannelsStatsForm.resx">
<DependentUpon>ChannelsStatsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Channels\ChannelViewForm.resx">
<DependentUpon>ChannelViewForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="DownloadedInfoForm.resx">
<EmbeddedResource Include="Download\DownloadedInfoForm.resx">
<DependentUpon>DownloadedInfoForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="DownloadSavedPostsForm.resx">
<EmbeddedResource Include="Download\ActiveDownloadingProgress.resx">
<DependentUpon>ActiveDownloadingProgress.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Download\DownloadSavedPostsForm.resx">
<DependentUpon>DownloadSavedPostsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Editors\CollectionEditorForm.resx">
@@ -281,6 +323,9 @@
<EmbeddedResource Include="Editors\UserCreatorForm.resx">
<DependentUpon>UserCreatorForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="FDatePickerForm.resx">
<DependentUpon>FDatePickerForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="MainFrame.resx">
<DependentUpon>MainFrame.vb</DependentUpon>
</EmbeddedResource>
@@ -290,7 +335,7 @@
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="VideosDownloaderForm.resx">
<EmbeddedResource Include="Download\VideosDownloaderForm.resx">
<DependentUpon>VideosDownloaderForm.vb</DependentUpon>
</EmbeddedResource>
</ItemGroup>
@@ -313,6 +358,10 @@
<Project>{8405896b-2685-4916-bc93-1fb514c323a9}</Project>
<Name>PersonalUtilities</Name>
</ProjectReference>
<ProjectReference Include="..\SCrawler.PluginProvider\SCrawler.PluginProvider.vbproj">
<Project>{d4650f6b-5a54-44b6-999b-6c675b7116b1}</Project>
<Name>SCrawler.PluginProvider</Name>
</ProjectReference>
</ItemGroup>
<ItemGroup>
<None Include="Content\Icons\InstagramIcon.ico" />
@@ -338,5 +387,6 @@
<Install>false</Install>
</BootstrapperPackage>
</ItemGroup>
<ItemGroup />
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

197
SCrawler/SettingsCLS.vb
View File

@@ -10,21 +10,23 @@ Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports SCrawler.API
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Hosts
Imports SCrawler.DownloadObjects
Friend Class SettingsCLS : Implements IDisposable
Friend Const DefaultMaxDownloadingTasks As Integer = 5
Friend Const Name_Node_Sites As String = "Sites"
Private Const SitesValuesSeparator As String = ","
Friend ReadOnly Design As XmlFile
Private ReadOnly MyXML As XmlFile
Friend ReadOnly OS64 As Boolean
Friend ReadOnly FfmpegExists As Boolean
Private ReadOnly OS64 As Boolean
Private ReadOnly FfmpegExists As Boolean
Friend ReadOnly FfmpegFile As SFile
Friend ReadOnly Property UseM3U8 As Boolean
Get
Return OS64 And FfmpegExists
End Get
End Property
Private ReadOnly MySites As Dictionary(Of Sites, SiteSettings)
Friend ReadOnly Plugins As List(Of PluginHost)
Friend ReadOnly Property Users As List(Of IUserData)
Friend ReadOnly Property UsersList As List(Of UserInfo)
Friend Property Channels As Reddit.ChannelsCollection
@@ -39,12 +41,14 @@ Friend Class SettingsCLS : Implements IDisposable
If OS64 And Not FfmpegExists Then MsgBoxE("[ffmpeg.exe] is missing", vbExclamation)
Design = New XmlFile("Settings\Design.xml", Protector.Modes.All)
MyXML = New XmlFile(Nothing) With {.AutoUpdateFile = True}
MyXML.BeginUpdate()
Users = New List(Of IUserData)
UsersList = New List(Of UserInfo)
BlackList = New List(Of UserBan)
Plugins = New List(Of PluginHost)
GlobalPath = New XMLValue(Of SFile)("GlobalPath", New SFile($"{SFile.GetPath(Application.StartupPath).PathWithSeparator}Data\"), MyXML,,
XMLValue(Of SFile).ToFilePath)
New XMLValueBase.ToFilePath)
SeparateVideoFolder = New XMLValue(Of Boolean)("SeparateVideoFolder", True, MyXML)
CollectionsPath = New XMLValue(Of String)("CollectionsPath", "Collections", MyXML)
@@ -55,29 +59,25 @@ Friend Class SettingsCLS : Implements IDisposable
DefaultDownloadVideos = New XMLValue(Of Boolean)("DownloadVideos", True, MyXML, n)
ChangeReadyForDownOnTempChange = New XMLValue(Of Boolean)("ChangeReadyForDownOnTempChange", True, MyXML, n)
MySites = New Dictionary(Of Sites, SiteSettings) From {
{Sites.Reddit, New SiteSettings(Sites.Reddit, MyXML, GlobalPath.Value, DefaultTemporary, DefaultDownloadImages, DefaultDownloadVideos)},
{Sites.Twitter, New SiteSettings(Sites.Twitter, MyXML, GlobalPath.Value, DefaultTemporary, DefaultDownloadImages, DefaultDownloadVideos)},
{Sites.Instagram, New SiteSettings(Sites.Instagram, MyXML, GlobalPath.Value, DefaultTemporary, DefaultDownloadImages, DefaultDownloadVideos)},
{Sites.RedGifs, New SiteSettings(Sites.RedGifs, MyXML, GlobalPath.Value, DefaultTemporary, DefaultDownloadImages, DefaultDownloadVideos)}
}
MySites(Sites.Reddit).Responser.Decoders.Add(SymbolsConverter.Converters.Unicode)
Plugins.AddRange(PluginHost.GetMyHosts(MyXML, GlobalPath.Value, DefaultTemporary, DefaultDownloadImages, DefaultDownloadVideos))
Dim tmpPluginList As IEnumerable(Of PluginHost) = PluginHost.GetPluginsHosts(MyXML, GlobalPath.Value, DefaultTemporary,
DefaultDownloadImages, DefaultDownloadVideos)
If tmpPluginList.ListExists Then Plugins.AddRange(tmpPluginList)
FastProfilesLoading = New XMLValue(Of Boolean)("FastProfilesLoading", False, MyXML)
MaxLargeImageHeigh = New XMLValue(Of Integer)("MaxLargeImageHeigh", 150, MyXML)
MaxSmallImageHeigh = New XMLValue(Of Integer)("MaxSmallImageHeigh", 15, MyXML)
InfoViewMode = New XMLValue(Of Integer)("InfoViewMode", DownloadedInfoForm.ViewModes.Session, MyXML)
ViewMode = New XMLValue(Of Integer)("ViewMode", ViewModes.IconLarge, MyXML)
ShowingMode = New XMLValue(Of Integer)("ShowingMode", ShowingModes.All, MyXML)
LatestSavingPath = New XMLValue(Of SFile)("LatestSavingPath", Nothing, MyXML,, XMLValue(Of SFile).ToFilePath)
LatestSavingPath = New XMLValue(Of SFile)("LatestSavingPath", Nothing, MyXML,, New XMLValueBase.ToFilePath)
LatestSelectedLabels = New XMLValue(Of String)("LatestSelectedLabels",, MyXML)
LatestSelectedChannel = New XMLValue(Of String)("LatestSelectedChannel",, MyXML)
LastUpdatedLimit = New XMLValue(Of Date)
LastUpdatedLimit.SetExtended("LastUpdatedLimit",, MyXML)
XMLSelectedSites = New XMLValue(Of String)("SelectedSites", String.Empty, MyXML, {Name_Node_Sites})
If Not XMLSelectedSites.IsEmptyString Then
_SelectedSites = XMLSelectedSites.Value.StringToList(Of Sites)(SitesValuesSeparator)
End If
If _SelectedSites Is Nothing Then _SelectedSites = New List(Of Sites)
SelectedSites = New XMLValuesCollection(Of String)(XMLValueBase.ListModes.String, "SelectedSites", MyXML, {Name_Node_Sites})
ImgurClientID = New XMLValue(Of String)("ImgurClientID", String.Empty, MyXML, {Name_Node_Sites})
@@ -89,17 +89,22 @@ Friend Class SettingsCLS : Implements IDisposable
ChannelsImagesColumns = New XMLValue(Of Integer)("ImagesColumns", 5, MyXML, n)
ChannelsHideExistsUser = New XMLValue(Of Boolean)("HideExistsUser", True, MyXML, n)
ChannelsMaxJobsCount = New XMLValue(Of Integer)("MaxJobsCount", DefaultMaxDownloadingTasks, MyXML, n)
ChannelsAddUserImagesFromAllChannels = New XMLValue(Of Boolean)("AddUserImagesFromAllChannels", True, MyXML, n)
n = {"Users"}
FromChannelDownloadTop = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML, n)
FromChannelDownloadTopUse = New XMLValue(Of Boolean)("FromChannelDownloadTopUse", False, MyXML, n)
FromChannelCopyImageToUser = New XMLValue(Of Boolean)("FromChannelCopyImageToUser", True, MyXML, n)
UpdateUserDescriptionEveryTime = New XMLValue(Of Boolean)("UpdateUserDescriptionEveryTime", True, MyXML, n)
n = {"Users", "FileName"}
MaxUsersJobsCount = New XMLValue(Of Integer)("MaxJobsCount", DefaultMaxDownloadingTasks, MyXML, n)
FileAddDateToFileName = New XMLValue(Of Boolean)("FileAddDateToFileName", False, MyXML, n) With {.OnChangeFunction = AddressOf ChangeDateProvider}
FileAddTimeToFileName = New XMLValue(Of Boolean)("FileAddTimeToFileName", False, MyXML, n) With {.OnChangeFunction = AddressOf ChangeDateProvider}
FileDateTimePositionEnd = New XMLValue(Of Boolean)("FileDateTimePositionEnd", True, MyXML, n) With {.OnChangeFunction = AddressOf ChangeDateProvider}
FileAddDateToFileName = New XMLValue(Of Boolean)("FileAddDateToFileName", False, MyXML, n)
AddHandler FileAddDateToFileName.OnValueChanged, AddressOf ChangeDateProvider
FileAddTimeToFileName = New XMLValue(Of Boolean)("FileAddTimeToFileName", False, MyXML, n)
AddHandler FileAddTimeToFileName.OnValueChanged, AddressOf ChangeDateProvider
FileDateTimePositionEnd = New XMLValue(Of Boolean)("FileDateTimePositionEnd", True, MyXML, n)
AddHandler FileDateTimePositionEnd.OnValueChanged, AddressOf ChangeDateProvider
FileReplaceNameByDate = New XMLValue(Of Boolean)("FileReplaceNameByDate", False, MyXML, n)
CheckUpdatesAtStart = New XMLValue(Of Boolean)("CheckUpdatesAtStart", True, MyXML)
@@ -109,7 +114,10 @@ Friend Class SettingsCLS : Implements IDisposable
ExitConfirm = New XMLValue(Of Boolean)("ExitConfirm", True, MyXML)
CloseToTray = New XMLValue(Of Boolean)("CloseToTray", True, MyXML)
ShowNotifications = New XMLValue(Of Boolean)("ShowNotifications", True, MyXML)
OpenFolderInOtherProgram = New XMLValueAttribute(Of String, Boolean)("OpenFolderInOtherProgram", "Use",,, MyXML)
DeleteToRecycleBin = New XMLValue(Of Boolean)("DeleteToRecycleBin", True, MyXML)
MyXML.EndUpdate()
If MyXML.ChangesDetected Then MyXML.Sort() : MyXML.UpdateData()
Labels = New LabelsKeeper
@@ -130,6 +138,7 @@ Friend Class SettingsCLS : Implements IDisposable
If FileDateTimePositionEnd Then FileDateAppenderPattern = "{0}_{1}" Else FileDateAppenderPattern = "{1}_{0}"
End If
End Sub
#Region "USERS"
Friend Sub LoadUsers()
Try
Users.Clear()
@@ -138,15 +147,16 @@ Friend Class SettingsCLS : Implements IDisposable
x.LoadData()
If x.Count > 0 Then x.ForEach(Sub(xx) UsersList.Add(xx))
End Using
Dim PNC As Func(Of UserInfo, Boolean) = Function(u) Not u.IncludedInCollection
UsersCompatibilityCheck()
Dim PNC As Func(Of UserInfo, Boolean) = Function(u) Not u.IncludedInCollection And Not u.Protected
Dim NeedUpdate As Boolean = False
If UsersList.Count > 0 Then
Dim cUsers As List(Of UserInfo) = UsersList.Where(Function(u) u.IncludedInCollection).ToList
Dim cUsers As List(Of UserInfo) = UsersList.Where(Function(u) u.IncludedInCollection And Not u.Protected).ToList
If cUsers.ListExists Then
Dim d As New Dictionary(Of SFile, List(Of UserInfo))
cUsers = cUsers.ListForEachCopy(Of List(Of UserInfo))(Function(ByVal f As UserInfo, ByVal f_indx As Integer) As UserInfo
Dim m% = IIf(f.Merged, 1, 2)
If SFile.GetPath(f.File.CutPath(m - 1).Path).Exists(SFO.Path, False) Then
If Not f.Protected AndAlso SFile.GetPath(f.File.CutPath(m - 1).Path).Exists(SFO.Path, False) Then
Dim fp As SFile = SFile.GetPath(f.File.CutPath(m).Path)
If Not d.ContainsKey(fp) Then
d.Add(fp, New List(Of UserInfo) From {f})
@@ -155,8 +165,7 @@ Friend Class SettingsCLS : Implements IDisposable
End If
Return f
Else
NeedUpdate = True
UsersList.Remove(f)
If Not f.Protected Then NeedUpdate = True : UsersList.Remove(f)
Return Nothing
End If
End Function, True)
@@ -179,36 +188,89 @@ Friend Class SettingsCLS : Implements IDisposable
Task.WaitAll(t.ToArray)
t.Clear()
Dim du As List(Of UserInfo) = (From u As IUserData In Users
Where Not u.IsCollection AndAlso Not u.FileExists
Select DirectCast(u.Self, UserDataBase).User).ToList
Where Not u.IsCollection AndAlso Not u.FileExists AndAlso Not DirectCast(u, UserDataBase).User.Protected
Select DirectCast(u, UserDataBase).User).ToList
If du.ListExists Then du.ForEach(Sub(u) UsersList.Remove(u)) : du.Clear()
Users.ListDisposeRemoveAll(Function(ByVal u As IUserData) As Boolean
If u.IsCollection Then
With DirectCast(u, UserDataBind)
If .Count > 0 Then
For i% = .Count - 1 To 0 Step -1
If Not .Item(i).FileExists Then
.Item(i).Delete()
.Collections.RemoveAt(i)
End If
Next
End If
Return Not .FileExists
End With
If Not DirectCast(u, UserDataBase).User.Protected Then
If u.IsCollection Then
With DirectCast(u, UserDataBind)
If .Count > 0 Then
For i% = .Count - 1 To 0 Step -1
If Not .Item(i).FileExists Then
.Item(i).Delete()
.Collections.RemoveAt(i)
End If
Next
End If
Return Not .FileExists
End With
Else
Return Not u.FileExists
End If
Else
Return Not u.FileExists
Return False
End If
End Function)
End If
If NeedUpdate Then UpdateUsersList()
End If
If Users.Count > 0 Then
Labels.ToList.ListAddList(Users.SelectMany(Function(u) u.Labels), LAP.NotContainsOnly)
Labels.AddRange(Users.SelectMany(Function(u) u.Labels), False)
If Labels.NewLabelsExists Then Labels.Update() : Labels.NewLabels.Clear()
End If
Catch ex As Exception
End Try
End Sub
Private Sub UsersCompatibilityCheck()
With UsersList
Dim user As UserInfo
Dim uKeysList As List(Of String) = Nothing
If Plugins.Count > 0 Then uKeysList = Plugins.Select(Function(p) p.Key).ListIfNothing
If uKeysList Is Nothing Then uKeysList = New List(Of String)
Dim i%
If .Count > 0 AndAlso (uKeysList.Count = 0 OrElse
.Exists(Function(u) u.Site.Length = 1 Or u.Plugin.IsEmptyString Or Not uKeysList.Contains(u.Plugin))) Then
Dim indx%
Dim c As Boolean = False
For i = 0 To .Count - 1
user = .Item(i)
With user
If .Site.Length = 1 Then
Select Case .Site
Case "1" : .Site = Reddit.RedditSite : c = True
Case "2" : .Site = Twitter.TwitterSite : c = True
Case "3" : .Site = Instagram.InstagramSite : c = True
Case "4" : .Site = RedGifs.RedGifsSite : c = True
End Select
End If
If Not .Site.IsEmptyString Then
If .Plugin.IsEmptyString Then
indx = Plugins.FindIndex(Function(p) p.Settings.Name.ToLower = .Site.ToLower)
If indx >= 0 Then .Plugin = Plugins(indx).Settings.Key : c = True Else .Protected = True
Else
indx = Plugins.FindIndex(Function(p) p.Key = .Plugin)
If indx < 0 Then .Protected = True
End If
End If
End With
.Item(i) = user
Next
If c Then UpdateUsersList()
End If
.Clear()
Using x As New XmlFile(UsersSettingsFile, Protector.Modes.All, False) With {.AllowSameNames = True}
x.LoadData()
If x.Count > 0 Then
For i = 0 To x.Count - 1
user = x(i)
user.UpdateUserFile()
.Add(user)
Next
End If
End Using
End With
End Sub
Private _UserListUpdateRequired As Boolean = False
Friend ReadOnly Property UserListUpdateRequired As Boolean
Get
@@ -228,7 +290,7 @@ Friend Class SettingsCLS : Implements IDisposable
Try
If UsersList.Count > 0 Then
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Users"}
UsersList.ForEach(Sub(u) x.Add(u.GetContainer()))
x.AddRange(UsersList)
x.Save(UsersSettingsFile)
End Using
End If
@@ -237,18 +299,18 @@ Friend Class SettingsCLS : Implements IDisposable
_UserListUpdateRequired = True
End Try
End Sub
#End Region
Friend Sub UpdateBlackList()
If BlackList.Count > 0 Then
TextSaver.SaveTextToFile(BlackList.ListToString(, vbNewLine), BlackListFile, True, False, EDP.None)
Else
If BlackListFile.Exists Then BlackListFile.Delete()
BlackListFile.Delete(, Settings.DeleteMode)
End If
End Sub
Friend Sub DeleteCachPath()
If Reddit.ChannelsCollection.ChannelsPathCache.Exists(SFO.Path, False) Then _
Reddit.ChannelsCollection.ChannelsPathCache.Delete(SFO.Path, False, False, EDP.None)
Friend Sub DeleteCachePath()
Reddit.ChannelsCollection.ChannelsPathCache.Delete(SFO.Path, SFODelete.None, EDP.None)
End Sub
Friend Overloads Function UserExists(ByVal s As Sites, ByVal UserID As String) As Boolean
Friend Overloads Function UserExists(ByVal s As String, ByVal UserID As String) As Boolean
Dim UserFinderBase As Predicate(Of IUserData) = Function(user) user.Site = s And user.Name = UserID
Dim UserFinder As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
If user.IsCollection Then
@@ -271,16 +333,19 @@ Friend Class SettingsCLS : Implements IDisposable
Friend Sub BeginUpdate()
MyXML.BeginUpdate()
_UpdatesSuspended = True
If Plugins.Count > 0 Then Plugins.ForEach(Sub(p) p.Settings.Source.BeginUpdate())
End Sub
Friend Sub EndUpdate()
If Plugins.Count > 0 Then Plugins.ForEach(Sub(p) p.Settings.Source.EndUpdate())
MyXML.EndUpdate()
If MyXML.ChangesDetected Then MyXML.UpdateData()
_UpdatesSuspended = False
ChangeDateProvider(Nothing, Nothing, Nothing)
End Sub
Default Friend ReadOnly Property Site(ByVal s As Sites) As SiteSettings
Default Friend ReadOnly Property Site(ByVal PluginKey As String) As SettingsHost
Get
Return MySites(s)
Dim i% = Plugins.FindIndex(Function(p) p.Key = PluginKey)
If i >= 0 Then Return Plugins(i).Settings Else Return Nothing
End Get
End Property
Friend ReadOnly Property GlobalPath As XMLValue(Of SFile)
@@ -307,6 +372,7 @@ Friend Class SettingsCLS : Implements IDisposable
Friend ReadOnly Property FromChannelDownloadTop As XMLValue(Of Integer)
Friend ReadOnly Property FromChannelDownloadTopUse As XMLValue(Of Boolean)
Friend ReadOnly Property FromChannelCopyImageToUser As XMLValue(Of Boolean)
Friend ReadOnly Property UpdateUserDescriptionEveryTime As XMLValue(Of Boolean)
#Region "File naming"
Friend ReadOnly Property FileAddDateToFileName As XMLValue(Of Boolean)
Friend ReadOnly Property FileAddTimeToFileName As XMLValue(Of Boolean)
@@ -315,6 +381,7 @@ Friend Class SettingsCLS : Implements IDisposable
#End Region
#End Region
#Region "View"
Friend ReadOnly Property FastProfilesLoading As XMLValue(Of Boolean)
Friend ReadOnly Property MaxLargeImageHeigh As XMLValue(Of Integer)
Friend ReadOnly Property MaxSmallImageHeigh As XMLValue(Of Integer)
Friend ReadOnly Property InfoViewMode As XMLValue(Of Integer)
@@ -328,20 +395,14 @@ Friend Class SettingsCLS : Implements IDisposable
End Get
End Property
Friend ReadOnly Property ShowingMode As XMLValue(Of Integer)
Private ReadOnly Property XMLSelectedSites As XMLValue(Of String)
Private ReadOnly _SelectedSites As List(Of Sites)
Friend Property SelectedSites As List(Of Sites)
Friend ReadOnly Property SelectedSites As XMLValuesCollection(Of String)
Private ReadOnly LastUpdatedLimit As XMLValue(Of Date)
Friend Property LastUpdatedDate As Date?
Get
Return _SelectedSites
If LastUpdatedLimit.ValueF.Exists Then Return LastUpdatedLimit.Value Else Return Nothing
End Get
Set(ByVal s As List(Of Sites))
_SelectedSites.Clear()
If s.ListExists Then
_SelectedSites.ListAddList(s)
XMLSelectedSites.Value = ListAddList(Of Integer, Sites)(Nothing, s).ListToString(, SitesValuesSeparator)
Else
XMLSelectedSites.Value = String.Empty
End If
Set(ByVal NewDate As Date?)
If Not NewDate.HasValue Then LastUpdatedLimit.ValueF = Nothing Else LastUpdatedLimit.Value = NewDate.Value
End Set
End Property
#End Region
@@ -358,6 +419,7 @@ Friend Class SettingsCLS : Implements IDisposable
Friend ReadOnly Property ChannelsImagesColumns As XMLValue(Of Integer)
Friend ReadOnly Property ChannelsHideExistsUser As XMLValue(Of Boolean)
Friend ReadOnly Property ChannelsMaxJobsCount As XMLValue(Of Integer)
Friend ReadOnly Property ChannelsAddUserImagesFromAllChannels As XMLValue(Of Boolean)
#End Region
#Region "New version properties"
Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean)
@@ -368,6 +430,13 @@ Friend Class SettingsCLS : Implements IDisposable
Friend ReadOnly Property ExitConfirm As XMLValue(Of Boolean)
Friend ReadOnly Property CloseToTray As XMLValue(Of Boolean)
Friend ReadOnly Property ShowNotifications As XMLValue(Of Boolean)
Friend ReadOnly Property OpenFolderInOtherProgram As XMLValueAttribute(Of String, Boolean)
Friend ReadOnly Property DeleteToRecycleBin As XMLValue(Of Boolean)
Friend ReadOnly Property DeleteMode As SFODelete
Get
Return If(DeleteToRecycleBin, SFODelete.DeleteToRecycleBin, SFODelete.None)
End Get
End Property
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
@@ -377,12 +446,12 @@ Friend Class SettingsCLS : Implements IDisposable
If UserListUpdateRequired Then UpdateUsersList()
If Not Channels Is Nothing Then
Channels.Dispose()
DeleteCachPath()
DeleteCachePath()
End If
For Each kv In MySites : kv.Value.Dispose() : Next
MySites.Clear()
Plugins.Clear()
Users.ListClearDispose
UsersList.Clear()
SelectedSites.Dispose()
Design.Dispose()
MyXML.Dispose()
End If

349
SCrawler/TDownloader.vb
View File

@@ -1,349 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Imports EOptions = PersonalUtilities.Forms.Toolbars.IMyProgress.EnableOptions
Imports SCrawler.API
Imports SCrawler.API.Base
Friend Class TDownloader : Implements IDisposable
Friend Event OnJobsChange(ByVal Site As Sites, ByVal JobsCount As Integer)
Friend Event OnDownloadCountChange()
Friend Event OnDownloading(ByVal Value As Boolean)
Friend Event SendNotification(ByVal Message As String)
Friend ReadOnly Property Downloaded As List(Of IUserData)
Private ReadOnly NProv As IFormatProvider
Friend ReadOnly Property Working(Optional ByVal Site As Sites = Sites.Undefined) As Boolean
Get
If Site = Sites.Instagram Then
Return JobInst.Working
Else
Return JobDefault.Working Or JobInst.Working
End If
End Get
End Property
Friend Property InstagramSavedPostsDownloading As Boolean = False
#Region "Jobs"
Friend Structure Job
Friend Site As Sites
Private TokenSource As CancellationTokenSource
Private Token As CancellationToken
Private [Thread] As Thread
Private _Working As Boolean
Friend ReadOnly Items As List(Of IUserData)
Friend ReadOnly Property Count As Integer
Get
Return Items.Count
End Get
End Property
Friend ReadOnly Property Working As Boolean
Get
Return _Working OrElse If(Thread?.IsAlive, False)
End Get
End Property
Friend ReadOnly Progress As MyProgress
Friend Sub New(ByRef _Progress As MyProgress)
Progress = _Progress
Items = New List(Of IUserData)
End Sub
Public Shared Widening Operator CType(ByVal j As Job) As CancellationToken
Return j.Token
End Operator
Public Shared Widening Operator CType(ByVal j As Job) As Boolean
Return j.Working
End Operator
Public Shared Operator And(ByVal x As Job, ByVal y As Job) As Boolean
Return x.Working And y.Working
End Operator
Public Shared Operator And(ByVal x As Job, ByVal y As Boolean) As Boolean
Return x.Working And y
End Operator
Public Shared Operator And(ByVal x As Boolean, ByVal y As Job) As Boolean
Return x And y.Working
End Operator
Public Shared Operator Or(ByVal x As Job, ByVal y As Job) As Boolean
Return x.Working Or y.Working
End Operator
Public Shared Operator Or(ByVal x As Job, ByVal y As Boolean) As Boolean
Return x.Working Or y
End Operator
Public Shared Operator Or(ByVal x As Boolean, ByVal y As Job) As Boolean
Return x Or y.Working
End Operator
Public Shared Operator Not(ByVal j As Job) As Boolean
Return Not j.Working
End Operator
Friend Sub ThrowIfCancellationRequested()
Token.ThrowIfCancellationRequested()
End Sub
Friend ReadOnly Property IsCancellationRequested As Boolean
Get
Return Token.IsCancellationRequested
End Get
End Property
Friend ReadOnly Property IsInstagram As Boolean
Get
Return Site = Sites.Instagram
End Get
End Property
Friend Sub [Start](ByVal [ThreadStart] As ThreadStart)
Thread = New Thread(ThreadStart) With {.IsBackground = True}
Thread.SetApartmentState(ApartmentState.MTA)
Thread.Start()
End Sub
Friend Sub [Start]()
TokenSource = New CancellationTokenSource
Token = TokenSource.Token
_Working = True
End Sub
Friend Sub [Stop]()
If Not TokenSource Is Nothing Then TokenSource.Cancel()
End Sub
Friend Sub Stopped()
_Working = False
TokenSource = Nothing
Try
If Not Thread Is Nothing Then
If Thread.IsAlive Then Thread.Abort()
Thread = Nothing
End If
Catch ex As Exception
End Try
End Sub
End Structure
Private JobDefault As Job
Private JobInst As Job
#End Region
Friend Sub New()
Downloaded = New List(Of IUserData)
NProv = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
JobDefault = New Job(MainProgress)
JobInst = New Job(MainProgressInst) With {.Site = Sites.Instagram}
End Sub
Friend Sub [Start]()
If Not JobDefault.Working And JobDefault.Count > 0 Then JobDefault.Start(New ThreadStart(Sub() StartDownloading(JobDefault)))
If Not JobInst.Working And JobInst.Count > 0 And Not InstagramSavedPostsDownloading Then _
JobInst.Start(New ThreadStart(Sub() StartDownloading(JobInst)))
End Sub
Private Sub StartDownloading(ByRef _Job As Job)
RaiseEvent OnDownloading(True)
Dim isInst As Boolean = _Job.IsInstagram
Dim pt As Func(Of String, String) = Function(ByVal t As String) As String
Dim _t$ = If(isInst, $"Instagram {Left(t, 1).ToLower}{Right(t, t.Length - 1)}", t)
RaiseEvent SendNotification(_t)
Return _t
End Function
Try
_Job.Start()
_Job.Progress.TotalCount = 0
_Job.Progress.CurrentCounter = 0
_Job.Progress.Enabled = True
Do While _Job.Count > 0
_Job.ThrowIfCancellationRequested()
UpdateJobsLabel(_Job)
DownloadData(_Job, _Job)
_Job.ThrowIfCancellationRequested()
Thread.Sleep(500)
Loop
_Job.Progress.InformationTemporary = pt("All data downloaded")
Catch oex As OperationCanceledException When _Job.IsCancellationRequested
_Job.Progress.InformationTemporary = pt("Downloading canceled")
Catch ex As Exception
_Job.Progress.InformationTemporary = pt("Downloading error")
ErrorsDescriber.Execute(EDP.SendInLog, ex, "TDownloader.Start")
Finally
_Job.Stopped()
UpdateJobsLabel(_Job)
If _Job.Site = Sites.Instagram Then
Settings(Sites.Instagram).InstagramLastDownloadDate.Value = Now
If Settings(Sites.Instagram).InstaHashUpdateRequired Then MyMainLOG = "Check your Instagram credentials"
End If
_Job.Progress.Enabled(EOptions.ProgressBar) = False
RaiseEvent OnDownloading(False)
End Try
End Sub
Friend Sub [Stop]()
If JobDefault.Working Then JobDefault.Stop()
If JobInst.Working Then JobInst.Stop()
End Sub
Private Overloads Sub UpdateJobsLabel()
UpdateJobsLabel(JobDefault)
UpdateJobsLabel(JobInst)
End Sub
Private Overloads Sub UpdateJobsLabel(ByVal _Job As Job)
RaiseEvent OnJobsChange(_Job.Site, _Job.Count)
End Sub
Private _InstagramNextWNM As Instagram.UserData.WNM = Instagram.UserData.WNM.Notify
Private Sub DownloadData(ByRef _Job As Job, ByVal Token As CancellationToken)
Try
If _Job.Count > 0 Then
Const nf As ANumbers.Formats = ANumbers.Formats.Number
Dim t As New List(Of Task)
Dim i% = 0
Dim j% = Settings.MaxUsersJobsCount
Dim limit% = IIf(_Job.Site = Sites.Instagram, 1, j)
Dim Keys As New List(Of String)
Dim h As Boolean = False
Dim InstaReady As Boolean = Settings(Sites.Instagram).InstagramReadyForDownload
For Each _Item As IUserData In _Job.Items
If Not _Item.Disposed Then
Keys.Add(_Item.LVIKey)
If Not _Item.Site = Sites.Instagram Or InstaReady Then
If _Item.Site = Sites.Instagram Then
h = True
With DirectCast(_Item, Instagram.UserData)
.WaitNotificationMode = _InstagramNextWNM
If Settings(Sites.Instagram).InstagramLastDownloadDate.Value < Now.AddMinutes(60) Then
.RequestsCount = Settings(Sites.Instagram).InstagramLastRequestsCount
End If
End With
End If
_Job.ThrowIfCancellationRequested()
t.Add(Task.Run(Sub() _Item.DownloadData(Token)))
i += 1
If i >= limit Then Exit For
End If
End If
Next
If t.Count > 0 Or Keys.Count > 0 Then
If h Then
With Settings(Sites.Instagram)
If .InstaHash.IsEmptyString Or .InstaHashUpdateRequired Then .GatherInstaHash()
End With
End If
With _Job.Progress
.Enabled(EOptions.All) = True
.Information = IIf(_Job.IsInstagram, "Instagram d", "D")
.Information &= $"ownloading {t.Count.NumToString(nf, NProv)}/{_Job.Items.Count.NumToString(nf, NProv)} profiles' data"
.InformationTemporary = .Information
End With
If t.Count > 0 Then Task.WaitAll(t.ToArray)
Dim dcc As Boolean = False
If Keys.Count > 0 Then
For Each k$ In Keys
i = _Job.Items.FindIndex(Function(ii) ii.LVIKey = k)
If i >= 0 Then
With _Job.Items(i)
If _Job.Site = Sites.Instagram Then
With DirectCast(.Self, Instagram.UserData)
_InstagramNextWNM = .WaitNotificationMode
If _InstagramNextWNM = Instagram.UserData.WNM.SkipTemp Or _InstagramNextWNM = Instagram.UserData.WNM.SkipCurrent Then _
_InstagramNextWNM = Instagram.UserData.WNM.Notify
Settings(Sites.Instagram).InstagramLastRequestsCount.Value = .RequestsCount
End With
End If
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
If Not Downloaded.Contains(.Self) Then Downloaded.Add(GetUserFromMainCollection(.Self))
dcc = True
End If
End With
_Job.Items.RemoveAt(i)
End If
Next
End If
Keys.Clear()
_Job.Items.RemoveAll(Function(ii) ii.Disposed)
If dcc Then Downloaded.RemoveAll(Function(u) u Is Nothing)
If dcc And Downloaded.Count > 0 Then RaiseEvent OnDownloadCountChange()
t.Clear()
End If
End If
Catch aoex As ArgumentOutOfRangeException
ErrorsDescriber.Execute(EDP.SendInLog, aoex, $"TDownloader.DownloadData: index out of range ({_Job.Count})")
Catch oex As OperationCanceledException When _Job.IsCancellationRequested
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "TDownloader.DownloadData")
Finally
If Settings.UserListUpdateRequired Then _
Task.WaitAll(Task.Run(Sub()
While Settings.UserListUpdateRequired : Settings.UpdateUsersList() : End While
End Sub))
If _Job.Site = Sites.Instagram Then Settings(Sites.Instagram).InstagramLastDownloadDate.Value = Now
End Try
End Sub
Private Function GetUserFromMainCollection(ByVal User As IUserData) As IUserData
Dim uSimple As Predicate(Of IUserData) = Function(u) u.Equals(DirectCast(User.Self, UserDataBase))
Dim uCol As Predicate(Of IUserData) = Function(ByVal u As IUserData) As Boolean
If u.IsCollection Then
Return DirectCast(u, UserDataBind).Collections.Exists(uSimple)
Else
Return False
End If
End Function
Dim uu As Predicate(Of IUserData)
If User.IncludedInCollection Then uu = uCol Else uu = uSimple
Dim i% = Settings.Users.FindIndex(uu)
If i >= 0 Then
If Settings.Users(i).IsCollection Then
With DirectCast(Settings.Users(i), UserDataBind)
i = .Collections.FindIndex(uSimple)
If i >= 0 Then Return .Collections(i)
End With
Else
Return Settings.Users(i)
End If
End If
Return Nothing
End Function
Private Sub AddItem(ByVal Item As IUserData, ByVal _UpdateJobsLabel As Boolean)
If Not Contains(Item) Then
If Item.IsCollection Then
Item.DownloadData(Nothing)
ElseIf Item.Site = Sites.Instagram Then
JobInst.Items.Add(Item)
If _UpdateJobsLabel Then UpdateJobsLabel(JobInst)
Else
JobDefault.Items.Add(Item)
If _UpdateJobsLabel Then UpdateJobsLabel(JobDefault)
End If
End If
End Sub
Friend Sub Add(ByVal Item As IUserData)
AddItem(Item, True)
If JobDefault.Count > 0 Or JobInst.Count > 0 Then Start()
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If _Items.ListExists Then
For i% = 0 To _Items.Count - 1 : AddItem(_Items(i), False) : Next
UpdateJobsLabel()
End If
If JobDefault.Count > 0 Or JobInst.Count > 0 Then Start()
End Sub
Private Function Contains(ByVal _Item As IUserData)
If _Item.Site = Sites.Instagram Then
Return JobInst.Items.Contains(_Item)
Else
Return JobDefault.Items.Contains(_Item)
End If
End Function
Friend Sub UserRemove(ByVal _Item As IUserData)
If Downloaded.Count > 0 AndAlso Downloaded.Contains(_Item) Then Downloaded.Remove(_Item) : RaiseEvent OnDownloadCountChange()
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
[Stop]()
JobDefault.Items.Clear()
JobInst.Items.Clear()
Downloaded.Clear()
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class

158
SCrawler/VideosDownloaderForm.Designer.vb generated
View File

@@ -1,158 +0,0 @@
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class VideosDownloaderForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.BTT_ADD = New System.Windows.Forms.ToolStripButton()
Me.BTT_ADD_LIST = New System.Windows.Forms.ToolStripButton()
Me.BTT_DELETE = New System.Windows.Forms.ToolStripButton()
Me.BTT_DOWN = New System.Windows.Forms.ToolStripButton()
Me.BTT_OPEN_PATH = New System.Windows.Forms.ToolStripButton()
Me.ToolbarBOTTOM = New System.Windows.Forms.StatusStrip()
Me.PR_V = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_STATUS = New System.Windows.Forms.ToolStripStatusLabel()
Me.LIST_VIDEOS = New System.Windows.Forms.ListBox()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.ToolbarBOTTOM.SuspendLayout()
Me.SuspendLayout()
'
'SEP_1
'
SEP_1.Name = "SEP_1"
SEP_1.Size = New System.Drawing.Size(6, 25)
'
'SEP_2
'
SEP_2.Name = "SEP_2"
SEP_2.Size = New System.Drawing.Size(6, 25)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_ADD, Me.BTT_ADD_LIST, Me.BTT_DELETE, SEP_1, Me.BTT_DOWN, SEP_2, Me.BTT_OPEN_PATH})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(524, 25)
Me.ToolbarTOP.TabIndex = 0
'
'BTT_ADD
'
Me.BTT_ADD.AutoToolTip = False
Me.BTT_ADD.Image = Global.SCrawler.My.Resources.Resources.PlusPIC
Me.BTT_ADD.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD.Name = "BTT_ADD"
Me.BTT_ADD.Size = New System.Drawing.Size(75, 22)
Me.BTT_ADD.Text = "Add (Ins)"
'
'BTT_ADD_LIST
'
Me.BTT_ADD_LIST.AutoToolTip = False
Me.BTT_ADD_LIST.Image = Global.SCrawler.My.Resources.Resources.PlusPIC
Me.BTT_ADD_LIST.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD_LIST.Name = "BTT_ADD_LIST"
Me.BTT_ADD_LIST.Size = New System.Drawing.Size(67, 22)
Me.BTT_ADD_LIST.Text = "Add list"
'
'BTT_DELETE
'
Me.BTT_DELETE.AutoToolTip = False
Me.BTT_DELETE.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_DELETE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DELETE.Name = "BTT_DELETE"
Me.BTT_DELETE.Size = New System.Drawing.Size(83, 22)
Me.BTT_DELETE.Text = "Delete (F8)"
'
'BTT_DOWN
'
Me.BTT_DOWN.AutoToolTip = False
Me.BTT_DOWN.Image = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_DOWN.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DOWN.Name = "BTT_DOWN"
Me.BTT_DOWN.Size = New System.Drawing.Size(104, 22)
Me.BTT_DOWN.Text = "Download (F5)"
'
'BTT_OPEN_PATH
'
Me.BTT_OPEN_PATH.AutoToolTip = False
Me.BTT_OPEN_PATH.Image = Global.SCrawler.My.Resources.Resources.Folder_32
Me.BTT_OPEN_PATH.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_OPEN_PATH.Name = "BTT_OPEN_PATH"
Me.BTT_OPEN_PATH.Size = New System.Drawing.Size(120, 22)
Me.BTT_OPEN_PATH.Text = "Open saving path"
'
'ToolbarBOTTOM
'
Me.ToolbarBOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.PR_V, Me.LBL_STATUS})
Me.ToolbarBOTTOM.Location = New System.Drawing.Point(0, 339)
Me.ToolbarBOTTOM.Name = "ToolbarBOTTOM"
Me.ToolbarBOTTOM.Size = New System.Drawing.Size(524, 22)
Me.ToolbarBOTTOM.TabIndex = 1
'
'PR_V
'
Me.PR_V.Name = "PR_V"
Me.PR_V.Size = New System.Drawing.Size(200, 16)
Me.PR_V.Visible = False
'
'LBL_STATUS
'
Me.LBL_STATUS.Name = "LBL_STATUS"
Me.LBL_STATUS.Size = New System.Drawing.Size(0, 17)
'
'LIST_VIDEOS
'
Me.LIST_VIDEOS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_VIDEOS.FormattingEnabled = True
Me.LIST_VIDEOS.Location = New System.Drawing.Point(0, 25)
Me.LIST_VIDEOS.Name = "LIST_VIDEOS"
Me.LIST_VIDEOS.Size = New System.Drawing.Size(524, 314)
Me.LIST_VIDEOS.TabIndex = 2
'
'VideosDownloaderForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(524, 361)
Me.Controls.Add(Me.LIST_VIDEOS)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(540, 400)
Me.Name = "VideosDownloaderForm"
Me.ShowIcon = False
Me.Text = "Download Videos"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()
Me.ToolbarBOTTOM.ResumeLayout(False)
Me.ToolbarBOTTOM.PerformLayout()
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private WithEvents ToolbarTOP As ToolStrip
Private WithEvents BTT_ADD As ToolStripButton
Private WithEvents BTT_ADD_LIST As ToolStripButton
Private WithEvents BTT_DELETE As ToolStripButton
Private WithEvents ToolbarBOTTOM As StatusStrip
Private WithEvents PR_V As ToolStripProgressBar
Private WithEvents LBL_STATUS As ToolStripStatusLabel
Private WithEvents LIST_VIDEOS As ListBox
Private WithEvents BTT_DOWN As ToolStripButton
Private WithEvents BTT_OPEN_PATH As ToolStripButton
End Class

141
SCrawler/VideosDownloaderForm.vb
View File

@@ -1,141 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Friend Class VideosDownloaderForm
Private MyView As FormsView
Private ReadOnly MyPR As Toolbars.MyProgress
Private ReadOnly UrlList As List(Of String)
Private ReadOnly DownloadingUrlsFile As SFile = $"{SettingsFolderName}\VideosUrls.txt"
Friend Sub New()
InitializeComponent()
UrlList = New List(Of String)
MyPR = New Toolbars.MyProgress(ToolbarBOTTOM, PR_V, LBL_STATUS, "Downloading video")
If DownloadingUrlsFile.Exists Then
UrlList.ListAddList(DownloadingUrlsFile.GetText.StringToList(Of String, List(Of String))(Environment.NewLine), LAP.NotContainsOnly)
End If
End Sub
Private Sub VideosDownloaderForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
MyView = New FormsView(Me)
MyView.ImportFromXML(Settings.Design)
MyView.SetMeSize()
RefillList(False)
Catch ex As Exception
End Try
End Sub
Private Sub VideosDownloaderForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub VideosDownloaderForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MyView Is Nothing Then MyView.Dispose(Settings.Design)
If UrlList.Count > 0 Then UpdateUrlsFile()
UrlList.Clear()
End Sub
Private Sub VideosDownloaderForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Dim b As Boolean = True
Select Case e.KeyCode
Case Keys.Insert : AddVideo()
Case Keys.F5 : DownloadVideos()
Case Keys.F8 : BTT_DELETE_Click(Nothing, EventArgs.Empty)
Case Else : b = False
End Select
If b Then e.Handled = True
End Sub
Private Sub RefillList(Optional ByVal Update As Boolean = True)
Try
With LIST_VIDEOS
.Items.Clear()
If UrlList.Count > 0 Then UrlList.ForEach(Sub(u) .Items.Add(u))
If .Items.Count > 0 And _LatestSelected >= 0 And _LatestSelected <= .Items.Count - 1 Then .SelectedIndex = _LatestSelected
If Update Then UpdateUrlsFile()
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on list refill")
End Try
End Sub
Private Sub UpdateUrlsFile()
If UrlList.Count > 0 Then
TextSaver.SaveTextToFile(UrlList.ListToString(, Environment.NewLine), DownloadingUrlsFile, True,, EDP.SendInLog)
Else
If DownloadingUrlsFile.Exists Then DownloadingUrlsFile.Delete(,,, EDP.SendInLog)
End If
End Sub
Private Sub BTT_ADD_Click(sender As Object, e As EventArgs) Handles BTT_ADD.Click
AddVideo()
End Sub
Private Sub AddVideo()
Dim URL$ = GetNewVideoURL()
If Not URL.IsEmptyString Then
If Not UrlList.Contains(URL) Then
UrlList.Add(URL)
RefillList()
Else
MsgBoxE("This URL already added to list")
End If
End If
End Sub
Private Sub BTT_ADD_LIST_Click(sender As Object, e As EventArgs) Handles BTT_ADD_LIST.Click
Dim l$ = InputBoxE("Enter URLs (new line as delimiter):", "URLs list", GetCurrentBuffer(),,,,,, True)
If Not l.IsEmptyString Then
Dim ub% = UrlList.Count
UrlList.ListAddList(l.StringToList(Of String, List(Of String))(Environment.NewLine))
If Not UrlList.Count = ub Then RefillList()
End If
End Sub
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click
If _LatestSelected >= 0 And _LatestSelected <= UrlList.Count - 1 Then
If MsgBoxE({$"Do you really want to delete video URL:{vbCr}{UrlList(_LatestSelected)}", "Deleting URL..."},
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo).DialogResult = MsgBoxResult.Yes Then
UrlList.RemoveAt(_LatestSelected)
RefillList()
End If
Else
MsgBoxE("URL does not selected", MsgBoxStyle.Exclamation)
End If
End Sub
Private Sub BTT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_DOWN.Click
DownloadVideos()
End Sub
Private Sub DownloadVideos()
If UrlList.Count > 0 Then
MyPR.TotalCount = UrlList.Count
MyPR.Enabled = True
Dim IsFirst As Boolean = True
For i% = UrlList.Count - 1 To 0 Step -1
If DownloadVideoByURL(UrlList(i), IsFirst, True) Then UrlList.RemoveAt(i)
MyPR.Perform()
IsFirst = False
Next
MyPR.Done()
RefillList()
MyPR.Enabled = False
Else
MsgBoxE("No one video added", MsgBoxStyle.Exclamation)
End If
End Sub
Private _LatestSelected As Integer = -1
Private Sub LIST_VIDEOS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_VIDEOS.SelectedIndexChanged
_LatestSelected = LIST_VIDEOS.SelectedIndex
End Sub
Private Sub BTT_OPEN_PATH_Click(sender As Object, e As EventArgs) Handles BTT_OPEN_PATH.Click
With Settings.LatestSavingPath
If Not .Value.IsEmptyString Then
If .Value.Exists(SFO.Path, False) Then
.Value.Open(SFO.Path, EDP.ShowMainMsg)
Else
MsgBoxE($"Path [{ .Value}] does not exists!", MsgBoxStyle.Exclamation)
End If
Else
MsgBoxE("Saving path does not set!", MsgBoxStyle.Exclamation)
End If
End With
End Sub
End Class