mirror of
https://github.com/AAndyProgram/SCrawler.git
synced 2026-03-15 00:02:17 +00:00
Initial commit
This commit is contained in:
Andy
78
SCrawler/API/Base/SiteSettings.vb
Normal file
78
SCrawler/API/Base/SiteSettings.vb
Normal file
@@ -0,0 +1,78 @@
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Functions.XML.Base
|
||||
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 As SFile
|
||||
Get
|
||||
If _Path.IsEmptyString Then _Path.Value = SFile.GetPath($"{Settings.GlobalPath.Value.PathWithSeparator}{Site}")
|
||||
Return _Path.Value
|
||||
End Get
|
||||
Set(ByVal NewFile As SFile)
|
||||
_Path.Value = NewFile
|
||||
End Set
|
||||
End Property
|
||||
Private ReadOnly SettingsFile As SFile
|
||||
Friend Sub New(ByVal s As Sites, ByRef _XML As XmlFile, ByVal GlobalPath As SFile)
|
||||
Site = s
|
||||
SettingsFile = $"{SettingsFolderName}\Responser_{s}.xml"
|
||||
Responser = New WEB.Response(SettingsFile)
|
||||
|
||||
If SettingsFile.Exists Then
|
||||
Responser.LoadSettings()
|
||||
Else
|
||||
If Site = Sites.Twitter Then
|
||||
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
|
||||
ElseIf Site = Sites.Reddit Then
|
||||
Responser.CookiesDomain = "reddit.com"
|
||||
Responser.Decoders.Add(SymbolsConverter.Converters.Unicode)
|
||||
End If
|
||||
Responser.SaveSettings()
|
||||
End If
|
||||
_Path = New XMLValue(Of SFile)("Path", SFile.GetPath($"{GlobalPath.PathWithSeparator}{Site}"), _XML, {Site.ToString}, XMLValue(Of SFile).ToFilePath)
|
||||
End Sub
|
||||
Friend Sub Update()
|
||||
Responser.SaveSettings()
|
||||
End Sub
|
||||
#Region "IDisposable Support"
|
||||
Private disposedValue As Boolean = False
|
||||
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue Then
|
||||
If disposing Then 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
|
||||
81
SCrawler/API/Base/Structures.vb
Normal file
81
SCrawler/API/Base/Structures.vb
Normal file
@@ -0,0 +1,81 @@
|
||||
Namespace API.Base
|
||||
Friend Module Structures
|
||||
Friend Structure UserMedia : Implements IEquatable(Of UserMedia)
|
||||
Friend Enum Types As Integer
|
||||
Undefined = 0
|
||||
[Picture] = 1
|
||||
[Video] = 2
|
||||
[Text] = 3
|
||||
VideoPre = 10
|
||||
GIF = 50
|
||||
m3u8 = 100
|
||||
End Enum
|
||||
Friend Enum States : Unknown : Tried : Downloaded : Skipped : End Enum
|
||||
Friend Type As Types
|
||||
Friend URL_BASE As String
|
||||
Friend URL As String
|
||||
Friend MD5 As String
|
||||
Friend [File] As SFile
|
||||
Friend Post As UserPost
|
||||
Friend PictureOption As String
|
||||
Friend State As States
|
||||
Friend Sub New(ByVal _URL As String)
|
||||
URL = _URL
|
||||
URL_BASE = _URL
|
||||
File = URL
|
||||
Type = Types.Undefined
|
||||
End Sub
|
||||
Friend Sub New(ByVal _URL As String, ByVal _Type As Types)
|
||||
Me.New(_URL)
|
||||
Type = _Type
|
||||
End Sub
|
||||
Public Shared Widening Operator CType(ByVal _URL As String) As UserMedia
|
||||
Return New UserMedia(_URL)
|
||||
End Operator
|
||||
Public Shared Widening Operator CType(ByVal m As UserMedia) As String
|
||||
Return m.URL
|
||||
End Operator
|
||||
Public Overrides Function ToString() As String
|
||||
Return URL
|
||||
End Function
|
||||
Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals
|
||||
Return URL = Other.URL
|
||||
End Function
|
||||
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
|
||||
Return Equals(CType(Obj, UserMedia))
|
||||
End Function
|
||||
End Structure
|
||||
Friend Structure UserPost : Implements IEquatable(Of UserPost), IComparable(Of UserPost)
|
||||
''' <summary>Post ID</summary>
|
||||
Friend ID As String
|
||||
Friend [Date] As Date?
|
||||
#Region "Channel compatible fields"
|
||||
Friend UserID As String
|
||||
Friend CachedFile As SFile
|
||||
#End Region
|
||||
Friend Function GetImage(ByVal s As Size, ByVal e As ErrorsDescriber, ByVal NullArg As Image) As Image
|
||||
If Not CachedFile.IsEmptyString Then
|
||||
Return If(PersonalUtilities.Tools.ImageRenderer.GetImage(SFile.GetBytes(CachedFile), s, e), NullArg.Clone)
|
||||
Else
|
||||
Return NullArg.Clone
|
||||
End If
|
||||
End Function
|
||||
#Region "IEquatable, IComparable Support"
|
||||
Friend Overloads Function Equals(ByVal Other As UserPost) As Boolean Implements IEquatable(Of UserPost).Equals
|
||||
Return ID = Other.ID
|
||||
End Function
|
||||
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
|
||||
Return Equals(DirectCast(Obj, UserPost))
|
||||
End Function
|
||||
Friend Function CompareTo(ByVal Other As UserPost) As Integer Implements IComparable(Of UserPost).CompareTo
|
||||
Return GetCompareValue(Me).CompareTo(GetCompareValue(Other))
|
||||
End Function
|
||||
#End Region
|
||||
Private Function GetCompareValue(ByVal Post As UserPost) As Long
|
||||
Dim v& = 0
|
||||
If Post.Date.HasValue Then v = Post.Date.Value.Ticks * -1
|
||||
Return v
|
||||
End Function
|
||||
End Structure
|
||||
End Module
|
||||
End Namespace
|
||||
961
SCrawler/API/Base/UserDataBase.vb
Normal file
961
SCrawler/API/Base/UserDataBase.vb
Normal file
@@ -0,0 +1,961 @@
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports System.IO
|
||||
Imports System.Threading
|
||||
Imports UState = SCrawler.API.Base.UserMedia.States
|
||||
Namespace API.Base
|
||||
Friend MustInherit Class UserDataBase : Implements IUserData
|
||||
Friend Const UserFileAppender As String = "User"
|
||||
Friend Event OnPictureUpdated As IUserData.OnPictureUpdatedEventHandler Implements IUserData.OnPictureUpdated
|
||||
Protected Sub Raise_OnPictureUpdated()
|
||||
RaiseEvent OnPictureUpdated(Me)
|
||||
End Sub
|
||||
#Region "Collection buttons"
|
||||
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)
|
||||
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
|
||||
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}
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "XML Declarations"
|
||||
Private Const Name_Site As String = "Site"
|
||||
Private Const Name_UserName As String = "UserName"
|
||||
Private Const Name_FriendlyName As String = "FriendlyName"
|
||||
Private Const Name_UserID As String = "UserID"
|
||||
Private Const Name_Description As String = "Description"
|
||||
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
|
||||
Private Const Name_Temporary As String = "Temporary"
|
||||
Private Const Name_Favorite As String = "Favorite"
|
||||
|
||||
Private Const Name_SeparateVideoFolder As String = "SeparateVideoFolder"
|
||||
Private Const Name_CollectionName As String = "Collection"
|
||||
Private Const Name_LabelsName As String = "Labels"
|
||||
|
||||
Private Const Name_ReadyForDownload As String = "ReadyForDownload"
|
||||
|
||||
Private Const Name_VideoCount As String = "VideoCount"
|
||||
Private Const Name_PicturesCount As String = "PicturesCount"
|
||||
Private Const Name_LastUpdated As String = "LastUpdated"
|
||||
|
||||
Private Const Name_DataMerging As String = "DataMerging"
|
||||
#Region "Downloaded data"
|
||||
Private Const Name_MediaType As String = "Type"
|
||||
Private Const Name_MediaURL As String = "URL"
|
||||
Private Const Name_MediaHash As String = "Hash"
|
||||
Private Const Name_MediaFile As String = "File"
|
||||
Private Const Name_MediaPostID As String = "ID"
|
||||
Private Const Name_MediaPostDate As String = "Date"
|
||||
#End Region
|
||||
#End Region
|
||||
#Region "Declarations"
|
||||
Friend MustOverride Property Site As Sites Implements IContentProvider.Site
|
||||
Friend User As UserInfo
|
||||
Friend Overridable Property Name As String Implements IContentProvider.Name
|
||||
Get
|
||||
Return User.Name
|
||||
End Get
|
||||
Set(ByVal NewName As String)
|
||||
User.Name = NewName
|
||||
User.UpdateUserFile()
|
||||
Settings.UpdateUsersList(User)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overridable Property ID As String = String.Empty Implements IContentProvider.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
|
||||
Protected _Favorite As Boolean = False
|
||||
Friend Overridable Property Favorite As Boolean Implements IContentProvider.Favorite
|
||||
Get
|
||||
Return _Favorite
|
||||
End Get
|
||||
Set(ByVal Fav As Boolean)
|
||||
_Favorite = Fav
|
||||
If _Favorite Then _Temporary = False
|
||||
End Set
|
||||
End Property
|
||||
Protected _Temporary As Boolean = False
|
||||
Friend Overridable Property Temporary As Boolean Implements IContentProvider.Temporary
|
||||
Get
|
||||
Return _Temporary
|
||||
End Get
|
||||
Set(ByVal Temp As Boolean)
|
||||
_Temporary = Temp
|
||||
If _Temporary Then _Favorite = False
|
||||
End Set
|
||||
End Property
|
||||
Friend Overridable ReadOnly Property IsChannel As Boolean Implements IUserData.IsChannel
|
||||
Get
|
||||
Return User.IsChannel
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property Self As IUserData Implements IUserData.Self
|
||||
Get
|
||||
Return Me
|
||||
End Get
|
||||
End Property
|
||||
#Region "Images"
|
||||
Friend Overridable Function GetUserPicture() As Image Implements IUserData.GetPicture
|
||||
If Settings.ViewModeIsPicture Then
|
||||
Return GetPicture()
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
End Function
|
||||
Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
|
||||
Try
|
||||
If Not f.IsEmptyString AndAlso f.Exists Then
|
||||
Using p As New UserImage(f, User.File) : p.Save() : End Using
|
||||
End If
|
||||
Catch ex As Exception
|
||||
End Try
|
||||
End Sub
|
||||
Protected Function GetNullPicture(ByVal MaxHeigh As XML.Base.XMLValue(Of Integer)) As Bitmap
|
||||
Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value)
|
||||
End Function
|
||||
Private Function GetPicture(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As Image
|
||||
Dim f As SFile = Nothing
|
||||
Dim p As UserImage = Nothing
|
||||
Dim DelPath As Boolean = True
|
||||
BlockPictureFolder:
|
||||
On Error GoTo BlockPictureScan
|
||||
f = SFile.GetPath($"{MyFile.PathWithSeparator}Pictures")
|
||||
If f.Exists(SFO.Path, False) Then
|
||||
Dim PicList As List(Of SFile) = SFile.GetFiles(f, $"{UserImage.ImagePrefix}*.jpg")
|
||||
If PicList.ListExists Then
|
||||
PicList.Sort()
|
||||
Dim l As SFile, s As SFile
|
||||
l = PicList.Find(Function(ff) ff.Name.Contains(UserImage.ImagePostfix_Large))
|
||||
If Not l.IsEmptyString Then PicList.Remove(l)
|
||||
s = PicList.Find(Function(ff) ff.Name.Contains(UserImage.ImagePostfix_Small))
|
||||
If Not s.IsEmptyString Then PicList.Remove(s)
|
||||
If PicList.Count > 0 Then
|
||||
p = New UserImage(PicList.First, l, s, MyFile)
|
||||
GoTo BlockReturn
|
||||
Else
|
||||
f.Delete(SFO.Path, False, False, EDP.None)
|
||||
DelPath = False
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
BlockPictureScan:
|
||||
On Error GoTo BlockDeletePictureFolder
|
||||
Dim NewPicFile As SFile = SFile.GetFiles(MyFile.CutPath, "*.jpg|*.png",,
|
||||
New ErrorsDescriber(EDP.ReturnValue) With {
|
||||
.ReturnValue = New List(Of SFile),
|
||||
.ReturnValueExists = True}).FirstOrDefault
|
||||
If Not NewPicFile.IsEmptyString AndAlso NewPicFile.Exists Then
|
||||
p = New UserImage(NewPicFile, MyFile)
|
||||
p.Save()
|
||||
GoTo BlockReturn
|
||||
End If
|
||||
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)
|
||||
End If
|
||||
BlockReturn:
|
||||
On Error GoTo BlockNullPicture
|
||||
If Not p Is Nothing Then
|
||||
Dim i As Image = Nothing
|
||||
Select Case Settings.ViewMode.Value
|
||||
Case View.LargeIcon : i = p.Large.OriginalImage.Clone
|
||||
Case View.SmallIcon : i = p.Small.OriginalImage.Clone
|
||||
End Select
|
||||
p.Dispose()
|
||||
Return i
|
||||
End If
|
||||
BlockNullPicture:
|
||||
If ReturnNullImageOnNothing Then
|
||||
Select Case Settings.ViewMode.Value
|
||||
Case View.LargeIcon : Return GetNullPicture(Settings.MaxLargeImageHeigh)
|
||||
Case View.SmallIcon : Return GetNullPicture(Settings.MaxSmallImageHeigh)
|
||||
End Select
|
||||
End If
|
||||
Return Nothing
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Separate folder"
|
||||
Friend Property SeparateVideoFolder As Boolean?
|
||||
Protected ReadOnly Property SeparateVideoFolderF As Boolean
|
||||
Get
|
||||
Return (SeparateVideoFolder.HasValue AndAlso SeparateVideoFolder.Value) OrElse Settings.SeparateVideoFolder.Value
|
||||
End Get
|
||||
End Property
|
||||
#End Region
|
||||
#Region "Collections support"
|
||||
Protected _IsCollection As Boolean = False
|
||||
Protected Friend ReadOnly Property IsCollection As Boolean Implements IUserData.IsCollection
|
||||
Get
|
||||
Return _IsCollection
|
||||
End Get
|
||||
End Property
|
||||
Friend Overridable Property CollectionName As String Implements IUserData.CollectionName
|
||||
Get
|
||||
Return User.CollectionName
|
||||
End Get
|
||||
Set(ByVal NewCollection As String)
|
||||
ChangeCollectionName(NewCollection, True)
|
||||
End Set
|
||||
End Property
|
||||
Friend ReadOnly Property IncludedInCollection As Boolean Implements IUserData.IncludedInCollection
|
||||
Get
|
||||
Return User.IncludedInCollection
|
||||
End Get
|
||||
End Property
|
||||
Friend Overridable Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
|
||||
Dim u As UserInfo = User
|
||||
u.CollectionName = NewName
|
||||
u.IncludedInCollection = Not NewName.IsEmptyString
|
||||
User = u
|
||||
If UpdateSettings Then Settings.UpdateUsersList(User)
|
||||
End Sub
|
||||
Friend Overridable ReadOnly Property Labels As List(Of String) Implements IUserData.Labels
|
||||
#End Region
|
||||
#Region "Downloading params"
|
||||
Protected _DataLoaded As Boolean = False
|
||||
Protected _DataParsed As Boolean = False
|
||||
Friend Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
|
||||
#End Region
|
||||
#Region "Content"
|
||||
Protected ReadOnly _ContentList As List(Of UserMedia)
|
||||
Protected ReadOnly _ContentNew As List(Of UserMedia)
|
||||
Protected ReadOnly _ContentForReparse As List(Of UserMedia)
|
||||
Protected ReadOnly _TempMediaList As List(Of UserMedia)
|
||||
Protected ReadOnly _TempPostsList As List(Of String)
|
||||
#End Region
|
||||
#Region "Files"
|
||||
Friend Overridable Property MyFile As SFile Implements IUserData.File
|
||||
Get
|
||||
Return User.File
|
||||
End Get
|
||||
Set(ByVal f As SFile)
|
||||
User.File = f
|
||||
Settings.UpdateUsersList(User)
|
||||
End Set
|
||||
End Property
|
||||
Protected MyFileData As SFile
|
||||
Protected MyFileDataR As SFile
|
||||
Protected MyFileDataRV As SFile
|
||||
Protected MyFilePosts As SFile
|
||||
Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists
|
||||
Friend Overridable Property DataMerging As Boolean
|
||||
Get
|
||||
Return User.Merged
|
||||
End Get
|
||||
Set(ByVal IsMerged As Boolean)
|
||||
If Not User.Merged = IsMerged Then
|
||||
User.Merged = IsMerged
|
||||
User.UpdateUserFile()
|
||||
Settings.UpdateUsersList(User)
|
||||
End If
|
||||
End Set
|
||||
End Property
|
||||
#End Region
|
||||
#Region "Information"
|
||||
Protected _CountVideo As Integer = 0
|
||||
Protected _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
|
||||
Get
|
||||
Return _DownloadedPicturesSession
|
||||
End Get
|
||||
Set(ByVal NewValue As Integer)
|
||||
_DownloadedPicturesSession = NewValue
|
||||
End Set
|
||||
End Property
|
||||
Private _DownloadedVideosTotal As Integer = 0
|
||||
Private _DownloadedVideosSession As Integer = 0
|
||||
Friend Property DownloadedVideos As Integer Implements IUserData.DownloadedVideos
|
||||
Get
|
||||
Return _DownloadedVideosSession
|
||||
End Get
|
||||
Set(ByVal NewValue As Integer)
|
||||
_DownloadedVideosSession = NewValue
|
||||
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
|
||||
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})"
|
||||
End Get
|
||||
End Property
|
||||
#End Region
|
||||
Protected ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)
|
||||
#End Region
|
||||
#Region "LVI"
|
||||
Friend ReadOnly Property LVIKey As String Implements IUserData.LVIKey
|
||||
Get
|
||||
If Not _IsCollection Then
|
||||
Return $"{IIf(Site = Sites.Reddit, "R", "T")}_{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}
|
||||
Else
|
||||
Return New ListViewItem(ToString(), GetLVIGroup(Destination)) With {.Name = LVIKey, .Tag = LVIKey}
|
||||
End If
|
||||
End Function
|
||||
Friend Overridable ReadOnly Property FitToAddParams As Boolean Implements IUserData.FitToAddParams
|
||||
Get
|
||||
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.Labels : Return Settings.Labels.CurrentSelection.ListContains(Labels)
|
||||
Case ShowingModes.NoLabels : Return Labels.Count = 0
|
||||
Case Else : Return True
|
||||
End Select
|
||||
End Get
|
||||
End Property
|
||||
Friend Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Implements IUserData.GetLVIGroup
|
||||
Try
|
||||
If Settings.ShowingMode.Value = ShowingModes.Labels Then
|
||||
If Labels.Count > 0 And Settings.Labels.CurrentSelection.Count > 0 Then
|
||||
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
|
||||
Else
|
||||
Return Destination.Groups.Item(GetLviGroupName(Site, Temporary, Favorite, IsCollection))
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
|
||||
End Try
|
||||
End Function
|
||||
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)}")
|
||||
If Not UserDescription.IsEmptyString Then
|
||||
OutStr.StringAppendLine(String.Empty)
|
||||
OutStr.StringAppendLine(UserDescription)
|
||||
End If
|
||||
OutStr.StringAppendLine(String.Empty)
|
||||
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)}")
|
||||
End If
|
||||
Return OutStr
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Initializer"
|
||||
Private ReadOnly _InvokeImageHandler As Boolean
|
||||
''' <summary>By using this constructor you must set UserName and MyFile manually</summary>
|
||||
Friend Sub New(Optional ByVal InvokeImageHandler As Boolean = True)
|
||||
_InvokeImageHandler = InvokeImageHandler
|
||||
_ContentList = New List(Of UserMedia)
|
||||
_ContentNew = New List(Of UserMedia)
|
||||
_ContentForReparse = New List(Of UserMedia)
|
||||
_TempMediaList = New List(Of UserMedia)
|
||||
_TempPostsList = New List(Of String)
|
||||
Labels = New List(Of String)
|
||||
If InvokeImageHandler Then ImageHandler(Me)
|
||||
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 : Return New Reddit.UserData(u, _LoadUserInformation)
|
||||
Case Sites.Twitter : Return New Twitter.UserData(u, _LoadUserInformation)
|
||||
Case Else : Throw New ArgumentOutOfRangeException("Site", $"Site [{u.Site}] information does not recognized by loader")
|
||||
End Select
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Information & Content data files loader and saver"
|
||||
#Region "User information"
|
||||
Friend Overridable Sub LoadUserInformation() Implements IUserData.LoadUserInformation
|
||||
Try
|
||||
If MyFile.Exists Then
|
||||
FileExists = True
|
||||
Using x As New XmlFile(MyFile) With {.XmlReadOnly = True}
|
||||
x.DefaultsLoading(False)
|
||||
User.Site = Site
|
||||
Site = x.Value(Name_Site).FromXML(Of Integer)(0)
|
||||
User.Name = x.Value(Name_UserName)
|
||||
ID = x.Value(Name_UserID)
|
||||
FriendlyName = x.Value(Name_FriendlyName)
|
||||
UserDescription = x.Value(Name_Description)
|
||||
ParseUserMediaOnly = x.Value(Name_ParseUserMediaOnly).FromXML(Of Boolean)(False)
|
||||
Temporary = x.Value(Name_Temporary).FromXML(Of Boolean)(False)
|
||||
Favorite = x.Value(Name_Favorite).FromXML(Of Boolean)(False)
|
||||
SeparateVideoFolder = AConvert(Of Boolean)(x.Value(Name_SeparateVideoFolder), Nothing)
|
||||
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
|
||||
_CountVideo = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
|
||||
_CountPictures = 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)
|
||||
Labels.ListAddList(x.Value(Name_LabelsName).StringToList(Of String, List(Of String))("|", EDP.ReturnValue), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
|
||||
End Using
|
||||
UpdateDataFiles()
|
||||
_DataForReparseExists = MyFileDataR.Exists
|
||||
End If
|
||||
Catch ex As Exception
|
||||
LogError(ex, "user information loading error")
|
||||
End Try
|
||||
End Sub
|
||||
Friend Overridable Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
|
||||
Try
|
||||
MyFile.Exists(SFO.Path)
|
||||
Using x As New XmlFile With {.Name = "User"}
|
||||
x.Add(Name_Site, CInt(Site))
|
||||
x.Add(Name_UserName, User.Name)
|
||||
x.Add(Name_UserID, ID)
|
||||
x.Add(Name_FriendlyName, FriendlyName)
|
||||
x.Add(Name_Description, UserDescription)
|
||||
x.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
|
||||
x.Add(Name_Temporary, Temporary.BoolToInteger)
|
||||
x.Add(Name_Favorite, Favorite.BoolToInteger)
|
||||
If SeparateVideoFolder.HasValue Then
|
||||
x.Add(Name_SeparateVideoFolder, SeparateVideoFolder.Value.BoolToInteger)
|
||||
Else
|
||||
x.Add(Name_SeparateVideoFolder, String.Empty)
|
||||
End If
|
||||
x.Add(Name_ReadyForDownload, ReadyForDownload.BoolToInteger)
|
||||
x.Add(Name_VideoCount, _CountVideo)
|
||||
x.Add(Name_PicturesCount, _CountPictures)
|
||||
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))
|
||||
x.Add(Name_DataMerging, DataMerging.BoolToInteger)
|
||||
|
||||
x.Save(MyFile)
|
||||
End Using
|
||||
Settings.UpdateUsersList(User)
|
||||
Catch ex As Exception
|
||||
LogError(ex, "user information saving error")
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "User data"
|
||||
Friend Overridable Overloads Sub LoadContentInformation()
|
||||
UpdateDataFiles()
|
||||
LoadContentInformation(_ContentList, MyFileData)
|
||||
LoadContentInformation(_ContentForReparse, MyFileDataR)
|
||||
LoadContentInformation(_TempMediaList, MyFileDataRV)
|
||||
_DataForReparseExists = False
|
||||
End Sub
|
||||
Private Overloads Sub LoadContentInformation(ByRef _CLIST As List(Of UserMedia), ByVal f As SFile)
|
||||
Try
|
||||
If Not f.Exists Then Exit Sub
|
||||
Using x As New XmlFile(f, ProtectionLevels.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
|
||||
x.LoadData()
|
||||
x.DefaultsLoading(False)
|
||||
If x.Count > 0 Then
|
||||
Dim fs$ = MyFile.CutPath.PathWithSeparator
|
||||
Dim gfn As Func(Of String, String) = Function(ByVal Input As String) As String
|
||||
If Input.IsEmptyString Then
|
||||
Return String.Empty
|
||||
Else
|
||||
If Input.Contains("\") Then
|
||||
Return New SFile(Input).File
|
||||
Else
|
||||
Return Input
|
||||
End If
|
||||
End If
|
||||
End Function
|
||||
For Each v As EContainer In x
|
||||
_CLIST.Add(New UserMedia With {
|
||||
.Type = AConvert(Of Integer)(v.Attribute(Name_MediaType).Value, 0),
|
||||
.URL = v.Attribute(Name_MediaURL).Value,
|
||||
.URL_BASE = v.Value,
|
||||
.MD5 = v.Attribute(Name_MediaHash).Value,
|
||||
.File = fs & gfn.Invoke(v.Attribute(Name_MediaFile).Value),
|
||||
.Post = New UserPost With {
|
||||
.ID = v.Attribute(Name_MediaPostID).Value,
|
||||
.[Date] = AConvert(Of Date)(v.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing)}
|
||||
})
|
||||
Next
|
||||
End If
|
||||
_DataLoaded = True
|
||||
End Using
|
||||
Catch ex As Exception
|
||||
LogError(ex, "history loading error")
|
||||
End Try
|
||||
End Sub
|
||||
Friend Sub UpdateContentInformation(ByRef _CLIST As List(Of UserMedia), ByVal f As SFile)
|
||||
Try
|
||||
UpdateDataFiles()
|
||||
If f.IsEmptyString Then Exit Sub
|
||||
f.Exists(SFO.Path)
|
||||
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Data"}
|
||||
If _CLIST.Count > 0 Then
|
||||
For Each i As UserMedia In _CLIST
|
||||
x.Add(New EContainer("MediaData", i.URL_BASE,
|
||||
{New EAttribute(Name_MediaType, CInt(i.Type)),
|
||||
New EAttribute(Name_MediaURL, i.URL),
|
||||
New EAttribute(Name_MediaHash, i.MD5),
|
||||
New EAttribute(Name_MediaFile, i.File.File),
|
||||
New EAttribute(Name_MediaPostID, i.Post.ID),
|
||||
New EAttribute(Name_MediaPostDate, AConvert(Of String)(i.Post.Date, ParsersDataDateProvider, String.Empty))
|
||||
}))
|
||||
Next
|
||||
End If
|
||||
x.Save(MyFileData)
|
||||
End Using
|
||||
Catch ex As Exception
|
||||
LogError(ex, "history saving error")
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#End Region
|
||||
#Region "Open site, folder"
|
||||
Friend Overridable Sub OpenSite() Implements IContentProvider.OpenSite
|
||||
Try
|
||||
Dim URL$ = String.Empty
|
||||
Select Case Site
|
||||
Case Sites.Reddit : URL = $"https://www.reddit.com/user/{Name}/"
|
||||
Case Sites.Twitter : URL = $"https://twitter.com/{Name}"
|
||||
Case Else : MsgBoxE($"Site [{Site}] opening does not implemented", MsgBoxStyle.Exclamation)
|
||||
End Select
|
||||
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)
|
||||
End Try
|
||||
End Sub
|
||||
Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder
|
||||
MyFile.CutPath.Open(SFO.Path, EDP.None)
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download functions and options"
|
||||
Friend Overridable Property DownloadReparseOnly As Boolean = False Implements IUserData.DownloadReparseOnly
|
||||
Private _DataForReparseExists As Boolean = False
|
||||
Friend Overridable ReadOnly Property DataForReparseExists As Boolean Implements IUserData.DataForReparseExists
|
||||
Get
|
||||
Return _ContentForReparse.Count > 0 Or _DataForReparseExists
|
||||
End Get
|
||||
End Property
|
||||
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
|
||||
Dim Canceled As Boolean = False
|
||||
Try
|
||||
UpdateDataFiles()
|
||||
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(False) Is Nothing
|
||||
_DownloadedPicturesSession = 0
|
||||
_DownloadedVideosSession = 0
|
||||
_TempMediaList.Clear()
|
||||
_TempPostsList.Clear()
|
||||
|
||||
If Not _DataLoaded Then LoadContentInformation()
|
||||
|
||||
If Not DownloadReparseOnly Then
|
||||
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
|
||||
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
|
||||
Token.ThrowIfCancellationRequested()
|
||||
DownloadDataF(Token)
|
||||
Token.ThrowIfCancellationRequested()
|
||||
End If
|
||||
|
||||
ReparseVideo(Token)
|
||||
If Token.IsCancellationRequested Then
|
||||
If Not DownloadReparseOnly Then
|
||||
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(c) c.Type = UserMedia.Types.VideoPre) Then
|
||||
TextSaver.SaveTextToFile((From c As UserMedia In _TempMediaList
|
||||
Where c.Type = UserMedia.Types.VideoPre
|
||||
Select c.URL).ListToString(, Environment.NewLine), MyFileDataRV, True,, EDP.SendInLog)
|
||||
Else
|
||||
If MyFileDataRV.Exists Then MyFileDataRV.Delete(,,, EDP.SendInLog)
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If Not DownloadReparseOnly And _TempPostsList.Count > 0 Then TextSaver.SaveTextToFile(_TempPostsList.ListToString(, Environment.NewLine), MyFilePosts, True,, EDP.None)
|
||||
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
|
||||
End If
|
||||
|
||||
Dim r% = 0
|
||||
Do While r <= 2 And (_ContentNew.Count > 0 Or _ContentForReparse.Count > 0) And Not Token.IsCancellationRequested
|
||||
DownloadContent(Token)
|
||||
If _ContentNew.Count > 0 Then
|
||||
_ContentForReparse.ListAddList(_ContentNew.Where(Function(c) c.State = UState.Tried Or c.State = UState.Unknown), LNC)
|
||||
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UState.Downloaded), LNC)
|
||||
End If
|
||||
If _ContentForReparse.Count > 0 Then _ContentForReparse.RemoveAll(Function(c) _ContentList.Contains(c))
|
||||
_ContentNew.Clear()
|
||||
If _ContentForReparse.Count > 0 Then _ContentNew.ListAddList(_ContentForReparse, LNC)
|
||||
r += 1
|
||||
Loop
|
||||
|
||||
_CountPictures = _ContentList.LongCount(Function(c) c.Type = UserMedia.Types.Picture)
|
||||
_CountVideo = _ContentList.LongCount(Function(c) c.Type = UserMedia.Types.Video)
|
||||
If DownloadedPictures + DownloadedVideos > 0 Then
|
||||
LastUpdated = Now
|
||||
If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser)
|
||||
UpdateContentInformation(_ContentList, MyFileData)
|
||||
UpdateUserInformation()
|
||||
End If
|
||||
If _ContentForReparse.Count > 0 Then UpdateContentInformation(_ContentForReparse, MyFileDataR)
|
||||
_DownloadedPicturesTotal += _DownloadedPicturesSession
|
||||
_DownloadedVideosTotal += _DownloadedVideosSession
|
||||
If UpPic Then Raise_OnPictureUpdated()
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
MyMainLOG = $"{Site} - {Name}: downloading canceled"
|
||||
Canceled = True
|
||||
Catch ex As Exception
|
||||
LogError(ex, "downloading data error")
|
||||
HasError = True
|
||||
Finally
|
||||
If Not Canceled Then _DataParsed = True ': LastUpdated = Now
|
||||
_ContentNew.Clear()
|
||||
DownloadReparseOnly = False
|
||||
If _ContentForReparse.Count = 0 And MyFileDataR.Exists Then MyFileDataR.Delete(,,, EDP.SendInLog)
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub UpdateDataFiles()
|
||||
If Not User.File.IsEmptyString Then
|
||||
MyFileData = User.File
|
||||
MyFileData.Name &= "_Data"
|
||||
MyFileDataR = MyFileData
|
||||
MyFileDataR.Name &= "_REPARSE"
|
||||
MyFileDataRV = MyFileData
|
||||
MyFileDataRV.Name &= "_RVideo"
|
||||
MyFilePosts = User.File
|
||||
MyFilePosts.Name &= "_Posts"
|
||||
MyFilePosts.Extension = "txt"
|
||||
Else
|
||||
Throw New ArgumentNullException("User.File", "User file does not detected")
|
||||
End If
|
||||
End Sub
|
||||
Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
Protected MustOverride Sub ReparseVideo(ByVal Token As CancellationToken)
|
||||
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
#End Region
|
||||
#Region "Delete, Move, Merge"
|
||||
Friend Overridable Function Delete() As Integer Implements IUserData.Delete
|
||||
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
|
||||
If f.Exists(SFO.Path, False) AndAlso f.Delete(SFO.Path, False, False) Then
|
||||
ImageHandler(Me, False)
|
||||
Settings.UsersList.Remove(User)
|
||||
Settings.UpdateUsersList()
|
||||
Settings.Users.Remove(Me)
|
||||
Downloader.UserRemove(Me)
|
||||
Dispose(True)
|
||||
Return 1
|
||||
Else
|
||||
Return 0
|
||||
End If
|
||||
End Function
|
||||
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal _MergeData As Boolean) As Boolean Implements IUserData.MoveFiles
|
||||
Dim UserBefore As UserInfo = User
|
||||
Try
|
||||
Dim f As SFile
|
||||
Dim Removed As Boolean
|
||||
If IncludedInCollection Then
|
||||
Settings.Users.Add(Me)
|
||||
Removed = False
|
||||
User.CollectionName = String.Empty
|
||||
User.IncludedInCollection = False
|
||||
Else
|
||||
Settings.Users.Remove(Me)
|
||||
Removed = True
|
||||
User.CollectionName = __CollectionName
|
||||
User.IncludedInCollection = True
|
||||
End If
|
||||
User.UpdateUserFile()
|
||||
f = User.File.CutPath(, EDP.ThrowException)
|
||||
If f.Exists(SFO.Path, False) Then
|
||||
If If(SFile.GetFiles(f,, SearchOption.AllDirectories), New List(Of SFile)).Count > 0 AndAlso
|
||||
MsgBoxE({$"Destination directory [{f.Path}] already exists and contains files!" & vbCr &
|
||||
"By continuing, this directory and all files will be deleted",
|
||||
"Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then
|
||||
MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation)
|
||||
User = UserBefore
|
||||
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
|
||||
Return False
|
||||
End If
|
||||
f.Delete(SFO.Path, False, False, EDP.ThrowException)
|
||||
End If
|
||||
f.CutPath.Exists(SFO.Path)
|
||||
Directory.Move(UserBefore.File.CutPath(, EDP.ThrowException).Path, f.Path)
|
||||
Settings.UsersList.Remove(UserBefore)
|
||||
Settings.UpdateUsersList(User)
|
||||
UpdateUserInformation()
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Files moving error")
|
||||
User = UserBefore
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
Friend Overloads Sub MergeData()
|
||||
Dim UserBefore As UserInfo = User
|
||||
Try
|
||||
If DataMerging Then
|
||||
Throw New InvalidOperationException($"{Site} - {Name}: data already merged") With {.HelpLink = 1}
|
||||
Else
|
||||
Dim files As List(Of SFile) = Nothing
|
||||
Dim allFiles As List(Of SFile) = Nothing
|
||||
Dim fSource As SFile, fDest As SFile
|
||||
Dim ReplacingPath$ = UserBefore.File.CutPath.Path
|
||||
Dim dirs As List(Of SFile) = SFile.GetDirectories(UserBefore.File.CutPath,, SearchOption.AllDirectories)
|
||||
Dim FilesMover As Action = Sub()
|
||||
If files.ListExists Then
|
||||
For Each fSource In files
|
||||
fDest = fSource
|
||||
fDest.Path = User.File.CutPath.PathWithSeparator & fSource.Path.Replace(ReplacingPath, String.Empty)
|
||||
fDest.Exists(SFO.Path,, EDP.ThrowException)
|
||||
fDest = CheckFile(fDest, allFiles)
|
||||
File.Move(fSource, fDest)
|
||||
Next
|
||||
files.Clear()
|
||||
End If
|
||||
End Sub
|
||||
DataMerging = True
|
||||
If dirs.ListExists Then
|
||||
For Each dir As SFile In dirs
|
||||
allFiles = SFile.GetFiles(SFile.GetPath(User.File.CutPath.PathWithSeparator &
|
||||
dir.Path.Replace(ReplacingPath, String.Empty)),,, EDP.ReturnValue)
|
||||
files = SFile.GetFiles(dir,,, EDP.ReturnValue)
|
||||
FilesMover.Invoke
|
||||
Next
|
||||
End If
|
||||
allFiles = SFile.GetFiles(User.File.CutPath,,, EDP.ReturnValue)
|
||||
|
||||
files = SFile.GetFiles(UserBefore.File.CutPath,,, EDP.ReturnValue)
|
||||
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)
|
||||
End If
|
||||
UpdateUserInformation()
|
||||
End If
|
||||
Catch ex As Exception
|
||||
LogError(ex, "[UserDataBase.MergeData]")
|
||||
End Try
|
||||
End Sub
|
||||
Private Function CheckFile(ByVal f As SFile, ByRef List As IEnumerable(Of SFile)) As SFile
|
||||
If List.ListExists Then
|
||||
Dim p As New RegexStructure(".+?\s{0,1}\((\d+)\)|.+",,,,,,, String.Empty, EDP.ReturnValue)
|
||||
Dim i% = List.Where(Function(ff) CStr(RegexReplace(ff.Name, p)).Trim.ToLower = f.Name.Trim.ToLower).Count
|
||||
If i > 0 Then f.Name &= $" ({i + 1})"
|
||||
End If
|
||||
Return f
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Errors functions"
|
||||
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String)
|
||||
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"{IIf(IncludedInCollection, $"{CollectionName}-", String.Empty)}{Site} - {Name}: {Message}")
|
||||
End Sub
|
||||
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
|
||||
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
|
||||
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
|
||||
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
|
||||
Downloader.Add(Me)
|
||||
End Sub
|
||||
Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click
|
||||
Using f As New Editors.UserCreatorForm(Me)
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then UpdateUserInformation()
|
||||
End Using
|
||||
End Sub
|
||||
Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click
|
||||
End Sub
|
||||
Private Sub BTT_CONTEXT_OPEN_PATH_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_PATH.Click
|
||||
OpenFolder()
|
||||
End Sub
|
||||
Private Sub BTT_CONTEXT_OPEN_SITE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_SITE.Click
|
||||
OpenSite()
|
||||
End Sub
|
||||
#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
|
||||
End Function
|
||||
Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
|
||||
Return CompareTo(DirectCast(Obj, UserDataBase))
|
||||
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
|
||||
End Function
|
||||
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
|
||||
Return Equals(DirectCast(Obj, UserDataBase))
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IDisposable Support"
|
||||
Protected disposedValue As Boolean = False
|
||||
Friend ReadOnly Property Disposed As Boolean
|
||||
Get
|
||||
Return disposedValue
|
||||
End Get
|
||||
End Property
|
||||
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue Then
|
||||
If disposing Then
|
||||
_ContentList.Clear()
|
||||
_ContentNew.Clear()
|
||||
_TempMediaList.Clear()
|
||||
_TempPostsList.Clear()
|
||||
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()
|
||||
If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose()
|
||||
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)
|
||||
End If
|
||||
disposedValue = True
|
||||
End If
|
||||
End Sub
|
||||
Protected Overloads Overrides Sub Finalize()
|
||||
Dispose(False)
|
||||
MyBase.Finalize()
|
||||
End Sub
|
||||
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
|
||||
Dispose(True)
|
||||
GC.SuppressFinalize(Me)
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
Friend Interface IContentProvider
|
||||
Property Site As Sites
|
||||
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 DownloadData(ByVal Token As CancellationToken)
|
||||
End Interface
|
||||
Friend Interface IUserData : Inherits IContentProvider, IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IDisposable
|
||||
Event OnPictureUpdated(ByVal User As IUserData)
|
||||
Property ParseUserMediaOnly As Boolean
|
||||
#Region "Images"
|
||||
Function GetPicture() As Image
|
||||
Sub SetPicture(ByVal f As SFile)
|
||||
#End Region
|
||||
#Region "Collection support"
|
||||
ReadOnly Property IsCollection As Boolean
|
||||
Property CollectionName As String
|
||||
ReadOnly Property IncludedInCollection As Boolean
|
||||
ReadOnly Property Labels As List(Of String)
|
||||
#End Region
|
||||
ReadOnly Property IsChannel As Boolean
|
||||
Property ReadyForDownload As Boolean
|
||||
Property [File] As SFile
|
||||
Property FileExists As Boolean
|
||||
Property DownloadedPictures As Integer
|
||||
Property DownloadedVideos 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
|
||||
Function GetLVI(ByVal Destination As ListView) As ListViewItem
|
||||
Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup
|
||||
Sub LoadUserInformation()
|
||||
Sub UpdateUserInformation()
|
||||
''' <summary>
|
||||
''' 0 - Nothing removed<br/>
|
||||
''' 1 - User removed<br/>
|
||||
''' 2 - Collection removed<br/>
|
||||
''' 3 - Collection splitted
|
||||
''' </summary>
|
||||
Function Delete() As Integer
|
||||
Function MoveFiles(ByVal CollectionName As String, ByVal MergeData As Boolean) As Boolean
|
||||
Sub OpenFolder()
|
||||
Property DownloadReparseOnly As Boolean
|
||||
ReadOnly Property DataForReparseExists As Boolean
|
||||
ReadOnly Property Self As IUserData
|
||||
End Interface
|
||||
Friend Interface IChannelLimits
|
||||
Property AutoGetLimits As Boolean
|
||||
Property DownloadLimitCount As Integer?
|
||||
Property DownloadLimitPost As String
|
||||
Property DownloadLimitDate As Date?
|
||||
Overloads Sub SetLimit(Optional ByVal Post As String = "", Optional ByVal Count As Integer? = Nothing, Optional ByVal [Date] As Date? = Nothing)
|
||||
Overloads Sub SetLimit(ByVal Source As IChannelLimits)
|
||||
End Interface
|
||||
Friend Interface IChannelData : Inherits IContentProvider, IChannelLimits
|
||||
Property SkipExistsUsers As Boolean
|
||||
Property SaveToCache As Boolean
|
||||
End Interface
|
||||
End Namespace
|
||||
304
SCrawler/API/Reddit/Channel.vb
Normal file
304
SCrawler/API/Reddit/Channel.vb
Normal file
@@ -0,0 +1,304 @@
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports SCrawler.API.Base
|
||||
Namespace API.Reddit
|
||||
Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel),
|
||||
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"
|
||||
#End Region
|
||||
Friend Const DefaultDownloadLimitCount As Integer = 1000
|
||||
Friend Property Name As String = String.Empty
|
||||
Friend Property ID As String = String.Empty
|
||||
Friend ReadOnly Property CUser As UserInfo
|
||||
Get
|
||||
Return New UserInfo(Me)
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property PostsLatest As List(Of UserPost)
|
||||
Friend ReadOnly Property Posts As List(Of UserPost)
|
||||
Friend ReadOnly Property PostsAll As List(Of UserPost)
|
||||
Get
|
||||
Return ListAddList(Nothing, Posts).ListAddList(PostsLatest).ListSort
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly Property Source As IEnumerable(Of UserPost) Implements IRangeSwitcherContainer(Of UserPost).Source
|
||||
Get
|
||||
Return Posts
|
||||
End Get
|
||||
End Property
|
||||
Friend Property LatestParsedDate As Date? = Nothing
|
||||
Private _Downloading As Boolean = False
|
||||
Friend ReadOnly Property Downloading As Boolean
|
||||
Get
|
||||
Return _Downloading
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property File As SFile
|
||||
Get
|
||||
Return $"{ChannelsCollection.ChannelsPath.PathWithSeparator}{ID}.xml"
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property CachePath As SFile
|
||||
Get
|
||||
Return $"{ChannelsCollection.ChannelsPathCache.PathWithSeparator}{ID}\"
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property Count As Integer Implements ICollection(Of UserPost).Count, IMyEnumerator(Of UserPost).MyEnumeratorCount
|
||||
Get
|
||||
Return Posts.Count
|
||||
End Get
|
||||
End Property
|
||||
Default Friend ReadOnly Property Item(ByVal Index As Integer) As UserPost Implements IMyEnumerator(Of UserPost).MyEnumeratorObject
|
||||
Get
|
||||
Return Posts(Index)
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly Property Range As RangeSwitcher(Of UserPost)
|
||||
#Region "Limits Support"
|
||||
Private _DownloadLimitCount As Integer? = Nothing
|
||||
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
|
||||
Get
|
||||
If AutoGetLimits Then
|
||||
If LatestParsedDate.HasValue OrElse Not DownloadLimitPost.IsEmptyString Then
|
||||
Return Nothing
|
||||
ElseIf _DownloadLimitCount.HasValue Then
|
||||
Return _DownloadLimitCount
|
||||
Else
|
||||
Return DefaultDownloadLimitCount
|
||||
End If
|
||||
Else
|
||||
Return _DownloadLimitCount
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal NewLimit As Integer?)
|
||||
_DownloadLimitCount = NewLimit
|
||||
End Set
|
||||
End Property
|
||||
Private _DownloadLimitPost As String = String.Empty
|
||||
Friend Property DownloadLimitPost As String Implements IChannelLimits.DownloadLimitPost
|
||||
Get
|
||||
Dim PID$ = ListAddList(Nothing, Posts, LAP.NotContainsOnly).ListAddList(PostsLatest, LAP.NotContainsOnly).ListSort.FirstOrDefault.ID
|
||||
If AutoGetLimits And Not PID.IsEmptyString Then
|
||||
Return PID
|
||||
Else
|
||||
Return _DownloadLimitPost
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal NewLimit As String)
|
||||
_DownloadLimitPost = NewLimit
|
||||
End Set
|
||||
End Property
|
||||
Private _DownloadLimitDate As Date? = Nothing
|
||||
Friend Property DownloadLimitDate As Date? Implements IChannelLimits.DownloadLimitDate
|
||||
Get
|
||||
If AutoGetLimits And LatestParsedDate.HasValue Then
|
||||
Return LatestParsedDate
|
||||
Else
|
||||
Return _DownloadLimitDate
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal NewLimit As Date?)
|
||||
_DownloadLimitDate = NewLimit
|
||||
End Set
|
||||
End Property
|
||||
Friend Overloads Sub SetLimit(Optional ByVal MaxPost As String = "", Optional ByVal MaxCount As Integer? = Nothing,
|
||||
Optional ByVal MinDate As Date? = Nothing) Implements IChannelLimits.SetLimit
|
||||
DownloadLimitPost = MaxPost
|
||||
DownloadLimitCount = MaxCount
|
||||
DownloadLimitDate = MinDate
|
||||
End Sub
|
||||
Friend Overloads Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit
|
||||
With Source
|
||||
DownloadLimitCount = .DownloadLimitCount
|
||||
DownloadLimitPost = .DownloadLimitPost
|
||||
DownloadLimitDate = .DownloadLimitDate
|
||||
AutoGetLimits = .AutoGetLimits
|
||||
End With
|
||||
End Sub
|
||||
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
|
||||
#End Region
|
||||
Friend Sub New()
|
||||
Posts = New List(Of UserPost)
|
||||
PostsLatest = New List(Of UserPost)
|
||||
Range = New RangeSwitcher(Of UserPost)(Me)
|
||||
End Sub
|
||||
Friend Sub New(ByVal f As SFile)
|
||||
Me.New
|
||||
LoadData(f, False)
|
||||
End Sub
|
||||
Public Shared Widening Operator CType(ByVal f As SFile) As Channel
|
||||
Return New Channel(f)
|
||||
End Operator
|
||||
Public Overrides Function ToString() As String
|
||||
If Not Name.IsEmptyString Then
|
||||
Return Name
|
||||
Else
|
||||
Return ID
|
||||
End If
|
||||
End Function
|
||||
Friend Sub Delete()
|
||||
If File.Exists Then File.Delete()
|
||||
End Sub
|
||||
Friend Sub DownloadData(ByVal Token As Threading.CancellationToken, Optional ByVal SkipExists As Boolean = True,
|
||||
Optional ByVal p As MyProgress = Nothing)
|
||||
Try
|
||||
_Downloading = True
|
||||
Using d As New UserData(CUser, False, False) With {
|
||||
.Progress = p,
|
||||
.SaveToCache = True,
|
||||
.SkipExistsUsers = SkipExists,
|
||||
.ChannelInfo = Me
|
||||
}
|
||||
d.SetLimit(Me)
|
||||
d.DownloadData(Token)
|
||||
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
|
||||
Posts.Sort()
|
||||
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
|
||||
Token.ThrowIfCancellationRequested()
|
||||
End Using
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
Finally
|
||||
_Downloading = False
|
||||
End Try
|
||||
End Sub
|
||||
#Region "ICollection Support"
|
||||
Private ReadOnly Property IsReadOnly As Boolean = False Implements ICollection(Of UserPost).IsReadOnly
|
||||
Friend Sub Add(ByVal _Item As UserPost) Implements ICollection(Of UserPost).Add
|
||||
If Not Contains(_Item) Then Posts.Add(_Item)
|
||||
End Sub
|
||||
Friend Sub AddRange(ByVal _Items As IEnumerable(Of UserPost))
|
||||
If _Items.ListExists Then
|
||||
For Each i As UserPost In _Items : Add(i) : Next
|
||||
End If
|
||||
End Sub
|
||||
Friend Sub Clear() Implements ICollection(Of UserPost).Clear
|
||||
Posts.Clear()
|
||||
End Sub
|
||||
Friend Function Contains(ByVal _Item As UserPost) As Boolean Implements ICollection(Of UserPost).Contains
|
||||
Return Count > 0 AndAlso Posts.Contains(_Item)
|
||||
End Function
|
||||
Private Sub CopyTo(ByVal _Array() As UserPost, ByVal ArrayIndex As Integer) Implements ICollection(Of UserPost).CopyTo
|
||||
Throw New NotImplementedException()
|
||||
End Sub
|
||||
Friend Function Remove(ByVal _Item As UserPost) As Boolean Implements ICollection(Of UserPost).Remove
|
||||
Return Posts.Remove(_Item)
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IEnumerable Support"
|
||||
Friend Function GetEnumerator() As IEnumerator(Of UserPost) Implements IEnumerable(Of UserPost).GetEnumerator
|
||||
Return New MyEnumerator(Of UserPost)(Me)
|
||||
End Function
|
||||
Friend Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
|
||||
Return GetEnumerator()
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IEquatable Support"
|
||||
Friend Overloads Function Equals(ByVal Other As Channel) As Boolean Implements IEquatable(Of Channel).Equals
|
||||
Return ID = Other.ID
|
||||
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)
|
||||
Else
|
||||
Return Equals(DirectCast(Obj, Channel))
|
||||
End If
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IComparable Support"
|
||||
Friend Function CompareTo(ByVal Other As Channel) As Integer Implements IComparable(Of Channel).CompareTo
|
||||
If Not Name.IsEmptyString And Not Other.Name.IsEmptyString Then
|
||||
Return Name.CompareTo(Other.Name)
|
||||
Else
|
||||
Return ID.CompareTo(Other.ID)
|
||||
End If
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IXMLContainer Support"
|
||||
Friend Overloads Function LoadData(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Load
|
||||
Return LoadData(File, False, e)
|
||||
End Function
|
||||
Friend Overloads Function LoadData(ByVal f As SFile, ByVal PartialLoad As Boolean, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
|
||||
If f.Exists Then
|
||||
Using x As New XmlFile(f, ProtectionLevels.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
|
||||
x.LoadData()
|
||||
x.DefaultsLoading(False)
|
||||
If x.Count > 0 Then
|
||||
Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
|
||||
Name = x.Value(Name_Name)
|
||||
ID = x.Value(Name_ID)
|
||||
LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), XMLDateProvider, Nothing)
|
||||
If Not PartialLoad Then
|
||||
With x(Name_PostsNode).XmlIfNothing
|
||||
If .Count > 0 Then .ForEach(Sub(ee) PostsLatest.Add(New UserPost With {
|
||||
.ID = ee.Attribute(Name_ID),
|
||||
.[Date] = AConvert(Of Date)(ee.Attribute(Name_Date).Value, XMLDateProvider, Nothing)}))
|
||||
End With
|
||||
End If
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
Return True
|
||||
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)
|
||||
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}
|
||||
x.DefaultsLoading(False)
|
||||
x.Add(Name_Name, Name)
|
||||
x.Add(Name_ID, ID)
|
||||
If Posts.Count > 0 Or PostsLatest.Count > 0 Then
|
||||
Dim tmpPostList As List(Of UserPost) = Nothing
|
||||
tmpPostList.ListAddList(Posts).ListAddList(PostsLatest)
|
||||
tmpPostList.Sort()
|
||||
LatestParsedDate = tmpPostList.FirstOrDefault(Function(pd) pd.Date.HasValue).Date
|
||||
x.Add(Name_Date, AConvert(Of String)(LatestParsedDate, XMLDateProvider, String.Empty))
|
||||
x.Add(Name_PostsNode, String.Empty)
|
||||
With x(Name_PostsNode)
|
||||
tmpPostList.Take(200).ToList.ForEach(Sub(p) .Add(New EContainer("Post",
|
||||
String.Empty,
|
||||
{
|
||||
New EAttribute(Name_ID, p.ID),
|
||||
New EAttribute(Name_Date, AConvert(Of String)(p.Date, XMLDateProvider, String.Empty))
|
||||
})
|
||||
)
|
||||
)
|
||||
End With
|
||||
tmpPostList.Clear()
|
||||
End If
|
||||
x.Save(File)
|
||||
End Using
|
||||
Return True
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IDisposable Support"
|
||||
Private disposedValue As Boolean = False
|
||||
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue Then
|
||||
If disposing Then
|
||||
Posts.Clear()
|
||||
PostsLatest.Clear()
|
||||
Range.Dispose()
|
||||
If CachePath.Exists(SFO.Path, False) Then CachePath.Delete(SFO.Path, False, False, EDP.SendInLog)
|
||||
End If
|
||||
disposedValue = True
|
||||
End If
|
||||
End Sub
|
||||
Protected Overrides Sub Finalize()
|
||||
Dispose(False)
|
||||
MyBase.Finalize()
|
||||
End Sub
|
||||
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
|
||||
Dispose(True)
|
||||
GC.SuppressFinalize(Me)
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
End Namespace
|
||||
141
SCrawler/API/Reddit/ChannelsCollection.vb
Normal file
141
SCrawler/API/Reddit/ChannelsCollection.vb
Normal file
@@ -0,0 +1,141 @@
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Imports SCrawler.API.Base
|
||||
Imports System.Threading
|
||||
Namespace API.Reddit
|
||||
Friend Class ChannelsCollection : Implements ICollection(Of Channel), IMyEnumerator(Of Channel), IChannelLimits, IDisposable
|
||||
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 ReadOnly Property Downloading As Boolean
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Channels.Exists(Function(c) c.Downloading)
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
#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
|
||||
Friend Property DownloadLimitDate As Date? Implements IChannelLimits.DownloadLimitDate
|
||||
Friend Overloads Sub SetLimit(Optional ByVal MaxPost As String = "", Optional ByVal MaxCount As Integer? = Nothing,
|
||||
Optional ByVal MinDate As Date? = Nothing) Implements IChannelLimits.SetLimit
|
||||
'DownloadLimitPost = MaxPost
|
||||
DownloadLimitCount = MaxCount
|
||||
DownloadLimitDate = MinDate
|
||||
End Sub
|
||||
Friend Overloads Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit
|
||||
With Source
|
||||
DownloadLimitCount = .DownloadLimitCount
|
||||
DownloadLimitDate = .DownloadLimitDate
|
||||
AutoGetLimits = .AutoGetLimits
|
||||
End With
|
||||
End Sub
|
||||
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
|
||||
#End Region
|
||||
Friend Sub New()
|
||||
Channels = New List(Of Channel)
|
||||
End Sub
|
||||
Friend Sub Load()
|
||||
If ChannelsPath.Exists(SFO.Path, False) Then
|
||||
Dim files As List(Of SFile) = SFile.GetFiles(ChannelsPath, "*.xml")
|
||||
If files.ListExists Then files.ForEach(Sub(f) Add(f))
|
||||
End If
|
||||
End Sub
|
||||
Friend Sub Update()
|
||||
If Count > 0 Then Channels.ForEach(Sub(c) c.Save())
|
||||
End Sub
|
||||
Friend ReadOnly Property Count As Integer Implements ICollection(Of Channel).Count, IMyEnumerator(Of Channel).MyEnumeratorCount
|
||||
Get
|
||||
Return Channels.Count
|
||||
End Get
|
||||
End Property
|
||||
Default Friend ReadOnly Property Item(ByVal Index As Integer) As Channel Implements IMyEnumerator(Of Channel).MyEnumeratorObject
|
||||
Get
|
||||
Return Channels(Index)
|
||||
End Get
|
||||
End Property
|
||||
''' <exception cref="ArgumentException"></exception>
|
||||
Friend ReadOnly Property Find(ByVal ChannelID As String) As Channel
|
||||
Get
|
||||
If Count > 0 Then
|
||||
For i% = 0 To Count - 1
|
||||
If Item(i).ID = ChannelID Then Return Item(i)
|
||||
Next
|
||||
End If
|
||||
Throw New ArgumentException($"Channel ID [{ChannelID}] does not found in channels collection", "ChannelID") With {.HelpLink = 1}
|
||||
'Return Nothing
|
||||
End Get
|
||||
End Property
|
||||
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
|
||||
Optional ByVal p As MyProgress = Nothing)
|
||||
Try
|
||||
If Count > 0 Then
|
||||
Dim t As New List(Of Task)
|
||||
For Each c As Channel In Channels
|
||||
If Not c.Downloading Then t.Add(Task.Run(Sub()
|
||||
c.SetLimit(Me)
|
||||
c.DownloadData(Token, SkipExists, p)
|
||||
End Sub))
|
||||
Next
|
||||
If t.Count > 0 Then Task.WaitAll(t.ToArray)
|
||||
Token.ThrowIfCancellationRequested()
|
||||
End If
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
End Try
|
||||
End Sub
|
||||
#Region "ICollection Support"
|
||||
Private ReadOnly Property IsReadOnly As Boolean = False Implements ICollection(Of Channel).IsReadOnly
|
||||
Friend Sub Add(ByVal _Item As Channel) Implements ICollection(Of Channel).Add
|
||||
If Not Contains(_Item) Then Channels.Add(_Item)
|
||||
End Sub
|
||||
Friend Sub Clear() Implements ICollection(Of Channel).Clear
|
||||
Channels.ListClearDispose
|
||||
End Sub
|
||||
Private Sub CopyTo(ByVal _Array() As Channel, ByVal ArrayIndex As Integer) Implements ICollection(Of Channel).CopyTo
|
||||
Throw New NotImplementedException()
|
||||
End Sub
|
||||
Friend Function Contains(ByVal _Item As Channel) As Boolean Implements ICollection(Of Channel).Contains
|
||||
Return Count > 0 AndAlso Channels.Contains(_Item)
|
||||
End Function
|
||||
Friend Function Remove(ByVal _Item As Channel) As Boolean Implements ICollection(Of Channel).Remove
|
||||
If Count > 0 Then
|
||||
Dim i% = Channels.IndexOf(_Item)
|
||||
If i >= 0 Then
|
||||
With Channels(i) : .Delete() : .Dispose() : End With
|
||||
Channels.RemoveAt(i)
|
||||
Return True
|
||||
End If
|
||||
End If
|
||||
Return False
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IEnumerable Support"
|
||||
Friend Function GetEnumerator() As IEnumerator(Of Channel) Implements IEnumerable(Of Channel).GetEnumerator
|
||||
Return New MyEnumerator(Of Channel)(Me)
|
||||
End Function
|
||||
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
|
||||
Return GetEnumerator()
|
||||
End Function
|
||||
#End Region
|
||||
#Region "IDisposable Support"
|
||||
Private disposedValue As Boolean = False
|
||||
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue Then
|
||||
If disposing Then Update() : Clear()
|
||||
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
|
||||
33
SCrawler/API/Reddit/Declarations.vb
Normal file
33
SCrawler/API/Reddit/Declarations.vb
Normal file
@@ -0,0 +1,33 @@
|
||||
Imports PersonalUtilities.Functions.XML.Base
|
||||
Namespace API.Reddit
|
||||
Friend Module Declarations
|
||||
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)}
|
||||
Friend ReadOnly UrlBasePattern As New RegexStructure("(?<=/)([^/]+?\.[\w]{3,4})(?=(\?|\Z))", True, False)
|
||||
Friend ReadOnly VideoRegEx As New RegexStructure("http.{0,1}://[^" & Chr(34) & "]+?mp4", True, False)
|
||||
Friend ReadOnly DateProvider As New JsonDate
|
||||
Friend ReadOnly DateProviderChannel As New JsonDateChannel
|
||||
Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Modes.EUR)
|
||||
Friend Class JsonDate : Implements ICustomProvider
|
||||
''' <inheritdoc cref="ADateTime.ParseUnicodeJS(Object, Object, ErrorsDescriber)"/>
|
||||
Friend 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
|
||||
Return ADateTime.ParseUnicodeJS(Value, NothingArg, e)
|
||||
End Function
|
||||
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
|
||||
Throw New NotImplementedException("GetFormat does not available in this context")
|
||||
End Function
|
||||
End Class
|
||||
Friend Class JsonDateChannel : Implements ICustomProvider
|
||||
''' <inheritdoc cref="ADateTime.ParseUnicodeJS(Object, Object, ErrorsDescriber)"/>
|
||||
Friend 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
|
||||
Return ADateTime.ParseUnicode(AConvert(Of Integer)(Value, EUR_PROVIDER, Value), NothingArg, e)
|
||||
End Function
|
||||
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
|
||||
Throw New NotImplementedException("GetFormat does not available in this context")
|
||||
End Function
|
||||
End Class
|
||||
End Module
|
||||
End Namespace
|
||||
100
SCrawler/API/Reddit/M3U8.vb
Normal file
100
SCrawler/API/Reddit/M3U8.vb
Normal file
@@ -0,0 +1,100 @@
|
||||
Imports System.Net
|
||||
Imports SCrawler.API.Reddit.M3U8_Declarations
|
||||
Imports PersonalUtilities.Tools.WEB
|
||||
Namespace API.Reddit.M3U8_Declarations
|
||||
Friend Module M3U8_Declarations
|
||||
Friend ReadOnly BaseUrlPattern As New RegexStructure("([htps:/]{7,8}.+?/.+?)(?=/)", True, False,,,,,, EDP.ReturnValue)
|
||||
Friend ReadOnly PlayListRegEx_1 As New RegexStructure("(#EXT-X-STREAM-INF)(.+)(RESOLUTION=)(\d+)(.+?[\r\n]{1,2})(.+?)([\r\n]{1,2})", True, False,,,
|
||||
RegexReturn.List,, New List(Of String),
|
||||
New ErrorsDescriber(False, False, True, New List(Of String)))
|
||||
Friend ReadOnly PlayListRegEx_2 As New RegexStructure("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", True, False,,, RegexReturn.List,,
|
||||
New List(Of String),
|
||||
New ErrorsDescriber(False, False, True, New List(Of String)))
|
||||
Friend ReadOnly DPED As New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue)
|
||||
End Module
|
||||
End Namespace
|
||||
Namespace API.Reddit
|
||||
Friend NotInheritable Class M3U8
|
||||
Private Sub New()
|
||||
End Sub
|
||||
Private Structure Resolution : Implements IRegExCreator, IComparable(Of Resolution)
|
||||
Friend File As String
|
||||
Friend Resolution As Integer
|
||||
Friend Function CreateFromArray(ByVal ParamsArray() As String) As IRegExCreator Implements IRegExCreator.CreateFromArray
|
||||
If ParamsArray.ArrayExists Then
|
||||
File = ParamsArray(0)
|
||||
If ParamsArray.Length > 1 Then Resolution = AConvert(Of Integer)(ParamsArray(1), 0)
|
||||
End If
|
||||
Return Me
|
||||
End Function
|
||||
Friend Function CompareTo(ByVal Other As Resolution) As Integer Implements IComparable(Of Resolution).CompareTo
|
||||
Return Resolution.CompareTo(Other.Resolution) * -1
|
||||
End Function
|
||||
End Structure
|
||||
Private Shared Function GetPlaylistUrls(ByVal PlayListURL As String, ByVal BaseUrl As String) As List(Of String)
|
||||
Try
|
||||
If Not BaseUrl.IsEmptyString Then
|
||||
Using w As New WebClient
|
||||
Dim r$ = w.DownloadString(PlayListURL)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim l As List(Of Resolution) = RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4})
|
||||
If l.ListExists Then
|
||||
l.Sort()
|
||||
Dim pls$ = $"{BaseUrl}/{l.First.File}"
|
||||
r = w.DownloadString(pls)
|
||||
If Not r.IsEmptyString Then
|
||||
Dim lp As New ListAddParams(LAP.NotContainsOnly) With {
|
||||
.Converter = Function(input) $"{BaseUrl}/{input}",
|
||||
.e = New ErrorsDescriber(False, False, True, New List(Of String))}
|
||||
Return ListAddList(Of String, List(Of String))(Nothing, DirectCast(RegexReplace(r, PlayListRegEx_2), List(Of String)), lp).ListIfNothing
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
Return New List(Of String)
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(DPED, ex, "[M3U8.GetPlaylistUrls]", New List(Of String))
|
||||
End Try
|
||||
End Function
|
||||
Private Shared Function Save(ByVal URLs As List(Of String), ByVal f As SFile) As SFile
|
||||
Dim CachePath As SFile = Nothing
|
||||
Try
|
||||
If URLs.ListExists Then
|
||||
Dim ConcatFile As SFile = f
|
||||
ConcatFile.Name = "PlayListFile"
|
||||
ConcatFile.Extension = "mp4"
|
||||
CachePath = $"{f.PathWithSeparator}_Cache\{SFile.GetDirectories($"{f.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\"
|
||||
If CachePath.Exists(SFO.Path) Then
|
||||
Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers(ANumbers.Modes.USA) With {.GroupSeparator = String.Empty, .FormatMode = ANumbers.Formats.General})
|
||||
ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ReturnValue)
|
||||
Dim i%
|
||||
Dim eFiles As New List(Of SFile)
|
||||
Dim dFile As SFile = CachePath
|
||||
dFile.Extension = New SFile(URLs(0)).Extension
|
||||
If dFile.Extension.IsEmptyString Then dFile.Extension = "ts"
|
||||
Using w As New WebClient
|
||||
For i = 0 To URLs.Count - 1
|
||||
dFile.Name = $"ConPart_{i}"
|
||||
w.DownloadFile(URLs(i), dFile)
|
||||
eFiles.Add(dFile)
|
||||
Next
|
||||
End Using
|
||||
f = FFMPEG.ConcatenateFiles(eFiles, "ffmpeg.exe", ConcatFile, p, DPED)
|
||||
eFiles.Clear()
|
||||
Return f
|
||||
End If
|
||||
End If
|
||||
Return Nothing
|
||||
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)
|
||||
End Try
|
||||
End Function
|
||||
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile) As SFile
|
||||
Dim BaseUrl$ = RegexReplace(URL, BaseUrlPattern)
|
||||
Return Save(GetPlaylistUrls(URL, BaseUrl), f)
|
||||
End Function
|
||||
End Class
|
||||
End Namespace
|
||||
468
SCrawler/API/Reddit/UserData.vb
Normal file
468
SCrawler/API/Reddit/UserData.vb
Normal file
@@ -0,0 +1,468 @@
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports PersonalUtilities.Forms.Toolbars
|
||||
Imports PersonalUtilities.Tools.ImageRenderer
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports System.Net
|
||||
Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
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
|
||||
#Region "Channels Support"
|
||||
#Region "IChannelLimits Support"
|
||||
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
|
||||
Friend Property DownloadLimitPost As String Implements IChannelLimits.DownloadLimitPost
|
||||
Friend Property DownloadLimitDate As Date? Implements IChannelLimits.DownloadLimitDate
|
||||
Friend Overloads Sub SetLimit(Optional ByVal MaxPost As String = "", Optional ByVal MaxCount As Integer? = Nothing,
|
||||
Optional ByVal MinDate As Date? = Nothing) Implements IChannelLimits.SetLimit
|
||||
DownloadLimitPost = MaxPost
|
||||
DownloadLimitCount = MaxCount
|
||||
DownloadLimitDate = MinDate
|
||||
End Sub
|
||||
Friend Overloads Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit
|
||||
With Source
|
||||
DownloadLimitCount = .DownloadLimitCount
|
||||
DownloadLimitPost = .DownloadLimitPost
|
||||
DownloadLimitDate = .DownloadLimitDate
|
||||
AutoGetLimits = .AutoGetLimits
|
||||
End With
|
||||
End Sub
|
||||
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
|
||||
#End Region
|
||||
Friend Property ChannelInfo As Channel
|
||||
Private ReadOnly ChannelPostsNames As New List(Of String)
|
||||
Friend Property SkipExistsUsers As Boolean = True Implements IChannelData.SkipExistsUsers
|
||||
Private ReadOnly _ExistsUsersNames As List(Of String)
|
||||
Friend Property SaveToCache As Boolean = False Implements IChannelData.SaveToCache
|
||||
Friend Function GetNewChannelPosts() As IEnumerable(Of UserPost)
|
||||
If _ContentNew.Count > 0 Then Return (From c As UserMedia In _ContentNew
|
||||
Where Not c.Post.CachedFile.IsEmptyString And c.State = UStates.Downloaded
|
||||
Select c.Post) Else Return Nothing
|
||||
End Function
|
||||
#End Region
|
||||
Private _Progress As MyProgress
|
||||
Friend Property Progress As MyProgress
|
||||
Get
|
||||
If _Progress Is Nothing Then Return MainProgress Else Return _Progress
|
||||
End Get
|
||||
Set(ByVal p As MyProgress)
|
||||
_Progress = p
|
||||
End Set
|
||||
End Property
|
||||
#Region "Initializers"
|
||||
''' <summary>Video downloader initializer</summary>
|
||||
Private Sub New()
|
||||
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)
|
||||
User = u
|
||||
If _LoadUserInformation Then LoadUserInformation()
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download Overrides"
|
||||
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
|
||||
If IsChannel Then
|
||||
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)
|
||||
ReparseVideo(Token)
|
||||
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
|
||||
DownloadContent(Token)
|
||||
Else
|
||||
MyBase.DownloadData(Token)
|
||||
End If
|
||||
End Sub
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
If IsChannel Then
|
||||
_DownloadedChannelPosts = 0
|
||||
DownloadDataChannel(String.Empty, Token)
|
||||
Else
|
||||
DownloadDataUser(String.Empty, Token)
|
||||
End If
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download Functions (User, Channel)"
|
||||
Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
Dim PostID$ = String.Empty
|
||||
Dim PostDate$
|
||||
Dim n As EContainer, nn As EContainer, s As EContainer
|
||||
Dim NewPostDetected As Boolean = False
|
||||
Dim ExistsDetected As Boolean = False
|
||||
Dim _ItemsBefore%
|
||||
Dim added As Boolean
|
||||
Dim __ItemType$
|
||||
Dim tmpType As UTypes
|
||||
Dim CheckNode As Predicate(Of EContainer) = Function(e) e("author").XmlIfNothingValue("/").ToLower.Equals(Name.ToLower)
|
||||
Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
|
||||
|
||||
URL = $"https://gateway.reddit.com/desktopapi/v1/user/{Name}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort=new&t=all&layout=classic"
|
||||
Token.ThrowIfCancellationRequested()
|
||||
Dim r$ = GetSiteResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
Using w As EContainer = JsonDocument.Parse(r)
|
||||
If w.Count > 0 Then
|
||||
n = w.GetNode(JsonNodesJson)
|
||||
If Not n Is Nothing AndAlso n.Count > 0 Then
|
||||
For Each nn In n
|
||||
Token.ThrowIfCancellationRequested()
|
||||
If nn.Count > 0 Then
|
||||
PostID = nn.Name
|
||||
If PostID.IsEmptyString AndAlso nn.Contains("id") Then PostID = nn("id").Value
|
||||
If nn.Contains("created") Then PostDate = nn("created").Value Else PostDate = String.Empty
|
||||
If Not _TempPostsList.Contains(PostID) Then
|
||||
NewPostDetected = True
|
||||
_TempPostsList.Add(PostID)
|
||||
Else
|
||||
ExistsDetected = True
|
||||
Continue For
|
||||
End If
|
||||
If CheckNode(nn) Then
|
||||
_ItemsBefore = _TempMediaList.Count
|
||||
added = True
|
||||
s = nn.ItemF({"source", "url"})
|
||||
If s.XmlIfNothingValue("/").Contains("redgifs.com") Then
|
||||
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, PostID, PostDate,, IsChannel), LNC)
|
||||
Else
|
||||
s = nn.ItemF({"media"}).XmlIfNothing
|
||||
__ItemType = s("type").XmlIfNothingValue
|
||||
Select Case __ItemType
|
||||
Case "gallery" : DownloadGallery(s, PostID, PostDate)
|
||||
Case "image", "gifvideo"
|
||||
If s.Contains("content") Then _
|
||||
_TempMediaList.ListAddValue(MediaFromData(UPicType(__ItemType), s.Value("content"),
|
||||
PostID, PostDate,, IsChannel), LNC)
|
||||
Case "video"
|
||||
If s("hlsUrl").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then _
|
||||
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value("hlsUrl"),
|
||||
PostID, PostDate,, IsChannel), LNC)
|
||||
Case Else : added = False
|
||||
End Select
|
||||
End If
|
||||
If Not added Then
|
||||
s = nn.ItemF({"source", "url"}).XmlIfNothing
|
||||
If Not s.IsEmptyString AndAlso TryFile(s.Value) Then
|
||||
With s.Value.ToLower
|
||||
Select Case True
|
||||
Case .Contains("redgifs") : tmpType = UTypes.VideoPre
|
||||
Case .Contains("m3u8") : tmpType = UTypes.m3u8
|
||||
Case .Contains(".gif") And TryFile(s.Value) : tmpType = UTypes.GIF
|
||||
Case TryFile(s.Value) : tmpType = UTypes.Picture
|
||||
Case Else : tmpType = UTypes.Undefined
|
||||
End Select
|
||||
End With
|
||||
If Not tmpType = UTypes.Undefined Then _
|
||||
_TempMediaList.ListAddValue(MediaFromData(tmpType, s.Value, PostID, PostDate,, IsChannel), LNC)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
End Using
|
||||
If POST.IsEmptyString And ExistsDetected Then Exit Sub
|
||||
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataUser(PostID, Token)
|
||||
End If
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
Catch ex As Exception
|
||||
LogError(ex, $"data downloading error [{URL}]")
|
||||
HasError = True
|
||||
End Try
|
||||
End Sub
|
||||
Private _DownloadedChannelPosts As Integer = 0
|
||||
Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken)
|
||||
Dim URL$ = String.Empty
|
||||
Try
|
||||
Dim PostID$ = String.Empty
|
||||
Dim PostDate$, _UserID$, tmpUrl$
|
||||
Dim n As EContainer, nn As EContainer, s As EContainer, ss As EContainer
|
||||
Dim NewPostDetected As Boolean = False
|
||||
Dim ExistsDetected As Boolean = False
|
||||
Dim eCount As Predicate(Of EContainer) = Function(e) e.Count > 0
|
||||
Dim lDate As Date?
|
||||
|
||||
URL = $"https://reddit.com/r/{Name}/new.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort=new&t=all&layout=classic"
|
||||
Token.ThrowIfCancellationRequested()
|
||||
Dim r$ = GetSiteResponse(URL)
|
||||
If Not r.IsEmptyString Then
|
||||
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
|
||||
If w.Count > 0 Then
|
||||
n = w.GetNode(ChannelJsonNodes)
|
||||
If Not n Is Nothing AndAlso n.Count > 0 Then
|
||||
For Each nn In n
|
||||
Token.ThrowIfCancellationRequested()
|
||||
s = nn.ItemF({eCount})
|
||||
If Not s Is Nothing AndAlso s.Count > 0 Then
|
||||
PostID = s.Value("name")
|
||||
If PostID.IsEmptyString AndAlso s.Contains("id") Then PostID = s("id").Value
|
||||
|
||||
If ChannelPostsNames.Contains(PostID) Then ExistsDetected = True : Continue For 'Exit Sub
|
||||
If DownloadLimitCount.HasValue AndAlso _DownloadedChannelPosts >= DownloadLimitCount.Value Then Exit Sub
|
||||
If Not DownloadLimitPost.IsEmptyString AndAlso DownloadLimitPost = PostID Then Exit Sub
|
||||
If DownloadLimitDate.HasValue AndAlso _TempMediaList.Count > 0 Then
|
||||
With (From __u In _TempMediaList Where __u.Post.Date.HasValue Select __u.Post.Date.Value)
|
||||
If .Count > 0 Then lDate = .Min Else lDate = Nothing
|
||||
End With
|
||||
If lDate.HasValue AndAlso lDate.Value <= DownloadLimitDate.Value Then Exit Sub
|
||||
End If
|
||||
NewPostDetected = True
|
||||
|
||||
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
|
||||
|
||||
tmpUrl = s.Value("url")
|
||||
If Not tmpUrl.IsEmptyString AndAlso tmpUrl.Contains("redgifs.com") Then
|
||||
If SaveToCache Then
|
||||
tmpUrl = s.Value({"media", "oembed"}, "thumbnail_url")
|
||||
If Not tmpUrl.IsEmptyString Then
|
||||
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
|
||||
_DownloadedChannelPosts += 1
|
||||
End If
|
||||
Else
|
||||
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
|
||||
_DownloadedChannelPosts += 1
|
||||
End If
|
||||
ElseIf s.Item("media_metadata").XmlIfNothing.Count > 0 Then
|
||||
DownloadGallery(s, PostID, PostDate, _UserID, SaveToCache)
|
||||
_DownloadedChannelPosts += 1
|
||||
ElseIf s.Contains("preview") Then
|
||||
ss = s.ItemF({"preview", "images", eCount, "source", "url"}).XmlIfNothing
|
||||
If Not ss.Value.IsEmptyString Then
|
||||
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, ss.Value, PostID, PostDate, _UserID, IsChannel), LNC)
|
||||
_DownloadedChannelPosts += 1
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
End Using
|
||||
If POST.IsEmptyString And ExistsDetected Then Exit Sub
|
||||
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataChannel(PostID, Token)
|
||||
End If
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
Catch ex As Exception
|
||||
LogError(ex, $"channel data downloading error [{URL}]")
|
||||
HasError = True
|
||||
End Try
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download Base Functions"
|
||||
Private Sub DownloadGallery(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
|
||||
Optional ByVal _UserID As String = Nothing, Optional ByVal FirstOnly As Boolean = False)
|
||||
Try
|
||||
Dim cn$ = IIf(IsChannel, "media_metadata", "mediaMetadata")
|
||||
If Not w Is Nothing AndAlso w(cn).XmlIfNothing.Count > 0 Then
|
||||
Dim t As EContainer
|
||||
For Each n As EContainer In w(cn)
|
||||
t = n.ItemF({"s", "u"})
|
||||
If Not t Is Nothing AndAlso Not t.Value.IsEmptyString Then
|
||||
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, t.Value, PostID, PostDate, _UserID, IsChannel), LNC)
|
||||
If FirstOnly Then Exit For
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Catch ex As Exception
|
||||
LogError(ex, "gallery parsing error")
|
||||
HasError = True
|
||||
End Try
|
||||
End Sub
|
||||
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
|
||||
Try
|
||||
Token.ThrowIfCancellationRequested()
|
||||
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(p) p.Type = UTypes.VideoPre) Then
|
||||
Dim r$, v$
|
||||
Dim m As UserMedia
|
||||
For i% = _TempMediaList.Count - 1 To 0 Step -1
|
||||
Token.ThrowIfCancellationRequested()
|
||||
If _TempMediaList(i).Type = UTypes.VideoPre Then
|
||||
m = _TempMediaList(i)
|
||||
r = GetSiteResponse(m.URL)
|
||||
_TempMediaList(i) = New UserMedia
|
||||
If Not r.IsEmptyString Then
|
||||
v = RegexReplace(r, VideoRegEx)
|
||||
If Not v.IsEmptyString Then
|
||||
_TempMediaList(i) = New UserMedia With {.Type = UTypes.Video, .URL = v, .File = v, .Post = m.Post}
|
||||
Else
|
||||
_TempMediaList.RemoveAt(i)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
Catch ex As Exception
|
||||
LogError(ex, "video reparsing error")
|
||||
End Try
|
||||
End Sub
|
||||
Friend Shared Function GetVideoInfo(ByVal URL As String) As 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.ReparseVideo(Nothing)
|
||||
If r._TempMediaList.ListExists Then Return r._TempMediaList(0)
|
||||
End Using
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Video searching error")
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Structure creator"
|
||||
Protected Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
|
||||
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As UserMedia
|
||||
If _URL.IsEmptyString And t = UTypes.Picture Then Return Nothing
|
||||
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
|
||||
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}}
|
||||
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) Else m.File = Nothing
|
||||
If m.URL.Contains("preview") Then m.URL = $"https://i.redd.it/{m.File.File}"
|
||||
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, If(IsChannel, DateProviderChannel, DateProvider), Nothing) Else m.Post.Date = Nothing
|
||||
Return m
|
||||
End Function
|
||||
Private Function TryFile(ByVal URL As String) As Boolean
|
||||
Try
|
||||
If Not URL.IsEmptyString AndAlso URL.Contains(".jpg") Then
|
||||
Dim f As SFile = CStr(RegexReplace(URL, FilesPattern))
|
||||
Return Not f.IsEmptyString And Not f.File.IsEmptyString
|
||||
End If
|
||||
Return False
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
Try
|
||||
Dim i%
|
||||
Token.ThrowIfCancellationRequested()
|
||||
If _ContentNew.Count > 0 Then
|
||||
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
|
||||
If _ContentNew.Count > 0 Then
|
||||
MyFile.Exists(SFO.Path)
|
||||
Dim MyDir$
|
||||
If IsChannel And SaveToCache Then
|
||||
MyDir = ChannelInfo.CachePath.PathNoSeparator
|
||||
Else
|
||||
MyDir = MyFile.CutPath.PathNoSeparator
|
||||
End If
|
||||
Dim HashList As New List(Of String)
|
||||
If _ContentList.Count > 0 Then HashList.ListAddList((From h In _ContentList Where Not h.MD5.IsEmptyString Select h.MD5), LNC)
|
||||
Dim f As SFile
|
||||
Dim v As UserMedia
|
||||
Dim cached As Boolean = IsChannel And SaveToCache
|
||||
Dim vsf As Boolean = SeparateVideoFolderF
|
||||
Dim ImgFormat As Imaging.ImageFormat
|
||||
Dim bDP As New ErrorsDescriber(EDP.None)
|
||||
Dim MD5BS As Func(Of String, UTypes,
|
||||
SFile, Boolean, String) = Function(ByVal __URL As String, ByVal __MT As UTypes,
|
||||
ByVal __File As SFile, ByVal __IsBase As Boolean) As String
|
||||
Try
|
||||
If __MT = UTypes.GIF Then
|
||||
ImgFormat = Imaging.ImageFormat.Gif
|
||||
ElseIf __IsBase Then
|
||||
ImgFormat = GetImageFormat(CStr(RegexReplace(__URL, UrlBasePattern)))
|
||||
Else
|
||||
ImgFormat = GetImageFormat(__File)
|
||||
End If
|
||||
Return ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__URL, bDP), ImgFormat))
|
||||
Catch hash_ex As Exception
|
||||
Return String.Empty
|
||||
End Try
|
||||
End Function
|
||||
Dim m$
|
||||
Using w As New WebClient
|
||||
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
|
||||
Progress.TotalCount += _ContentNew.Count
|
||||
For i = 0 To _ContentNew.Count - 1
|
||||
Token.ThrowIfCancellationRequested()
|
||||
v = _ContentNew(i)
|
||||
v.State = UStates.Tried
|
||||
If v.Type = UTypes.Picture Then v.File = v.URL
|
||||
If v.File.IsEmptyString Then
|
||||
f = v.URL
|
||||
Else
|
||||
f = v.File
|
||||
End If
|
||||
f.Separator = "\"
|
||||
m = String.Empty
|
||||
If (v.Type = UTypes.Picture Or v.Type = UTypes.GIF) And Not cached Then
|
||||
m = MD5BS(v.URL, v.Type, f, False)
|
||||
If m.IsEmptyString AndAlso Not v.URL_BASE.IsEmptyString AndAlso Not v.URL_BASE = v.URL Then
|
||||
m = MD5BS(v.URL_BASE, v.Type, f, True)
|
||||
If Not m.IsEmptyString Then v.URL = v.URL_BASE
|
||||
End If
|
||||
End If
|
||||
|
||||
If (Not m.IsEmptyString AndAlso Not HashList.Contains(m)) Or Not (v.Type = UTypes.Picture Or
|
||||
v.Type = UTypes.GIF) Or cached Then
|
||||
If Not cached Then HashList.Add(m)
|
||||
v.MD5 = m
|
||||
f.Path = MyDir
|
||||
Try
|
||||
If (v.Type = UTypes.Video Or v.Type = UTypes.m3u8) And vsf Then f.Path = $"{f.PathWithSeparator}Video"
|
||||
If v.Type = UTypes.m3u8 Then
|
||||
f = M3U8.Download(v.URL, f)
|
||||
Else
|
||||
w.DownloadFile(v.URL, f.ToString)
|
||||
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
|
||||
End Select
|
||||
v.File = f
|
||||
v.Post.CachedFile = f
|
||||
v.State = UStates.Downloaded
|
||||
End If
|
||||
Catch wex As Exception
|
||||
If Not IsChannel Then ErrorDownloading(f, v.URL)
|
||||
End Try
|
||||
Else
|
||||
v.State = UStates.Skipped
|
||||
End If
|
||||
_ContentNew(i) = v
|
||||
Progress.Perform()
|
||||
Next
|
||||
End Using
|
||||
End If
|
||||
End If
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
Catch ex As Exception
|
||||
LogError(ex, "content downloading error")
|
||||
HasError = True
|
||||
End Try
|
||||
End Sub
|
||||
Protected Function GetSiteResponse(ByVal URL As String) As String
|
||||
Try
|
||||
Return Settings.Site(Sites.Reddit).Responser.GetResponse(URL,, EDP.ThrowException)
|
||||
Catch ex As Exception
|
||||
HasError = True
|
||||
Dim e As EDP = EDP.SendInLog
|
||||
Dim OptText$ = String.Empty
|
||||
If Settings.Site(Sites.Reddit).Responser.StatusCode = HttpStatusCode.NotFound Then
|
||||
e += EDP.ThrowException
|
||||
OptText = ": USER NOT FOUND"
|
||||
Else
|
||||
e += EDP.ReturnValue
|
||||
End If
|
||||
Return ErrorsDescriber.Execute(e, ex, $"[{Site} - {Name}: GetSiteResponse([{URL}])]{OptText}", String.Empty)
|
||||
End Try
|
||||
End Function
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue And disposing Then ChannelPostsNames.Clear() : _ExistsUsersNames.Clear()
|
||||
MyBase.Dispose(disposing)
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
9
SCrawler/API/Twitter/Declarations.vb
Normal file
9
SCrawler/API/Twitter/Declarations.vb
Normal file
@@ -0,0 +1,9 @@
|
||||
Imports PersonalUtilities.Functions.XML.Base
|
||||
Namespace API.Twitter
|
||||
Friend Module Declarations
|
||||
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 New RegexStructure("\d+x(\d+)",,,, 1,,, String.Empty, EDP.ReturnValue)
|
||||
Friend ReadOnly UserIdRegEx As New RegexStructure("user_id.:.(\d+)",,,, 1,,, String.Empty, EDP.ReturnValue)
|
||||
End Module
|
||||
End Namespace
|
||||
264
SCrawler/API/Twitter/UserData.vb
Normal file
264
SCrawler/API/Twitter/UserData.vb
Normal file
@@ -0,0 +1,264 @@
|
||||
Imports PersonalUtilities.Tools.WebDocuments.JSON
|
||||
Imports PersonalUtilities.Functions.XML
|
||||
Imports System.Net
|
||||
Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Imports UStates = SCrawler.API.Base.UserMedia.States
|
||||
Namespace API.Twitter
|
||||
Friend Class UserData : Inherits UserDataBase
|
||||
#Region "Declarations"
|
||||
Friend Overrides Property Site As Sites = Sites.Twitter
|
||||
Private Structure Sizes : Implements IComparable(Of Sizes)
|
||||
Friend Value As Integer
|
||||
Friend Name As String
|
||||
Friend ReadOnly HasError As Boolean
|
||||
Friend Sub New(ByVal _Value As String, ByVal _Name As String)
|
||||
Try
|
||||
Value = _Value
|
||||
Name = _Name
|
||||
Catch ex As Exception
|
||||
HasError = True
|
||||
End Try
|
||||
End Sub
|
||||
Friend Function CompareTo(ByVal Other As Sizes) As Integer Implements IComparable(Of Sizes).CompareTo
|
||||
Return Value.CompareTo(Other.Value) * -1
|
||||
End Function
|
||||
Friend Shared Function Reparse(ByRef Current As Sizes, ByVal Other As Sizes, ByVal LargeContained As Boolean) As Sizes
|
||||
If LargeContained And Current.Name.IsEmptyString And Current.Value > Other.Value Then Current.Name = "large"
|
||||
Return Current
|
||||
End Function
|
||||
Friend Shared Function ApplyLarge(ByRef s As Sizes) As Sizes
|
||||
s.Name = "large"
|
||||
Return s
|
||||
End Function
|
||||
End Structure
|
||||
#End Region
|
||||
#Region "Initializer"
|
||||
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
|
||||
User = u
|
||||
If _LoadUserInformation Then LoadUserInformation()
|
||||
End Sub
|
||||
#End Region
|
||||
#Region "Download functions"
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
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 m As EContainer, nn As EContainer, s As EContainer
|
||||
Dim NewPostDetected As Boolean = False
|
||||
Dim ExistsDetected As Boolean = False
|
||||
|
||||
Dim PicNode As Predicate(Of EContainer) = Function(e) e.Count > 0 AndAlso e.Contains("media_url")
|
||||
Dim UID As Func(Of EContainer, String) = Function(e) e.XmlIfNothing.Item({"user", "id"}).XmlIfNothingValue
|
||||
|
||||
URL = $"https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name={Name}&count=200&exclude_replies=false&include_rts=1&tweet_mode=extended"
|
||||
If Not POST.IsEmptyString Then URL &= $"&max_id={POST}"
|
||||
|
||||
Token.ThrowIfCancellationRequested()
|
||||
Dim r$ = Settings.Site(Sites.Twitter).Responser.GetResponse(URL,, EDP.ThrowException)
|
||||
If Not r.IsEmptyString Then
|
||||
Using w As EContainer = JsonDocument.Parse(r)
|
||||
If Not w Is Nothing AndAlso w.Count > 0 Then
|
||||
For Each nn In w
|
||||
Token.ThrowIfCancellationRequested()
|
||||
If nn.Count > 0 Then
|
||||
PostID = nn.Value("id")
|
||||
If ID.IsEmptyString Then
|
||||
ID = UID(nn)
|
||||
If Not ID.IsEmptyString Then UpdateUserInformation()
|
||||
End If
|
||||
|
||||
'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
|
||||
|
||||
If Not _TempPostsList.Contains(PostID) Then
|
||||
NewPostDetected = True
|
||||
_TempPostsList.Add(PostID)
|
||||
Else
|
||||
ExistsDetected = True
|
||||
Continue For
|
||||
End If
|
||||
|
||||
If Not ParseUserMediaOnly OrElse (Not nn.Contains("retweeted_status") OrElse
|
||||
(Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then
|
||||
If Not CheckVideoNode(nn, PostID, PostDate) Then
|
||||
s = nn.ItemF({"extended_entities", "media"})
|
||||
If s Is Nothing OrElse s.Count = 0 Then s = nn.ItemF({"retweeted_status", "extended_entities", "media"})
|
||||
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)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End Using
|
||||
If POST.IsEmptyString And ExistsDetected Then Exit Sub
|
||||
If Not PostID.IsEmptyString And NewPostDetected Then DownloadData(PostID, Token)
|
||||
End If
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
Catch ex As Exception
|
||||
LogError(ex, $"data downloading error [{URL}]")
|
||||
HasError = True
|
||||
End Try
|
||||
End Sub
|
||||
Friend Shared Function GetVideoInfo(ByVal URL As String) As UserMedia
|
||||
Try
|
||||
If URL.Contains("twitter") Then
|
||||
Dim PostID$ = RegexReplace(URL, New RegexStructure("(?<=/)\d+", True, False,,,,, String.Empty))
|
||||
If Not PostID.IsEmptyString Then
|
||||
Dim r$ = Settings.Site(Sites.Twitter).Responser.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)
|
||||
If j.ListExists Then
|
||||
Dim u$ = GetVideoNodeURL(j)
|
||||
If Not u.IsEmptyString Then Return MediaFromData(u, PostID, String.Empty)
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Video searching error")
|
||||
End Try
|
||||
End Function
|
||||
#Region "Picture options"
|
||||
Private Function GetPictureOption(ByVal w As EContainer) As String
|
||||
Try
|
||||
Dim ww As EContainer = w("sizes")
|
||||
If Not ww Is Nothing AndAlso ww.Count > 0 Then
|
||||
Dim l As New List(Of Sizes)
|
||||
Dim LargeContained As Boolean = ww.Contains("large")
|
||||
For Each v As EContainer In ww
|
||||
If v.Count > 0 AndAlso v.Contains("h") Then l.Add(New Sizes(v.Value("h"), v.Name))
|
||||
Next
|
||||
If l.Count > 0 Then
|
||||
l.Sort()
|
||||
If l(0).Name.IsEmptyString And LargeContained Then Return "large" Else Return l(0).Name
|
||||
End If
|
||||
End If
|
||||
Return String.Empty
|
||||
Catch ex As Exception
|
||||
LogError(ex, "[GetPictureOption]")
|
||||
Return String.Empty
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
#Region "Video options"
|
||||
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
|
||||
Return False
|
||||
Catch ex As Exception
|
||||
LogError(ex, "[CheckVideoNode]")
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
Private Shared Function GetVideoNodeURL(ByVal w As EContainer) As String
|
||||
Dim v As EContainer = w.GetNode(VideoNode)
|
||||
If Not v Is Nothing AndAlso v.Count > 0 Then
|
||||
Dim l As New List(Of Sizes)
|
||||
Dim u$
|
||||
Dim nn As EContainer
|
||||
For Each n As EContainer In v
|
||||
If n.Count > 0 Then
|
||||
For Each nn In n
|
||||
If nn("content_type").XmlIfNothingValue("none").Contains("mp4") AndAlso nn.Contains("url") Then
|
||||
u = nn.Value("url")
|
||||
l.Add(New Sizes(RegexReplace(u, VideoSizeRegEx), u))
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
If l.Count > 0 Then l.RemoveAll(Function(s) s.HasError)
|
||||
If l.Count > 0 Then l.Sort() : Return l(0).Name
|
||||
End If
|
||||
Return String.Empty
|
||||
End Function
|
||||
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
|
||||
End Sub
|
||||
#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
|
||||
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
|
||||
Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}}
|
||||
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
|
||||
If Not m.PictureOption.IsEmptyString And Not m.File.IsEmptyString And Not m.URL.IsEmptyString Then
|
||||
m.URL_BASE = $"{m.URL.Replace($".{m.File.Extension}", String.Empty)}?format={m.File.Extension}&name={m.PictureOption}"
|
||||
End If
|
||||
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing
|
||||
Return m
|
||||
End Function
|
||||
#End Region
|
||||
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
Try
|
||||
Dim i%
|
||||
Token.ThrowIfCancellationRequested()
|
||||
If _ContentNew.Count > 0 Then
|
||||
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
|
||||
If _ContentNew.Count > 0 Then
|
||||
MyFile.Exists(SFO.Path)
|
||||
Dim MyDir$ = MyFile.CutPath.Path
|
||||
Dim vsf As Boolean = SeparateVideoFolderF
|
||||
Dim f As SFile
|
||||
Dim v As UserMedia
|
||||
Using w As New WebClient
|
||||
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
|
||||
MainProgress.TotalCount += _ContentNew.Count
|
||||
For i = 0 To _ContentNew.Count - 1
|
||||
Token.ThrowIfCancellationRequested()
|
||||
v = _ContentNew(i)
|
||||
v.State = UStates.Tried
|
||||
If v.File.IsEmptyString Then
|
||||
f = v.URL
|
||||
Else
|
||||
f = v.File
|
||||
End If
|
||||
f.Separator = "\"
|
||||
f.Path = MyDir
|
||||
|
||||
If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL
|
||||
|
||||
If Not v.File.IsEmptyString AndAlso Not v.URL_BASE.IsEmptyString Then
|
||||
Try
|
||||
If f.Extension = "mp4" And vsf Then f.Path = $"{f.PathWithSeparator}Video"
|
||||
w.DownloadFile(v.URL_BASE, f.ToString)
|
||||
Select Case f.Extension
|
||||
Case "mp4" : v.Type = UserMedia.Types.Video : DownloadedVideos += 1 : _CountVideo += 1
|
||||
Case Else : v.Type = UserMedia.Types.Picture : DownloadedPictures += 1 : _CountPictures += 1
|
||||
End Select
|
||||
v.File = f
|
||||
v.State = UStates.Downloaded
|
||||
Catch wex As Exception
|
||||
ErrorDownloading(f, v.URL_BASE)
|
||||
End Try
|
||||
Else
|
||||
v.State = UStates.Skipped
|
||||
End If
|
||||
_ContentNew(i) = v
|
||||
MainProgress.Perform()
|
||||
Next
|
||||
End Using
|
||||
End If
|
||||
End If
|
||||
Catch oex As OperationCanceledException When Token.IsCancellationRequested
|
||||
Catch ex As Exception
|
||||
LogError(ex, "content downloading error")
|
||||
HasError = True
|
||||
End Try
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
471
SCrawler/API/UserDataBind.vb
Normal file
471
SCrawler/API/UserDataBind.vb
Normal file
@@ -0,0 +1,471 @@
|
||||
Imports PersonalUtilities.Tools
|
||||
Imports System.Threading
|
||||
Imports SCrawler.API.Base
|
||||
Namespace API
|
||||
Friend Class UserDataBind : Inherits UserDataBase : Implements ICollection(Of IUserData), IMyEnumerator(Of IUserData)
|
||||
Friend Event OnCollectionSelfRemoved()
|
||||
#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
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections(0).CollectionName
|
||||
Else
|
||||
Return _CollectionName
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal NewName As String)
|
||||
ChangeCollectionName(NewName, True)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
|
||||
_CollectionName = NewName
|
||||
If Count > 0 Then Collections.ForEach(Sub(c) c.CollectionName = NewName)
|
||||
End Sub
|
||||
Friend Overrides Property FriendlyName As String
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections(0).FriendlyName
|
||||
Else
|
||||
Return String.Empty
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal NewName As String)
|
||||
If Count > 0 Then Collections.ForEach(Sub(c)
|
||||
c.FriendlyName = NewName
|
||||
c.UpdateUserInformation()
|
||||
End Sub)
|
||||
End Set
|
||||
End Property
|
||||
#Region "Images"
|
||||
Friend Overrides Sub SetPicture(ByVal f As SFile)
|
||||
If Count > 0 Then Collections.ForEach(Sub(c) c.SetPicture(f))
|
||||
End Sub
|
||||
Friend Overrides Function GetUserPicture() As Image
|
||||
If Count > 0 Then
|
||||
Return Collections(0).GetPicture
|
||||
Else
|
||||
Return GetNullPicture(Settings.MaxLargeImageHeigh)
|
||||
End If
|
||||
End Function
|
||||
#End Region
|
||||
Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Select(Function(u) u.DownloadedTotal(Total)).Sum
|
||||
Else
|
||||
Return 0
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property Count As Integer Implements ICollection(Of IUserData).Count, IMyEnumerator(Of IUserData).MyEnumeratorCount
|
||||
Get
|
||||
If Collections Is Nothing Then
|
||||
Return 0
|
||||
Else
|
||||
Return Collections.Count
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend Overrides Property MyFile As SFile
|
||||
Get
|
||||
If Count > 0 Then Return Collections(0).File Else Return Nothing
|
||||
End Get
|
||||
Set(ByVal NewFile As SFile)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides Property FileExists As Boolean
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Exists(Function(c) c.FileExists)
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal IsExists As Boolean)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides Property DataMerging As Boolean
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return DirectCast(Collections(0), UserDataBase).DataMerging
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal IsMerged As Boolean)
|
||||
MergeData(IsMerged)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides Property HasError As Boolean
|
||||
Get
|
||||
Return MyBase.HasError Or (Count > 0 AndAlso Collections.Exists(Function(c) c.HasError))
|
||||
End Get
|
||||
Set(ByVal __HasError As Boolean)
|
||||
MyBase.HasError = __HasError
|
||||
If Count > 0 Then Collections.ForEach(Sub(c) c.HasError = False)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides Property Temporary As Boolean
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections(0).Temporary
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal Temp As Boolean)
|
||||
Collections.ForEach(Sub(c) c.Temporary = Temp)
|
||||
UpdateUserInformation()
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides Property Favorite As Boolean
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections(0).Favorite
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Get
|
||||
Set(ByVal Fav As Boolean)
|
||||
Collections.ForEach(Sub(c) c.Favorite = Fav)
|
||||
UpdateUserInformation()
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides ReadOnly Property Labels As List(Of String)
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return ListAddList(Nothing, Collections.SelectMany(Function(c) c.Labels), LAP.NotContainsOnly)
|
||||
Else
|
||||
Return New List(Of String)
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend Overrides Function GetUserInformation() As String
|
||||
Dim OutStr$ = String.Empty
|
||||
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, UserDataBase).LastUpdated.HasValue
|
||||
Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
|
||||
If .Count > 0 Then Return .Max
|
||||
End With
|
||||
End If
|
||||
Return Nothing
|
||||
End Get
|
||||
Set(ByVal NewDate As Date?)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides ReadOnly Property FitToAddParams As Boolean
|
||||
Get
|
||||
Return Count > 0 AndAlso Collections.Exists(Function(c) c.FitToAddParams)
|
||||
End Get
|
||||
End Property
|
||||
#Region "Context buttons"
|
||||
Friend ReadOnly Property ContextDown As ToolStripMenuItem()
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DOWN).ToArray
|
||||
Else
|
||||
Return New ToolStripMenuItem() {}
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property ContextEdit As ToolStripMenuItem()
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_EDIT).ToArray
|
||||
Else
|
||||
Return New ToolStripMenuItem() {}
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property ContextDelete As ToolStripMenuItem()
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DELETE).ToArray
|
||||
Else
|
||||
Return New ToolStripMenuItem() {}
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property ContextPath As ToolStripMenuItem()
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_PATH).ToArray
|
||||
Else
|
||||
Return New ToolStripMenuItem() {}
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend ReadOnly Property ContextSite As ToolStripMenuItem()
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_SITE).ToArray
|
||||
Else
|
||||
Return New ToolStripMenuItem() {}
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
#End Region
|
||||
#End Region
|
||||
Friend Sub New()
|
||||
_IsCollection = True
|
||||
Collections = New List(Of IUserData)
|
||||
'ImageHandler(Me, True)
|
||||
End Sub
|
||||
Friend Sub New(ByVal _Name As String)
|
||||
Me.New
|
||||
CollectionName = _Name
|
||||
End Sub
|
||||
Friend Overrides Sub LoadUserInformation()
|
||||
If Count > 0 Then Collections.ForEach(Sub(c) c.LoadUserInformation())
|
||||
End Sub
|
||||
Friend Overrides Sub UpdateUserInformation()
|
||||
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, UserDataBase).LoadContentInformation())
|
||||
End Sub
|
||||
Friend Overrides Property DownloadReparseOnly As Boolean
|
||||
Get
|
||||
If Count > 0 Then Return Collections(0).DownloadReparseOnly Else Return False
|
||||
End Get
|
||||
Set(ByVal DRO As Boolean)
|
||||
If Count > 0 Then Collections.ForEach(Sub(u) u.DownloadReparseOnly = DRO)
|
||||
End Set
|
||||
End Property
|
||||
Friend Overrides ReadOnly Property DataForReparseExists As Boolean
|
||||
Get
|
||||
If Count > 0 Then
|
||||
Return Collections.Exists(Function(u) u.DataForReparseExists)
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Get
|
||||
End Property
|
||||
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
|
||||
If Count > 0 Then Downloader.AddRange(Collections)
|
||||
End Sub
|
||||
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
|
||||
End Sub
|
||||
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
|
||||
End Sub
|
||||
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
|
||||
End Sub
|
||||
Private Sub User_OnPictureUpdated(ByVal User As IUserData)
|
||||
Raise_OnPictureUpdated()
|
||||
End Sub
|
||||
Friend Overrides Sub OpenSite()
|
||||
If Count > 0 Then Collections(0).OpenSite()
|
||||
End Sub
|
||||
Friend Overrides Sub OpenFolder()
|
||||
Try
|
||||
If Count > 0 Then Collections(0).File.CutPath(2).Open(SFO.Path, EDP.None)
|
||||
Catch ex As Exception
|
||||
End Try
|
||||
End Sub
|
||||
#Region "ICollection Support"
|
||||
Default Friend ReadOnly Property Item(ByVal Index As Integer) As IUserData Implements IMyEnumerator(Of IUserData).MyEnumeratorObject
|
||||
Get
|
||||
Return Collections(Index)
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of IUserData).IsReadOnly
|
||||
Get
|
||||
Return False
|
||||
End Get
|
||||
End Property
|
||||
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
|
||||
With _Item
|
||||
.Temporary = Temporary
|
||||
.Favorite = Favorite
|
||||
ImageHandler(_Item, False)
|
||||
AddHandler _Item.OnPictureUpdated, AddressOf User_OnPictureUpdated
|
||||
Dim m As Boolean = DataMerging
|
||||
If .MoveFiles(CollectionName, m) Then
|
||||
Collections.Add(_Item)
|
||||
DirectCast(_Item, UserDataBase).CreateButtons(Count - 1)
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
''' <summary>FOR SETTINGS START LOADING ONLY</summary>
|
||||
Friend Overloads Sub Add(ByVal u As UserInfo, Optional ByVal _LoadData As Boolean = True)
|
||||
Select Case u.Site
|
||||
Case Sites.Reddit : Collections.Add(New Reddit.UserData(u, _LoadData))
|
||||
Case Sites.Twitter : Collections.Add(New Twitter.UserData(u, _LoadData))
|
||||
Case Else : Exit Sub
|
||||
End Select
|
||||
With DirectCast(Collections(Count - 1), UserDataBase)
|
||||
.CreateButtons(Count - 1)
|
||||
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf BTT_CONTEXT_DELETE_Click
|
||||
End With
|
||||
AddHandler Collections(Count - 1).OnPictureUpdated, AddressOf User_OnPictureUpdated
|
||||
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, ByVal _MergeData As Boolean) As Boolean
|
||||
Throw New NotImplementedException("Files moving does not available if collection context")
|
||||
End Function
|
||||
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
|
||||
If Count > 0 Then
|
||||
If Merging Then
|
||||
If DataMerging Then
|
||||
MsgBoxE($"Collection [{CollectionName}] data already merged")
|
||||
Else
|
||||
If Collections.Count > 1 Then
|
||||
Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).MergeData())
|
||||
MsgBoxE($"Collection [{CollectionName}] data merged")
|
||||
Else
|
||||
MsgBoxE($"Collection [{CollectionName}] contains only one user profile" & vbCr &
|
||||
"Data merging available from two and more profiles in collection!", MsgBoxStyle.Exclamation)
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If DataMerging Then
|
||||
MsgBoxE($"Collection [{CollectionName}] data is already merged" & vbCr &
|
||||
"Combined data can not be undone", MsgBoxStyle.Critical)
|
||||
Else
|
||||
MsgBoxE($"Collection [{CollectionName}] data was never merged")
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Friend Sub Clear() Implements ICollection(Of IUserData).Clear
|
||||
Collections.ListClearDispose
|
||||
End Sub
|
||||
Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains
|
||||
Return Collections.Contains(_Item)
|
||||
End Function
|
||||
Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo
|
||||
Throw New NotImplementedException("[CopyTo] method does not supported in collections context")
|
||||
End Sub
|
||||
Friend Function Remove(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Remove
|
||||
If DataMerging Then
|
||||
MsgBoxE($"Collection [{CollectionName}] data is already merged" & vbCr &
|
||||
"Combined data can not be undone" & vbCr &
|
||||
"Operation canceled", MsgBoxStyle.Critical)
|
||||
Return False
|
||||
Else
|
||||
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty, False)
|
||||
ImageHandler(_Item)
|
||||
Return Collections.Remove(_Item)
|
||||
End If
|
||||
End Function
|
||||
Friend Overrides Function Delete() As Integer
|
||||
If Count > 0 Then
|
||||
If MsgBoxE({$"Collection may contain data{vbCr}Do you really want to delete collection and all of it files?", "Collection deleting"},
|
||||
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
|
||||
Settings.Users.Remove(Me)
|
||||
Collections.ForEach(Sub(c) c.Delete())
|
||||
Downloader.UserRemove(Me)
|
||||
ImageHandler(Me, False)
|
||||
Collections.ListClearDispose
|
||||
Dispose(False)
|
||||
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"},
|
||||
MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
|
||||
Dim f As SFile = Collections(0).File.CutPath(2)
|
||||
Settings.Users.Remove(Me)
|
||||
Collections.ForEach(Sub(c)
|
||||
c.MoveFiles(String.Empty, False)
|
||||
ImageHandler(c)
|
||||
End Sub)
|
||||
Collections.Clear()
|
||||
f.Delete(SFO.Path,,, EDP.SendInLog)
|
||||
Downloader.UserRemove(Me)
|
||||
ImageHandler(Me, False)
|
||||
Dispose(False)
|
||||
Return 3
|
||||
Else
|
||||
MsgBoxE("Operation canceled")
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Return 0
|
||||
End Function
|
||||
Private Sub BTT_CONTEXT_DELETE_Click(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
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
#Region "IEnumerable Support"
|
||||
Private Function GetEnumerator() As IEnumerator(Of IUserData) Implements IEnumerable(Of IUserData).GetEnumerator
|
||||
Return New MyEnumerator(Of IUserData)(Me)
|
||||
End Function
|
||||
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
|
||||
Return GetEnumerator()
|
||||
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
|
||||
Else
|
||||
Return Count > 0 AndAlso Collections.Exists(Function(u) u.Equals(Other))
|
||||
End If
|
||||
End Function
|
||||
#Region "IDisposable Support"
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
If Not disposedValue Then
|
||||
If disposing Then Collections.ListClearDispose
|
||||
End If
|
||||
MyBase.Dispose(disposing)
|
||||
End Sub
|
||||
#End Region
|
||||
End Class
|
||||
End Namespace
|
||||
Reference in New Issue
Block a user