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

2.0.0.2

Browse Source 
Site settings have been expanded, some functions and dependencies have been changed.
Removed unused elements in UserDataBase, added additional xml fields, added error executor.
Created a basic download function.
Added Instagram saved posts and 429 bypass.
Added channel statistics.
Added site redgifs.
Updated sites algorithms.
Other improvements.
Updated downloader algorithm.
This commit is contained in:
Andy
2022-01-23 05:34:09 +03:00
parent 7da1ccf1ae
commit f1ba2ecd77
56 changed files with 5056 additions and 1293 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -25,7 +25,9 @@ Namespace API.Base
_Path.Value = NewFile
End Set
End Property
#Region "Instagram"
Friend ReadOnly Property InstaHash As XMLValue(Of String)
Friend ReadOnly Property InstaHash_SP As XMLValue(Of String)
Friend ReadOnly Property InstaHashUpdateRequired As XMLValue(Of Boolean)
Friend ReadOnly Property InstagramDownloadingErrorDate As XMLValue(Of Date)
Friend Property InstagramLastApplyingValue As Integer? = Nothing
@@ -40,7 +42,18 @@ Namespace API.Base
End With
End Get
End Property
Friend Property InstagramTooManyRequestsReadyForCatch As Boolean = True
Friend ReadOnly Property InstagramLastDownloadDate As XMLValue(Of Date)
Friend ReadOnly Property InstagramLastRequestsCount As XMLValue(Of Integer)
Private InstagramTooManyRequestsReadyForCatch As Boolean = True
Friend Function GetInstaWaitDate() As Date
With InstagramDownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(InstagramLastApplyingValue, 10))
Else
Return Now
End If
End With
End Function
Friend Sub InstagramTooManyRequests(ByVal Catched As Boolean)
With InstagramDownloadingErrorDate
If Catched Then
@@ -55,9 +68,14 @@ Namespace API.Base
Else
.ValueF = Nothing
InstagramLastApplyingValue = Nothing
InstagramTooManyRequestsReadyForCatch = True
End If
End With
End Sub
Friend ReadOnly Property RequestsWaitTimer As XMLValue(Of Integer)
Friend ReadOnly Property RequestsWaitTimerTaskCount As XMLValue(Of Integer)
Friend ReadOnly Property SleepTimerOnPostsLimit As XMLValue(Of Integer)
#End Region
Friend ReadOnly Property Temporary As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadImages As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadVideos As XMLValue(Of Boolean)
@@ -98,6 +116,7 @@ Namespace API.Base
Responser.CookiesDomain = "reddit.com"
Responser.Decoders.Add(SymbolsConverter.Converters.Unicode)
Case Sites.Instagram : Responser.CookiesDomain = "instagram.com"
Case Sites.RedGifs : Responser.CookiesDomain = "redgifs.com"
End Select
Responser.SaveSettings()
End If
@@ -126,20 +145,30 @@ Namespace API.Base
GetUserMediaOnly = New XMLValue(Of Boolean)
End If
CreateProp(InstaHashUpdateRequired, Sites.Instagram, "InstaHashUpdateRequired", True, _XML, n)
CreateProp(InstaHash, Sites.Instagram, "InstaHash", String.Empty, _XML, n)
If Site = Sites.Instagram AndAlso (InstaHash.IsEmptyString Or InstaHashUpdateRequired) AndAlso Responser.Cookies.ListExists Then GatherInstaHash()
CreateProp(InstaHash_SP, Sites.Instagram, "InstaHashSavedPosts", String.Empty, _XML, n)
CreateProp(InstagramLastDownloadDate, Sites.Instagram, "LastDownloadDate", Now.AddDays(-1), _XML, n)
CreateProp(InstagramLastRequestsCount, Sites.Instagram, "LastRequestsCount", 0, _XML, n)
CreateProp(RequestsWaitTimer, Sites.Instagram, "RequestsWaitTimer", 1000, _XML, n)
CreateProp(RequestsWaitTimerTaskCount, Sites.Instagram, "RequestsWaitTimerTaskCount", 1, _XML, n)
CreateProp(SleepTimerOnPostsLimit, Sites.Instagram, "SleepTimerOnPostsLimit", 60000, _XML, n)
If Site = Sites.Instagram Then
InstaHash = New XMLValue(Of String)("InstaHash", String.Empty, _XML, n)
InstaHashUpdateRequired = New XMLValue(Of Boolean)("InstaHashUpdateRequired", True, _XML, n)
If (InstaHash.IsEmptyString Or InstaHashUpdateRequired) And Responser.Cookies.ListExists Then GatherInstaHash()
InstagramDownloadingErrorDate = New XMLValue(Of Date) With {.ToStringFunction = Function(ss, vv) AConvert(Of String)(vv, Nothing)}
InstagramDownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n)
Else
InstaHash = New XMLValue(Of String)
InstaHashUpdateRequired = New XMLValue(Of Boolean)
InstagramDownloadingErrorDate = New XMLValue(Of Date)
End If
If Site = Sites.Reddit Then
SavedPostsUserName = New XMLValue(Of String)("SavedPostsUserName", String.Empty, _XML, n)
SavedPostsUserName = New XMLValue(Of String)("SavedPostsUserName", String.Empty, _XML, n)
End Sub
Private Sub CreateProp(Of T)(ByRef p As XMLValue(Of T), ByVal s As Sites,
ByVal p_Name As String, ByVal p_Value As T, ByRef x As XmlFile, ByVal n() As String)
If Site = s Then
p = New XMLValue(Of T)(p_Name, p_Value, x, n)
Else
SavedPostsUserName = New XMLValue(Of String)
p = New XMLValue(Of T)
End If
End Sub
Friend Sub Update()

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

@@ -85,5 +85,21 @@ Namespace API.Base
Return v
End Function
End Structure
Friend Structure Sizes : Implements IComparable(Of Sizes)
Friend Value As Integer
Friend Data As String
Friend ReadOnly HasError As Boolean
Friend Sub New(ByVal _Value As String, ByVal _Data As String)
Try
Value = _Value
Data = _Data
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
End Structure
End Module
End Namespace

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

