geonu/SCrawler
1
0
Fork 0
mirror of https://github.com/AAndyProgram/SCrawler.git synced 2026-03-16 00:32: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

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)