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

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