@@ -7,9 +7,12 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Forms.Toolbars
Imports System.IO
Imports System.Net
Imports System.Threading
Imports UState = SCrawler.API.Base.UserMedia.States
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Base
Friend MustInherit Class UserDataBase : Implements IUserData
Friend Const UserFileAppender As String = "User"
@@ -77,10 +80,17 @@ Namespace API.Base
#End Region
#Region "Declarations"
Friend MustOverride Property Site As Sites Implements IContentProvider.Site
Protected _Progress As MyProgress
Friend Overridable 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
Friend User As UserInfo
Friend Property IsSavedPosts As Boolean
Protected Const NonExistendUserHelp As String = "404"
Protected Const SuspendedUserHelp As String = "403"
Friend Overridable Property UserExists As Boolean = True Implements IUserData.Exists
Friend Overridable Property UserSuspended As Boolean = False Implements IUserData.Suspended
Friend Overridable Property Name As String Implements IContentProvider.Name
@@ -288,7 +298,7 @@ BlockNullPicture:
#End Region
#Region "Information"
Protected _CountVideo As Integer = 0
Protected _CountPictures As Integer = 0
Protected Property _CountPictures As Integer = 0
Friend Overridable Property LastUpdated As Date?
Friend ReadOnly Property TotalContentCount As Integer
Get
@@ -339,7 +349,7 @@ BlockNullPicture:
Friend ReadOnly Property LVIKey As String Implements IUserData.LVIKey
Get
If Not _IsCollection Then
Return $"{Interaction.Switch(Site = Sites.Reddit, "R", Site = Sites.Twitter, "T", Site = Sites.Instagram, "I")}_{Name}"
Return $"{Site.ToString.ToUpper.Substring(0, 1)}_{Name}"
Else
Return $"CCCC_{CollectionName}"
End If
@@ -436,6 +446,7 @@ BlockNullPicture:
End If
Case Sites.Twitter : Return New Twitter.UserData(u, _LoadUserInformation)
Case Sites.Instagram : Return New Instagram.UserData(u, _LoadUserInformation)
Case Sites.RedGifs : Return New RedGifs.UserData(u, _LoadUserInformation)
Case Else : Throw New ArgumentOutOfRangeException("Site", $"Site [{u.Site}] information does not recognized by loader")
End Select
End Function
@@ -469,6 +480,7 @@ BlockNullPicture:
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)
LoadUserInformation_OptionalFields(x, True)
End Using
UpdateDataFiles()
End If
@@ -506,6 +518,8 @@ BlockNullPicture:
x.Add(Name_LabelsName, Labels.ListToString(, "|", EDP.ReturnValue))
x.Add(Name_DataMerging, DataMerging.BoolToInteger)
LoadUserInformation_OptionalFields(x, False)
x.Save(MyFile)
End Using
If Not IsSavedPosts Then Settings.UpdateUsersList(User)
@@ -513,16 +527,15 @@ BlockNullPicture:
LogError(ex, "user information saving error")
End Try
End Sub
''' <param name="Loading"><see langword="True"/>: Loading; <see langword="False"/>: Saving</param>
Protected MustOverride Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
#End Region
#Region "User data"
Friend Overridable Overloads Sub LoadContentInformation()
UpdateDataFiles()
LoadContentInformation(_ContentList, MyFileData)
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, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
UpdateDataFiles()
If Not MyFileData.Exists Then Exit Sub
Using x As New XmlFile(MyFileData, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData()
If x.Count > 0 Then
Dim fs$ = MyFile.CutPath.PathWithSeparator
@@ -538,7 +551,7 @@ BlockNullPicture:
End If
End Function
For Each v As EContainer In x
_CLIST.Add(New UserMedia With {
_ContentList.Add(New UserMedia With {
.Type = AConvert(Of Integer)(v.Attribute(Name_MediaType).Value, 0),
.URL = v.Attribute(Name_MediaURL).Value,
.URL_BASE = v.Value,
@@ -556,14 +569,14 @@ BlockNullPicture:
LogError(ex, "history loading error")
End Try
End Sub
Friend Sub UpdateContentInformation(ByRef _CLIST As List(Of UserMedia), ByVal f As SFile)
Friend Sub UpdateContentInformation()
Try
UpdateDataFiles()
If f.IsEmptyString Then Exit Sub
f.Exists(SFO.Path)
If MyFileData.IsEmptyString Then Exit Sub
MyFileData.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
If _ContentList.Count > 0 Then
For Each i As UserMedia In _ContentList
x.Add(New EContainer("MediaData", i.URL_BASE,
{New EAttribute(Name_MediaType, CInt(i.Type)),
New EAttribute(Name_MediaURL, i.URL),
@@ -631,9 +644,9 @@ BlockNullPicture:
ThrowAny(Token)
If _TempMediaList.Count > 0 Then
If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UserMedia.Types.GIF Or m.Type = UserMedia.Types.Picture)
If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UserMedia.Types.Video Or
m.Type = UserMedia.Types.VideoPre Or m.Type = UserMedia.Types.m3u8)
If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.GIF Or m.Type = UTypes.Picture)
If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.Video Or
m.Type = UTypes.VideoPre Or m.Type = UTypes.m3u8)
End If
ReparseVideo(Token)
@@ -642,14 +655,14 @@ BlockNullPicture:
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
DownloadContent(Token)
ThrowIfDisposed()
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UState.Downloaded), LNC)
_CountPictures = _ContentList.LongCount(Function(c) c.Type = UserMedia.Types.Picture)
_CountVideo = _ContentList.LongCount(Function(c) c.Type = UserMedia.Types.Video)
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UStates.Downloaded), LNC)
_CountPictures = _ContentList.LongCount(Function(c) c.Type = UTypes.Picture)
_CountVideo = _ContentList.LongCount(Function(c) c.Type = UTypes.Video)
If DownloadedPictures + DownloadedVideos > 0 Or EnvirChanged.Invoke Then
If __SaveData Then
LastUpdated = Now
If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser)
UpdateContentInformation(_ContentList, MyFileData)
UpdateContentInformation()
Else
_CountVideo = 0
_CountPictures = 0
@@ -660,8 +673,10 @@ BlockNullPicture:
UpdateUserInformation()
End If
ThrowIfDisposed()
_DownloadedPicturesTotal += _DownloadedPicturesSession
_DownloadedVideosTotal += _DownloadedVideosSession
If Not CreatedByChannel Then
_DownloadedPicturesTotal += _DownloadedPicturesSession
_DownloadedVideosTotal += _DownloadedVideosSession
End If
If UpPic Or EnvirChanged.Invoke Then Raise_OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested
MyMainLOG = $"{Site} - {Name}: downloading canceled"
@@ -692,6 +707,99 @@ BlockNullPicture:
Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken)
Protected MustOverride Sub ReparseVideo(ByVal Token As CancellationToken)
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try
Dim i%
Dim dCount% = 0, dTotal% = 0
ThrowAny(Token)
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.PathNoSeparator
Dim vsf As Boolean = SeparateVideoFolderF
Dim __isVideo As Boolean
Dim f As SFile
Dim v As UserMedia
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
ThrowAny(Token)
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 And Not v.URL_BASE.IsEmptyString Then
Try
__isVideo = v.Type = UTypes.Video Or f.Extension = "mp4"
If f.Extension.IsEmptyString Then
Select Case v.Type
Case UTypes.Picture : f.Extension = "jpg"
Case UTypes.Video : f.Extension = "mp4"
Case UTypes.GIF : f.Extension = "gif"
End Select
End If
If __isVideo And vsf Then f.Path = $"{f.PathWithSeparator}Video"
w.DownloadFile(v.URL_BASE, f.ToString)
If __isVideo Then
v.Type = UTypes.Video
DownloadedVideos += 1
_CountVideo += 1
Else
v.Type = UTypes.Picture
DownloadedPictures += 1
_CountPictures += 1
End If
v.File = ChangeFileNameByProvider(f, v)
v.State = UStates.Downloaded
dCount += 1
Catch wex As Exception
ErrorDownloading(f, v.URL_BASE)
End Try
Else
v.State = UStates.Skipped
End If
_ContentNew(i) = v
If DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value Then
Progress.Perform(_ContentNew.Count - dTotal)
Exit Sub
Else
dTotal += 1
Progress.Perform()
End If
Next
End Using
End If
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "content downloading error")
HasError = True
End Try
End Sub
''' <param name="RDE">Request DownloadingException</param>
Protected Sub ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String, Optional ByVal RDE As Boolean = True)
If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE AndAlso DownloadingException(ex, Message, True) = 0 Then LogError(ex, Message) : HasError = True
End If
End Sub
''' <summary>0 - Execute LogError and set HasError</summary>
Protected MustOverride Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
Protected Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
Dim ff As SFile = Nothing
Try
@@ -1020,7 +1128,7 @@ BlockNullPicture:
''' 0 - Nothing removed<br/>
''' 1 - User removed<br/>
''' 2 - Collection removed<br/>
''' 3 - Collection splitted
''' 3 - Collection split
''' </summary>
Function Delete() As Integer
Function MoveFiles(ByVal CollectionName As String) As Boolean

22
SCrawler/API/Imgur/Envir.vb
View File

@@ -46,8 +46,7 @@ Namespace API.Imgur
End If
Return Nothing
Catch ex As Exception
If Not e.Exists Then e = New ErrorsDescriber(EDP.ReturnValue + EDP.SendInLog)
Return ErrorsDescriber.Execute(e, ex, $"[API.Imgur.Envir.GetGallery({URL})]", Nothing)
Return DownloadingException(ex, $"[API.Imgur.Envir.GetGallery({URL})]", Nothing, e)
End Try
End Function
Friend Shared Function GetImage(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As String
@@ -64,8 +63,7 @@ Namespace API.Imgur
End If
Return String.Empty
Catch ex As Exception
If Not e.Exists Then e = New ErrorsDescriber(EDP.ReturnValue + EDP.SendInLog)
Return ErrorsDescriber.Execute(e, ex, $"[API.Imgur.Envir.GetImage({URL})]", String.Empty)
Return DownloadingException(ex, $"[API.Imgur.Envir.GetImage({URL})]", String.Empty, e)
End Try
End Function
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
@@ -83,5 +81,21 @@ Namespace API.Imgur
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Imgur standalone downloader: fetch media error")
End Try
End Function
Private Shared Function DownloadingException(ByVal ex As Exception, ByVal Message As String,
ByVal NullArg As Object, ByVal e As ErrorsDescriber) As Object
If TypeOf ex Is WebException Then
Dim obj As HttpWebResponse = TryCast(DirectCast(ex, WebException).Response, HttpWebResponse)
If Not obj Is Nothing Then
If obj.StatusCode = HttpStatusCode.NotFound Then
Return NullArg
ElseIf obj.StatusCode = HttpStatusCode.Unauthorized Then
MyMainLOG = "Imgur credentials expired"
Return NullArg
End If
End If
End If
If Not e.Exists Then e = New ErrorsDescriber(EDP.ReturnValue + EDP.SendInLog)
Return ErrorsDescriber.Execute(e, ex, Message, NullArg)
End Function
End Class
End Namespace

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

@@ -8,7 +8,7 @@
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
Friend Module Declarations
Friend ReadOnly FilesPattern As New RegexStructure("[^\./]+?\.\w+", True, False, 2,,,, String.Empty, EDP.ReturnValue)
Friend ReadOnly FilesPattern As New RegexStructure(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))",,,, 1,,, String.Empty, EDP.ReturnValue)
Friend ReadOnly Property DateProvider As New JsonDate
Friend Class JsonDate : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,

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

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

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

@@ -7,103 +7,275 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.Base
Imports System.Threading
Imports System.Net
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase
Private Const MaxPostsCount As Integer = 200
Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Friend Overrides Property Site As Sites = Sites.Instagram
Friend Overrides Property Progress As MyProgress
Get
If Not _Progress Is Nothing Then Return _Progress Else Return MainProgressInst
End Get
Set(ByVal p As MyProgress)
_Progress = p
End Set
End Property
Private ReadOnly _SavedPostsIDs As New List(Of String)
Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = True
''' <summary>Video downloader initializer</summary>
Private Sub New()
End Sub
''' <summary>Default initializer</summary>
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True, Optional ByVal InvokeImageHandler As Boolean = True)
MyBase.New(InvokeImageHandler)
User = u
If _LoadUserInformation Then LoadUserInformation()
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
LastCursor = Container.Value(Name_LastCursor)
FirstLoadingDone = Container.Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
Else
Container.Add(Name_LastCursor, LastCursor)
Container.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
End If
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
DownloadData(String.Empty, Token)
Try
_InstaHash = String.Empty
HasError = False
If Not LastCursor.IsEmptyString Then
DownloadData(LastCursor, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If Not HasError Then
DownloadData(String.Empty, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then DownloadPosts(Token)
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch ex As Exception
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF", False)
End Try
End Sub
Private _InstaHash As String = String.Empty
#Region "429 bypass"
Friend RequestsCount As Integer = 0
Friend Enum WNM As Integer
Notify = 0
SkipCurrent = 1
SkipAll = 2
SkipTemp = 3
End Enum
Friend WaitNotificationMode As WNM = WNM.Notify
Private Caught429 As Boolean = False
Private ProgressTempSet As Boolean = False
Private Const InstAborted As String = "InstAborted"
Private Function Ready() As Boolean
With Settings(Sites.Instagram)
If Not .InstagramReadyForDownload Then
If WaitNotificationMode = WNM.Notify Then
Dim m As New MMessage("Instagram [too many requests] error." & vbCr &
$"The program suggests waiting {If(Settings(Sites.Instagram).InstagramLastApplyingValue, 0)} minutes." & vbCr &
"What do you want to do?", "Waiting for Instagram download...",
{
New MsgBoxButton("Wait") With {.ToolTip = "Wait and ask again when the error is found."},
New MsgBoxButton("Wait (disable current") With {.ToolTip = "Wait and skip future prompts while downloading the current profile."},
New MsgBoxButton("Abort") With {.ToolTip = "Abort operation"},
New MsgBoxButton("Wait (disable all)") With {.ToolTip = "Wait and skip future prompts while downloading the current session."}
},
vbExclamation) With {.ButtonsPerRow = 2, .DefaultButton = 0, .CancelButton = 2}
Select Case MsgBoxE(m).Index
Case 1 : WaitNotificationMode = WNM.SkipCurrent
Case 2 : Throw New OperationCanceledException("Instagram download operation aborted") With {.HelpLink = InstAborted}
Case 3 : WaitNotificationMode = WNM.SkipAll
Case Else : WaitNotificationMode = WNM.SkipTemp
End Select
End If
If Not ProgressTempSet Then Progress.InformationTemporary = $"Waiting until {Settings(Sites.Instagram).GetInstaWaitDate().ToString(ParsersDataDateProvider)}"
ProgressTempSet = True
Return False
Else
Return True
End If
End With
End Function
Private Sub ReconfigureAwaiter()
If WaitNotificationMode = WNM.SkipTemp Then WaitNotificationMode = WNM.Notify
If Caught429 Then Caught429 = False : RequestsCount = 0
ProgressTempSet = False
End Sub
Private Sub NextRequest(ByVal StartWait As Boolean)
With Settings(Sites.Instagram)
If StartWait And (RequestsCount Mod .RequestsWaitTimerTaskCount.Value) = 0 Then Thread.Sleep(.RequestsWaitTimer)
If RequestsCount >= MaxPostsCount - 5 Then Thread.Sleep(.SleepTimerOnPostsLimit)
End With
End Sub
#End Region
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim _DownloadComplete As Boolean = False
LastCursor = Cursor
Try
Dim n As EContainer, nn As EContainer, node As EContainer
Dim HasNextPage As Boolean = False
Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty
Do While Not _DownloadComplete
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _InstaHash = Settings(Sites.Instagram).InstaHash
If _InstaHash.IsEmptyString Then Throw New ArgumentNullException("InstHash", "Query hash is null")
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
Try
Dim n As EContainer, nn As EContainer, node As EContainer
Dim HasNextPage As Boolean = False
Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty
'Create query
Dim vars$ = "{""id"":" & ID & ",""first"":12,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={_InstaHash}&variables={vars}"
NextRequest(True)
'Get response
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Settings(Sites.Instagram).InstagramTooManyRequests(False)
ThrowAny(Token)
'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _
_InstaHash = If(IsSavedPosts, Settings(Sites.Instagram).InstaHash_SP, Settings(Sites.Instagram).InstaHash).Value
If _InstaHash.IsEmptyString Then Throw New ArgumentNullException(IIf(IsSavedPosts, "InstaHashSavedPosts", "InstaHash"), "Query hash is null")
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
'Data
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
n = j.ItemF({"data", "user", 0}).XmlIfNothing
If n.Count > 0 Then
If n.Contains("page_info") Then
With n("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
End If
n = n("edges").XmlIfNothing
If n.Count > 0 Then
For Each nn In n
ThrowAny(Token)
node = nn(0).XmlIfNothing
'Create query
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={_InstaHash}&variables={vars}"
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Exit Sub
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
'Get response
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Settings(Sites.Instagram).InstagramTooManyRequests(False)
RequestsCount += 1
ThrowAny(Token)
ObtainMedia(node, PostID, PostDate)
Next
End If
'Data
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
n = j.ItemF({"data", "user", 0}).XmlIfNothing
If n.Count > 0 Then
If n.Contains("page_info") Then
With n("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
End If
n = n("edges").XmlIfNothing
If n.Count > 0 Then
For Each nn In n
ThrowAny(Token)
node = nn(0).XmlIfNothing
If IsSavedPosts Then
PostID = node.Value("shortcode")
If Not PostID.IsEmptyString Then
If _TempPostsList.Contains(PostID) Then Exit Sub Else _SavedPostsIDs.Add(PostID)
End If
Else
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Exit Sub
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
ObtainMedia(node, PostID, PostDate)
End If
Next
End If
Else
If j.Value("status") = "ok" AndAlso j({"data", "user"}).XmlIfNothing.Count = 0 AndAlso _TempMediaList.Count = 0 Then
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
UserExists = False
_DownloadComplete = True
Exit Sub
End If
End If
End Using
Else
If j.Value("status") = "ok" AndAlso j({"data", "user"}).XmlIfNothing.Count = 0 AndAlso _TempMediaList.Count = 0 Then
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
UserExists = False
Exit Sub
End If
_DownloadComplete = True
Exit Sub
End If
End Using
End If
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Token)
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
MyMainLOG = "Instagram credentials have expired"
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
ElseIf Responser.StatusCode = 429 Then
Settings(Sites.Instagram).InstagramTooManyRequests(True)
Else
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
LogError(ex, $"data downloading error [{URL}]")
End If
HasError = True
Finally
_InstaHash = String.Empty
_DownloadComplete = True
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Token)
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
Catch ex As Exception
If DownloadingException(ex, $"data downloading error [{URL}]") = 1 Then Continue Do Else Exit Do
End Try
Loop
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception
ProcessException(DoEx, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Sub DownloadPosts(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim _DownloadComplete As Boolean = False
Dim _Index% = 0
Try
Do While Not _DownloadComplete
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
Try
Dim r$
Dim j As EContainer, jj As EContainer
Dim _MediaObtained As Boolean
If _SavedPostsIDs.Count > 0 And _Index <= _SavedPostsIDs.Count - 1 Then
Dim e As New ErrorsDescriber(EDP.ThrowException)
For i% = _Index To _SavedPostsIDs.Count - 1
_Index = i
URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1"
ThrowAny(Token)
NextRequest((i + 1 Mod 5) = 0)
ThrowAny(Token)
r = Responser.GetResponse(URL,, e)
Settings(Sites.Instagram).InstagramTooManyRequests(False)
RequestsCount += 1
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
_MediaObtained = False
If j.Contains({"graphql", "shortcode_media"}) Then
With j({"graphql", "shortcode_media"}).XmlIfNothing
If .Count > 0 Then ObtainMedia(.Self, _SavedPostsIDs(i), String.Empty) : _MediaObtained = True
End With
End If
If Not _MediaObtained AndAlso j.Contains("items") Then
With j("items")
If .Count > 0 Then
For Each jj In .Self : ObtainMedia2(jj, _SavedPostsIDs(i)) : Next
End If
End With
End If
j.Dispose()
End If
End If
Next
_DownloadComplete = True
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
Catch ex As Exception
If DownloadingException(ex, $"downloading saved posts error [{URL}]") = 1 Then Continue Do Else Exit Do
End Try
Loop
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception
ProcessException(DoEx, Token, $"downloading saved posts error [{URL}]")
End Try
End Sub
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String)
@@ -124,6 +296,66 @@ Namespace API.Instagram
CreateMedia(node)
End If
End Sub
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String)
Try
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
If n.Count > 0 Then
Dim l As New List(Of Sizes)
Dim d As EContainer
Dim t%
'8 - gallery
'2 - one video
'1 - one picture
t = n.Value("media_type").FromXML(Of Integer)(-1)
If t >= 0 Then
Select Case t
Case 1
If n.Contains(img) Then
t = n.Value("media_type").FromXML(Of Integer)(-1)
If t >= 0 Then
With n.ItemF({img, "candidates"}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, Nothing), LNC)
l.Clear()
End If
End If
End With
End If
End If
Case 2
If n.Contains(vid) Then
With n.ItemF({vid}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, Nothing), LNC)
l.Clear()
End If
End If
End With
End If
Case 8
With n("carousel_media").XmlIfNothing
If .Count > 0 Then
For Each d In .Self : ObtainMedia2(d, PostID) : Next
End If
End With
End Select
End If
l.Clear()
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "API.Instagram.GetGallery")
End Try
End Sub
Private Sub GetUserId()
Try
Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, EDP.ThrowException)
@@ -136,106 +368,71 @@ Namespace API.Instagram
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Throw ex
Else
LogError(ex, "get instagram user id")
LogError(ex, "get Instagram user id")
End If
End Try
End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Try
Dim i%
Dim dCount% = 0, dTotal% = 0
ThrowAny(Token)
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.PathNoSeparator
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
ThrowAny(Token)
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 v.Type = UTypes.Video And vsf Then f.Path = $"{f.PathWithSeparator}Video"
w.DownloadFile(v.URL_BASE, f.ToString)
Select Case v.Type
Case UTypes.Video : DownloadedVideos += 1 : _CountVideo += 1
Case UTypes.Picture : DownloadedPictures += 1 : _CountPictures += 1
End Select
v.File = ChangeFileNameByProvider(f, v)
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
If DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value Then
MainProgress.Perform(_ContentNew.Count - dTotal)
Exit Sub
Else
dTotal += 1
MainProgress.Perform()
End If
Next
End Using
End If
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "content downloading error")
HasError = True
End Try
DownloadContentDefault(Token)
End Sub
''' <summary>
''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String)"/><br/>
''' 1 - continue
''' </summary>
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
HasError = True
MyMainLOG = "Instagram credentials have expired"
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
ElseIf Responser.StatusCode = 429 Then
With Settings(Sites.Instagram)
Dim WaiterExists As Boolean = .InstagramLastApplyingValue.HasValue
.InstagramTooManyRequests(True)
If Not WaiterExists Then .InstagramLastApplyingValue = 2
End With
Caught429 = True
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
Else
Settings(Sites.Instagram).InstaHashUpdateRequired.Value = True
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
Return 2
End Function
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateProvider, Nothing) Else m.Post.Date = Nothing
Return m
End Function
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.Contains("instagram.com") Then
Do While Right(URL, 1) = "/" : URL = Left(URL, URL.Length - 1) : Loop
URL = $"{URL}/?__a=1"
Using t As New UserData
t.Responser = New PersonalUtilities.Tools.WEB.Response
t.Responser.Copy(Settings(Sites.Instagram).Responser)
Dim r$ = t.Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
Dim node As EContainer = j({"graphql", "shortcode_media"}).XmlIfNothing
If node.Count > 0 Then t.ObtainMedia(node, String.Empty, String.Empty)
End Using
End If
If t._TempMediaList.Count > 0 Then Return ListAddList(Nothing, t._TempMediaList)
End Using
Dim PID$ = RegexReplace(URL, New RegexStructure(".*?instagram.com/p/([_\w\d]+)", 1))
If Not PID.IsEmptyString Then
Using t As New UserData
t.Responser = New PersonalUtilities.Tools.WEB.Response
t.Responser.Copy(Settings(Sites.Instagram).Responser)
t._SavedPostsIDs.Add(PID)
t.DownloadPosts(Nothing)
Return ListAddList(Nothing, t._TempMediaList)
End Using
End If
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Instagram standalone downloader: fetch media error")
End Try
End Function
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _SavedPostsIDs.Clear()
MyBase.Dispose(disposing)
End Sub
End Class
End Namespace

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

@@ -19,6 +19,8 @@ Namespace API.Reddit
Private Const Name_ID As String = "ID"
Private Const Name_Date As String = "Date"
Private Const Name_PostsNode As String = "Posts"
Private Const Name_UsersAdded As String = "UsersAdded"
Private Const Name_PostsDownloaded As String = "PostsDownloaded"
#End Region
Friend Const DefaultDownloadLimitCount As Integer = 1000
#Region "IUserData Support"
@@ -311,6 +313,31 @@ Namespace API.Reddit
End Get
End Property
Private ReadOnly Property Range As RangeSwitcher(Of UserPost)
Friend ReadOnly Property CountOfAddedUsers As List(Of Integer)
Friend ReadOnly Property CountOfLoadedPostsPerSession As List(Of Integer)
Private _FirstUserAdded As Boolean = False
Friend Sub UserAdded(Optional ByVal IsAdded As Boolean = True)
If Not _FirstUserAdded Then CountOfAddedUsers.Add(0) : _FirstUserAdded = True
Dim v% = CountOfAddedUsers.Last
v += IIf(IsAdded, 1, -1)
If v < 0 Then v = 0
CountOfAddedUsers(CountOfAddedUsers.Count - 1) = v
End Sub
Friend Function GetChannelStats(ByVal Extended As Boolean) As String
Dim s$ = String.Empty
Dim p As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
If Extended Then
s.StringAppendLine($"Users added from this channel: {CountOfAddedUsers.Sum.NumToString(p)}")
s.StringAppendLine($"Users added from this channel (avg): {CountOfAddedUsers.DefaultIfEmpty(0).Average.RoundDown.NumToString(p)}")
s.StringAppendLine($"Users added from this channel (session): {CountOfAddedUsers.LastOrDefault.NumToString(p)}")
s.StringAppendLine($"Posts downloaded (avg): {CountOfLoadedPostsPerSession.DefaultIfEmpty(0).Average.RoundUp.NumToString(p)}")
s.StringAppendLine($"Posts downloaded (session): {CountOfLoadedPostsPerSession.LastOrDefault.NumToString(p)}")
Else
s.StringAppend($"Users: {CountOfAddedUsers.Sum.NumToString(p)} (avg: {CountOfAddedUsers.DefaultIfEmpty(0).Average.RoundDown.NumToString(p)}; s: {CountOfAddedUsers.LastOrDefault.NumToString(p)})")
s.StringAppend($"Posts: {CountOfLoadedPostsPerSession.DefaultIfEmpty(0).Average.RoundUp.NumToString(p)} (s: {CountOfLoadedPostsPerSession.LastOrDefault.NumToString(p)})", "; ")
End If
Return s
End Function
#Region "Limits Support"
Private _DownloadLimitCount As Integer? = Nothing
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
@@ -379,6 +406,8 @@ Namespace API.Reddit
Posts = New List(Of UserPost)
PostsLatest = New List(Of UserPost)
Range = New RangeSwitcher(Of UserPost)(Me)
CountOfAddedUsers = New List(Of Integer)
CountOfLoadedPostsPerSession = New List(Of Integer)
End Sub
Friend Sub New(ByVal f As SFile)
Me.New
@@ -422,7 +451,9 @@ Namespace API.Reddit
}
d.SetLimit(Me)
d.DownloadData(Token)
Dim b% = Posts.Count
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
If Posts.Count - b > 0 Then CountOfLoadedPostsPerSession.Add(Posts.Count - b)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
End Using
@@ -525,6 +556,8 @@ Namespace API.Reddit
Name = x.Value(Name_Name)
ID = x.Value(Name_ID)
LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), XMLDateProvider, Nothing)
CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), LAP.ClearBeforeAdd)
CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), LAP.ClearBeforeAdd)
If Not PartialLoad Then
With x(Name_PostsNode).XmlIfNothing
If .Count > 0 Then .ForEach(Sub(ee) PostsLatest.Add(New UserPost With {
@@ -549,6 +582,8 @@ Namespace API.Reddit
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)
x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString(, "|"))
x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString(, "|"))
With x(Name_PostsNode)
tmpPostList.Take(200).ToList.ForEach(Sub(p) .Add(New EContainer("Post",
String.Empty,
@@ -578,6 +613,8 @@ Namespace API.Reddit
If disposing Then
Posts.Clear()
PostsLatest.Clear()
CountOfAddedUsers.Clear()
CountOfLoadedPostsPerSession.Clear()
Range.Dispose()
If Not Instance Is Nothing Then Instance.Dispose()
If CachePath.Exists(SFO.Path, False) Then CachePath.Delete(SFO.Path, False, False, EDP.SendInLog)

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

@@ -74,7 +74,6 @@ Namespace API.Reddit
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,
@@ -111,7 +110,7 @@ Namespace API.Reddit
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
If Count > 0 And Not _Item Is Nothing Then
Dim i% = Channels.IndexOf(_Item)
If i >= 0 Then
With Channels(i) : .Delete() : .Dispose() : End With

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

@@ -16,9 +16,8 @@ Namespace API.Reddit
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)
Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Cultures.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)
@@ -28,7 +27,6 @@ Namespace API.Reddit
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)

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

@@ -74,7 +74,7 @@ Namespace API.Reddit
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})
Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General})
ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ReturnValue)
Dim i%
Dim eFiles As New List(Of SFile)

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

@@ -7,29 +7,23 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Namespace API.Reddit
Friend NotInheritable Class ProfileSaved
Friend Shared ReadOnly Property DataPath As SFile = $"{Settings(Sites.Reddit).Path.PathNoSeparator}\!Saved\"
Private Sub New()
End Sub
Friend Shared Sub Download(ByRef Toolbar As StatusStrip, ByRef PR As ToolStripProgressBar)
Friend Shared Sub Download(ByRef Bar As MyProgress, ByVal Token As CancellationToken)
Try
Dim Bar = New PersonalUtilities.Forms.Toolbars.MyProgress(Toolbar, PR, Nothing)
Dim u As New UserInfo(Settings(Sites.Reddit).SavedPostsUserName.Value, Sites.Reddit) With {
.IsChannel = True,
.SpecialPath = $"{Settings(Sites.Reddit).Path.PathWithSeparator}\!Saved\"
}
Dim u As New UserInfo(Settings(Sites.Reddit).SavedPostsUserName.Value, Sites.Reddit) With {.IsChannel = True, .SpecialPath = DataPath}
u.UpdateUserFile()
Using user As IUserData = UserDataBase.GetInstance(u)
Using user As New UserData(u,, False)
DirectCast(user.Self, UserDataBase).IsSavedPosts = True
Bar.Enabled = True
DirectCast(user.Self, UserData).Progress = Bar
user.Progress = Bar
If Not user.FileExists Then user.UpdateUserInformation()
user.DownloadData(Nothing)
Dim m As New MMessage("Reddit saved posts download complete", "Saved posts downloading", {"OK", "Open folder"})
m.Text.StringAppendLine($"Downloaded images: {user.DownloadedPictures}")
m.Text.StringAppendLine($"Downloaded videos: {user.DownloadedVideos}")
If MsgBoxE(m) = 1 Then u.File.CutPath.Open(SFO.Path)
Bar.Enabled = False
user.DownloadData(Token)
Bar.InformationTemporary = $"Images: {user.DownloadedPictures}; Videos: {user.DownloadedVideos}"
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.Reddit.ProfileSaved.Download]")

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

@@ -7,7 +7,6 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net
@@ -50,15 +49,6 @@ Namespace API.Reddit
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()
@@ -74,9 +64,13 @@ Namespace API.Reddit
If _LoadUserInformation Then LoadUserInformation()
End Sub
#End Region
#Region "Load and Update user info"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
If IsChannel AndAlso Not ChannelInfo.IsRegularChannel Then
If Not IsSavedPosts AndAlso (IsChannel AndAlso Not ChannelInfo.IsRegularChannel) Then
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New PersonalUtilities.Tools.WEB.Response
Responser.Copy(Settings(Sites.Reddit).Responser)
@@ -92,7 +86,9 @@ Namespace API.Reddit
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
If IsChannel Then
If IsSavedPosts Then
DownloadDataChannel(String.Empty, Token)
ElseIf IsChannel Then
If ChannelInfo.IsRegularChannel Then
ChannelPostsNames.ListAddList(_TempPostsList, LNC)
If ChannelPostsNames.Count > 0 Then
@@ -129,7 +125,7 @@ Namespace API.Reddit
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"
ThrowAny(Token)
Dim r$ = GetSiteResponse(URL)
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then
@@ -203,17 +199,8 @@ Namespace API.Reddit
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 dex As ObjectDisposedException When Disposed
Catch ex As Exception
If ex.HelpLink = NonExistendUserHelp Then
UserExists = False
ElseIf ex.HelpLink = SuspendedUserHelp Then
UserSuspended = True
Else
LogError(ex, $"data downloading error [{URL}]")
HasError = True
End If
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken)
@@ -234,7 +221,7 @@ Namespace API.Reddit
End If
ThrowAny(Token)
Dim r$ = GetSiteResponse(URL)
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then
@@ -296,17 +283,8 @@ Namespace API.Reddit
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 dex As ObjectDisposedException When Disposed
Catch ex As Exception
If ex.HelpLink = NonExistendUserHelp Then
UserExists = False
ElseIf ex.HelpLink = SuspendedUserHelp Then
UserSuspended = True
Else
LogError(ex, $"channel data downloading error [{URL}]")
HasError = True
End If
ProcessException(ex, Token, $"channel data downloading error [{URL}]")
End Try
End Sub
#End Region
@@ -366,8 +344,7 @@ Namespace API.Reddit
End If
Return added
Catch ex As Exception
LogError(ex, "gallery parsing error")
HasError = True
ProcessException(ex, Nothing, "gallery parsing error", False)
Return False
End Try
End Function
@@ -382,7 +359,7 @@ Namespace API.Reddit
ThrowAny(Token)
If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i)
r = GetSiteResponse(m.URL, e)
r = Responser.GetResponse(m.URL,, e)
_TempMediaList(i) = New UserMedia
If Not r.IsEmptyString Then
v = RegexReplace(r, VideoRegEx)
@@ -395,10 +372,8 @@ Namespace API.Reddit
End If
Next
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "video reparsing error")
ProcessException(ex, Token, "video reparsing error", False)
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
@@ -433,7 +408,7 @@ Namespace API.Reddit
Try
If Not URL.IsEmptyString AndAlso URL.StringContains({".jpg", ".png", ".jpeg"}) Then
Dim f As SFile = CStr(RegexReplace(URL, FilesPattern))
Return Not f.IsEmptyString And Not f.File.IsEmptyString
Return Not f.File.IsEmptyString
End If
Return False
Catch ex As Exception
@@ -454,7 +429,7 @@ Namespace API.Reddit
If _ContentNew.Count > 0 Then
MyFile.Exists(SFO.Path)
Dim MyDir$
If IsChannel And SaveToCache Then
If Not IsSavedPosts AndAlso (IsChannel And SaveToCache) Then
MyDir = ChannelInfo.CachePath.PathNoSeparator
Else
MyDir = MyFile.CutPath.PathNoSeparator
@@ -605,29 +580,20 @@ Namespace API.Reddit
HasError = True
End Try
End Sub
Protected Function GetSiteResponse(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As String
Try
Return Responser.GetResponse(URL,, EDP.ThrowException)
Catch ex As Exception
HasError = True
Dim OptText$ = String.Empty
If Not e.Exists Then
Dim ee As EDP = EDP.SendInLog
If Responser.StatusCode = HttpStatusCode.NotFound Then
ee = EDP.ThrowException
OptText = ": USER NOT FOUND"
ex.HelpLink = NonExistendUserHelp
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then
ee = EDP.ThrowException
OptText = ": USER PROFILE SUSPENDED"
ex.HelpLink = SuspendedUserHelp
Else
ee += EDP.ReturnValue
End If
e = New ErrorsDescriber(ee)
End If
Return ErrorsDescriber.Execute(e, ex, $"[{Site} - {Name}: GetSiteResponse([{URL}])]{OptText}", String.Empty)
End Try
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then
UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Or
Responser.StatusCode = HttpStatusCode.GatewayTimeout Then
MyMainLOG = "Reddit is currently unavailable"
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
Return 1
End Function
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then ChannelPostsNames.Clear() : _ExistsUsersNames.Clear()

22
SCrawler/API/Redgifs/Declarations.vb Normal file
View File

@@ -0,0 +1,22 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.RedGifs
Friend Module Declarations
Friend ReadOnly DateProvider As New JsonDate
Friend Class JsonDate : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicode(Value, NothingArg, e)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
End Module
End Namespace

90
SCrawler/API/Redgifs/UserData.vb Normal file
View File

@@ -0,0 +1,90 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Threading
Imports System.Net
Imports SCrawler.API.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.RedGifs
Friend Class UserData : Inherits UserDataBase
Friend Overrides Property Site As Sites = Sites.RedGifs
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
User = u
If _LoadUserInformation Then LoadUserInformation()
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
DownloadData(1, Token)
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent&page={Page}"
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Dim postDate$, postID$
Dim pTotal% = 0
Dim u$
Dim ut As UTypes
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("gifs") Then
pTotal = j.Value("pages").FromXML(Of Integer)(0)
For Each g As EContainer In j("gifs")
postDate = g.Value("createDate")
postID = g.Value("id")
If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit For
With g("urls")
If .ListExists Then
u = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
If Not u.IsEmptyString Then
ut = UTypes.Undefined
'Type 1: video
'Type 2: image
Select Case g.Value("type").FromXML(Of Integer)(0)
Case 1 : ut = UTypes.Video
Case 2 : ut = UTypes.Picture
End Select
If Not ut = UTypes.Undefined Then _TempMediaList.ListAddValue(MediaFromData(ut, u, postID, postDate))
End If
End If
End With
Next
End If
End Using
End If
If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) : m.URL_BASE = m.URL
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateProvider, Nothing) Else m.Post.Date = Nothing
Return m
End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
Return 1
End Function
End Class
End Namespace

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

@@ -12,35 +12,10 @@ 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)
@@ -48,6 +23,10 @@ Namespace API.Twitter
If _LoadUserInformation Then LoadUserInformation()
End Sub
#End Region
#Region "Load and Update user info"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
DownloadData(String.Empty, Token)
@@ -115,19 +94,8 @@ Namespace API.Twitter
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 dex As ObjectDisposedException When Disposed
Catch ex As Exception
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Unauthorized Then
UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
MyMainLOG = "Twitter has invalid credentials"
Else
LogError(ex, $"data downloading error [{URL}]")
HasError = True
End If
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia)
@@ -164,12 +132,12 @@ Namespace API.Twitter
Next
If l.Count > 0 Then
l.Sort()
If l(0).Name.IsEmptyString And LargeContained Then Return "large" Else Return l(0).Name
If l(0).Data.IsEmptyString And LargeContained Then Return "large" Else Return l(0).Data
End If
End If
Return String.Empty
Catch ex As Exception
LogError(ex, "[GetPictureOption]")
LogError(ex, "[API.Twitter.UserData.GetPictureOption]")
Return String.Empty
End Try
End Function
@@ -181,7 +149,7 @@ Namespace API.Twitter
If Not URL.IsEmptyString Then _TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate), LNC) : Return True
Return False
Catch ex As Exception
LogError(ex, "[CheckVideoNode]")
LogError(ex, "[API.Twitter.UserData.CheckVideoNode]")
Return False
End Try
End Function
@@ -202,7 +170,7 @@ Namespace API.Twitter
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
If l.Count > 0 Then l.Sort() : Return l(0).Data
End If
Return String.Empty
End Function
@@ -222,70 +190,20 @@ Namespace API.Twitter
End Function
#End Region
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Try
Dim i%
Dim dCount% = 0, dTotal% = 0
ThrowAny(Token)
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.PathNoSeparator
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
ThrowAny(Token)
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 = ChangeFileNameByProvider(f, v)
v.State = UStates.Downloaded
dCount += 1
Catch wex As Exception
ErrorDownloading(f, v.URL_BASE)
End Try
Else
v.State = UStates.Skipped
End If
_ContentNew(i) = v
If DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value Then
MainProgress.Perform(_ContentNew.Count - dTotal)
Exit Sub
Else
dTotal += 1
MainProgress.Perform()
End If
Next
End Using
End If
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "content downloading error")
HasError = True
End Try
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Unauthorized Then
UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
MyMainLOG = "Twitter has invalid credentials"
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
Return 1
End Function
End Class
End Namespace

26
SCrawler/API/UserDataBind.vb
View File

@@ -7,6 +7,7 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.XML
Imports System.Threading
Imports SCrawler.API.Base
Namespace API
@@ -271,6 +272,8 @@ Namespace API
Friend Overrides Sub LoadContentInformation()
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c.Self, UserDataBase).LoadContentInformation())
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
Friend Overrides Property DownloadTopCount As Integer?
Get
If Count > 0 Then
@@ -292,6 +295,9 @@ Namespace API
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
Return 0
End Function
Private Sub User_OnUserUpdated(ByVal User As IUserData)
Raise_OnUserUpdated()
End Sub
@@ -338,16 +344,16 @@ Namespace API
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.Last.Self, UserDataBase)
.CreateButtons(Count - 1)
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf BTT_CONTEXT_DELETE_Click
End With
AddHandler Collections.Last.OnUserUpdated, AddressOf User_OnUserUpdated
Collections.Add(GetInstance(u, _LoadData))
If Not Collections.Last Is Nothing Then
With DirectCast(Collections.Last.Self, UserDataBase)
.CreateButtons(Count - 1)
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf BTT_CONTEXT_DELETE_Click
End With
AddHandler Collections.Last.OnUserUpdated, AddressOf User_OnUserUpdated
Else
Collections.RemoveAt(Count - 1)
End If
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If Not _Items Is Nothing AndAlso _Items.Count > 0 Then