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

2022.12.26.0

Browse Source 
UserMedia: fixed plugin bugs
Instagram: updated algo and settings; update responser settings based on site response
PornHub: fixed bug in SiteSettings; fixed typos
RedGis: fixed downloading user profiles
XVideos: fixed user profile opening
UserDataBind: fixed multiple collection removing issue
DownloadedInfoForm: fixed user focusing
UserCreatorForm: add user name to form header if user exists
ListImagesLoader: changed loading algo
MainFrame: added channels button to tray context menu
Added ffmpeg fox x86
Fixed typos
This commit is contained in:
Andy
2022-12-26 17:37:25 +03:00
parent 03487185c5
commit aabf6d62ab
35 changed files with 563 additions and 790 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -104,7 +104,7 @@ Namespace API.Base
Return Post.ID
End Get
Set(ByVal PostID As String)
Post.ID = PostID
Post = New UserPost(PostID, Post.Date)
End Set
End Property
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
@@ -112,7 +112,7 @@ Namespace API.Base
Return Post.Date
End Get
Set(ByVal PostDate As Date?)
Post.Date = PostDate
Post = New UserPost(Post.ID, PostDate)
End Set
End Property
Private Property IUserMedia_SpecialFolder As String Implements IUserMedia.SpecialFolder

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

@@ -682,6 +682,7 @@ BlockNullPicture:
LastUpdated = AConvert(Of Date)(x.Value(Name_LastUpdated), ADateTime.Formats.BaseDateTime, Nothing)
ScriptUse = x.Value(Name_ScriptUse).FromXML(Of Boolean)(False)
ScriptData = x.Value(Name_ScriptData)
'TODELETE: UserDataBase remove old 'merge' constant
#Disable Warning BC40000
If x.Contains(Name_DataMerging) Then
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False)

135
SCrawler/API/Instagram/AdditionalSettingsForm.Designer.vb generated
View File

@@ -1,135 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class AdditionalSettingsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_DOWN_TIME = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_TAG = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_SAVED = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(234, 78)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(234, 103)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(Me.CH_DOWN_TIME, 0, 0)
TP_MAIN.Controls.Add(Me.CH_DOWN_TAG, 0, 1)
TP_MAIN.Controls.Add(Me.CH_DOWN_SAVED, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 4
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(234, 78)
TP_MAIN.TabIndex = 0
'
'CH_DOWN_TIME
'
Me.CH_DOWN_TIME.AutoSize = True
Me.CH_DOWN_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TIME.Location = New System.Drawing.Point(4, 4)
Me.CH_DOWN_TIME.Name = "CH_DOWN_TIME"
Me.CH_DOWN_TIME.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_TIME.TabIndex = 0
Me.CH_DOWN_TIME.Text = "Download Timeline"
Me.CH_DOWN_TIME.UseVisualStyleBackColor = True
'
'CH_DOWN_TAG
'
Me.CH_DOWN_TAG.AutoSize = True
Me.CH_DOWN_TAG.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TAG.Location = New System.Drawing.Point(4, 30)
Me.CH_DOWN_TAG.Name = "CH_DOWN_TAG"
Me.CH_DOWN_TAG.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_TAG.TabIndex = 1
Me.CH_DOWN_TAG.Text = "Download Stories and Tagged data"
Me.CH_DOWN_TAG.UseVisualStyleBackColor = True
'
'CH_DOWN_SAVED
'
Me.CH_DOWN_SAVED.AutoSize = True
Me.CH_DOWN_SAVED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_SAVED.Location = New System.Drawing.Point(4, 56)
Me.CH_DOWN_SAVED.Name = "CH_DOWN_SAVED"
Me.CH_DOWN_SAVED.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_SAVED.TabIndex = 2
Me.CH_DOWN_SAVED.Text = "Download saved posts"
Me.CH_DOWN_SAVED.UseVisualStyleBackColor = True
'
'AdditionalSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(234, 103)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(250, 142)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(250, 142)
Me.Name = "AdditionalSettingsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Additional settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_DOWN_TIME As CheckBox
Private WithEvents CH_DOWN_TAG As CheckBox
Private WithEvents CH_DOWN_SAVED As CheckBox
End Class
End Namespace

126
SCrawler/API/Instagram/AdditionalSettingsForm.resx
View File

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

41
SCrawler/API/Instagram/AdditionalSettingsForm.vb
View File

@@ -1,41 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Namespace API.Instagram
Friend Class AdditionalSettingsForm
Private WithEvents MyDefs As DefaultFormOptions
Friend Property MyParameters As SettingsExchangeOptions
Friend Sub New(ByVal Parameters As SettingsExchangeOptions)
InitializeComponent()
MyParameters = Parameters
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub MyForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(True)
.AddOkCancelToolbar()
With MyParameters
CH_DOWN_TIME.Checked = .DownloadTimeline
CH_DOWN_TAG.Checked = .DownloadStoriesTagged
CH_DOWN_SAVED.Checked = .DownloadSaved
End With
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
MyParameters = New SettingsExchangeOptions With {
.DownloadTimeline = CH_DOWN_TIME.Checked,
.DownloadStoriesTagged = CH_DOWN_TAG.Checked,
.DownloadSaved = CH_DOWN_SAVED.Checked,
.Changed = True
}
MyDefs.CloseForm()
End Sub
End Class
End Namespace

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

@@ -7,11 +7,49 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports PersonalUtilities.Tools.Web.Cookies
Namespace API.Instagram
Friend Module Declarations
Friend Const InstagramSite As String = "Instagram"
Friend Const InstagramSiteKey As String = "AndyProgram_Instagram"
Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
Friend ReadOnly Property DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v))
Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser)
Const r_wwwClaimName$ = "x-ig-set-www-claim"
Const r_tokenName$ = "csrftoken"
If Not Source Is Nothing Then
Dim isInternal As Boolean = TypeOf Source Is WebDataResponse
Dim wwwClaimName$, tokenName$
If isInternal Then
wwwClaimName = r_wwwClaimName
tokenName = r_tokenName
Else
wwwClaimName = SiteSettings.Header_IG_WWW_CLAIM
tokenName = SiteSettings.Header_CSRF_TOKEN
End If
Dim wwwClaim$ = String.Empty
Dim token$ = String.Empty
With Source
If isInternal Then
If .HeadersExists Then wwwClaim = .Headers.Value(wwwClaimName)
If .CookiesExists Then token = If(.Cookies.FirstOrDefault(Function(c) c.Name = tokenName)?.Value, String.Empty)
Else
If .HeadersExists Then
wwwClaim = .Headers.Value(wwwClaimName)
token = .Headers.Value(tokenName)
End If
End If
End With
If Not wwwClaim.IsEmptyString Then Destination.Headers.Add(SiteSettings.Header_IG_WWW_CLAIM, wwwClaim)
If Not token.IsEmptyString Then Destination.Headers.Add(SiteSettings.Header_CSRF_TOKEN, token)
If Not isInternal Then
Destination.Cookies.Update(Source.Cookies, CookieKeeper.UpdateModes.ReplaceByNameAll, False, EDP.SendInLog)
Destination.SaveSettings()
End If
End If
End Sub
End Module
End Namespace

23
SCrawler/API/Instagram/SettingsExchangeOptions.vb
View File

@@ -1,23 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
Friend Structure SettingsExchangeOptions
Friend DownloadTimeline As Boolean
Friend DownloadStoriesTagged As Boolean
Friend DownloadSaved As Boolean
Friend Changed As Boolean
Friend Sub New(ByVal Source As SiteSettings)
With Source
DownloadTimeline = .DownloadTimeline
DownloadStoriesTagged = .DownloadStoriesTagged
DownloadSaved = .DownloadSaved
End With
End Sub
End Structure
End Namespace

170
SCrawler/API/Instagram/SiteSettings.vb
View File

@@ -13,9 +13,11 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False), SpecialForm(True)>
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Images"
@@ -77,28 +79,23 @@ Namespace API.Instagram
End Class
#End Region
#Region "Authorization properties"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True, AllowNull:=False), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property Hash As PropertyValue
Private Const HashSavedPosts_Text As String = "Hash 2"
<PropertyOption(ControlText:=HashSavedPosts_Text, ControlToolTip:="Instagram session hash for saved posts", IsAuth:=True), PXML("InstaHashSavedPosts"), ControlNumber(1)>
Friend ReadOnly Property HashSavedPosts As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Instagram token for tagged data", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property HashTagged As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
Friend ReadOnly Property CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)>
Friend Property IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=False), ControlNumber(4)>
Friend Property IG_WWW_CLAIM As PropertyValue
Private Const SavedPostsUserName_Text As String = "Saved posts user"
<PropertyOption(ControlText:=SavedPostsUserName_Text, ControlToolTip:="Personal profile username", IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
Return Responser.CookiesExists And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
End Function
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Const Header_CSRF_TOKEN As String = "x-csrftoken"
Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private _FieldsChangerSuspended As Boolean = False
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
If Not _FieldsChangerSuspended And Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
@@ -114,33 +111,34 @@ Namespace API.Instagram
End Sub
#End Region
#Region "Download properties"
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(6)>
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(8)>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(7)>
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(9)>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(8)>
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(10)>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(9)>
<PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(11)>
Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(10)>
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(12)>
Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(11)>
"-1 to disable"), PXML, ControlNumber(13)>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region
#Region "Download ready"
Friend ReadOnly Property DownloadTimeline As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadStoriesTagged As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadSaved As XMLValue(Of Boolean)
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline, stories and saved posts"), PXML, ControlNumber(6)>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(7)>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region
#Region "429 bypass"
Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
@@ -206,6 +204,9 @@ Namespace API.Instagram
app_id = .Headers.Value(Header_IG_APP_ID)
www_claim = .Headers.Value(Header_IG_WWW_CLAIM)
End If
.CookiesExtractMode = Responser.CookiesExtractModes.Response
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
If Not .Cookies Is Nothing Then
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
@@ -214,17 +215,13 @@ Namespace API.Instagram
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
Hash = New PropertyValue(String.Empty, GetType(String))
HashSavedPosts = New PropertyValue(String.Empty, GetType(String))
HashTagged = New PropertyValue(String.Empty, GetType(String))
CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v))
IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_APP_ID), v))
IG_WWW_CLAIM = New PropertyValue(www_claim, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v))
DownloadTimeline = New XMLValue(Of Boolean)("DownloadTimeline", True, _XML, n)
DownloadStoriesTagged = New XMLValue(Of Boolean)("DownloadStoriesTagged", True, _XML, n)
DownloadSaved = New XMLValue(Of Boolean)("DownloadSaved", True, _XML, n)
DownloadTimeline = New PropertyValue(True)
DownloadTagged = New PropertyValue(False)
RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100)
@@ -251,7 +248,6 @@ Namespace API.Instagram
End Sub
Private Structure LatestValues
Friend Hash As String
Friend Hash2 As String
Friend Token As String
Friend AppID As String
Friend WwwClaim As String
@@ -259,8 +255,7 @@ Namespace API.Instagram
Friend Sub New(ByVal Source As SiteSettings)
Exists = True
With Source
Hash = AConvert(Of String)(.Hash.Value, String.Empty)
Hash2 = AConvert(Of String)(.HashSavedPosts.Value, String.Empty)
Hash = AConvert(Of String)(.HashTagged.Value, String.Empty)
With .Responser
Token = .Headers.Value(Header_CSRF_TOKEN)
AppID = .Headers.Value(Header_IG_APP_ID)
@@ -270,69 +265,31 @@ Namespace API.Instagram
End Sub
End Structure
Private LV As LatestValues = Nothing
Private ASO As SettingsExchangeOptions = Nothing
Friend Overrides Sub BeginEdit()
LV = New LatestValues(Me)
ASO = Nothing
MyBase.BeginEdit()
End Sub
Friend Overrides Sub EndEdit()
LV = Nothing
ASO = Nothing
MyBase.EndEdit()
End Sub
Friend Overrides Sub Update()
Friend Overloads Overrides Sub Update()
If LV.Exists Then
Dim __lv As New LatestValues(Me)
If If(Responser.Cookies?.Count, 0) > 0 Then
Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False)
If Not DownloadTimeline AndAlso (_cookiesChanged Or
(Not LV.Hash = __lv.Hash And Not __lv.Hash.IsEmptyString)) Then DownloadTimeline.Value = True
If Not DownloadSaved AndAlso (_cookiesChanged Or (Not LV.Hash2 = __lv.Hash2 And Not __lv.Hash2.IsEmptyString)) Then DownloadSaved.Value = True
If Not DownloadStoriesTagged AndAlso (
_cookiesChanged Or (
(Not LV.Hash = __lv.Hash Or Not LV.Token = __lv.Token Or Not LV.AppID = __lv.AppID Or Not LV.WwwClaim = __lv.WwwClaim) And
(Not __lv.Hash.IsEmptyString And Not __lv.Token.IsEmptyString And Not __lv.AppID.IsEmptyString And Not __lv.WwwClaim.IsEmptyString)
)) Then DownloadStoriesTagged.Value = True
Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False) And Responser.CookiesExists
Dim _tokensChanged As Boolean = (Not __lv.Token.IsEmptyString And Not __lv.WwwClaim.IsEmptyString And Not __lv.AppID.IsEmptyString) And
(Not LV.Token = __lv.Token Or Not LV.WwwClaim = __lv.WwwClaim Or Not LV.AppID = __lv.AppID)
If _cookiesChanged Or _tokensChanged Then DownloadTimeline.Value = True
If Not __lv.Hash.IsEmptyString And (_cookiesChanged Or _tokensChanged Or Not LV.Hash = __lv.Hash) Then DownloadTagged.Value = True
End If
End If
If ASO.Changed Then
DownloadTimeline.Value = ASO.DownloadTimeline
DownloadStoriesTagged.Value = ASO.DownloadStoriesTagged
DownloadSaved.Value = ASO.DownloadSaved
End If
LV = Nothing
ASO = Nothing
If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False
MyBase.Update()
End Sub
#End Region
#Region "PropertiesDataChecker"
<PropertiesDataChecker({NameOf(Hash), NameOf(HashSavedPosts)})>
Private Function CheckHashControls(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists(2) Then
Dim h$ = String.Empty
Dim hsp$ = String.Empty
For Each pp As PropertyData In p
Select Case pp.Name
Case NameOf(Hash) : h = AConvert(Of String)(pp.Value, String.Empty)
Case NameOf(HashSavedPosts) : hsp = AConvert(Of String)(pp.Value, String.Empty)
End Select
Next
If h.IsEmptyString And hsp.IsEmptyString Then
Return True
Else
If h = hsp Then
MsgBoxE({"InstaHash for saved posts must be different from InstaHash!", "InstaHash are equal"}, vbCritical)
Return False
Else
Return True
End If
End If
Else
Return False
End If
End Function
<PropertiesDataChecker({NameOf(TaggedNotifyLimit)})>
Private Function CheckNotifyLimit(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
@@ -351,37 +308,6 @@ Namespace API.Instagram
End If
Return False
End Function
<PropertiesDataChecker({NameOf(HashSavedPosts), NameOf(SavedPostsUserName)})>
Private Function CheckSavedOptions(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
Const MsgTitle$ = "Saved posts credentials"
Dim __hash$ = String.Empty
Dim __name$ = String.Empty
Dim _OptionlErrorText$ = $"For download saved posts, you must to set both [{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}]."
For i% = 0 To p.Count - 1
Select Case p(i).Name
Case NameOf(HashSavedPosts) : __hash = p(i).Value
Case NameOf(SavedPostsUserName) : __name = p(i).Value
End Select
Next
If __hash = __name Then
If __hash.IsEmptyString Then
Return True
Else
MsgBoxE({$"[{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}] for saved posts cannot be equal!", MsgTitle}, vbCritical)
End If
Else
If __hash.IsEmptyString Then
MsgBoxE({$"[{HashSavedPosts_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
ElseIf __name.IsEmptyString Then
MsgBoxE({$"[{SavedPostsUserName_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
Else
Return True
End If
End If
End If
Return False
End Function
#End Region
#Region "Plugin functions"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
@@ -389,7 +315,7 @@ Namespace API.Instagram
Case Download.Main : Return New UserData
Case Download.SavedPosts
Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = Site}
Return u
End Select
Return Nothing
@@ -397,13 +323,7 @@ Namespace API.Instagram
#Region "Downloading"
Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() Then
Select Case What
Case Download.Main : Return ACheck(Hash.Value) And DownloadTimeline
Case Download.SavedPosts : Return ACheck(HashSavedPosts.Value) And DownloadSaved
End Select
End If
Return False
Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso DownloadTimeline.Value
End Function
Private ActiveJobs As Integer = 0
Private _NextWNM As UserData.WNM = UserData.WNM.Notify
@@ -432,6 +352,10 @@ Namespace API.Instagram
_NextTagged = .TaggedCheckSession
LastDownloadDate.Value = Now
LastRequestsCount.Value = .RequestsCount
_FieldsChangerSuspended = True
IG_WWW_CLAIM.Value = Responser.Headers.Value(Header_IG_WWW_CLAIM)
CSRF_TOKEN.Value = Responser.Headers.Value(Header_CSRF_TOKEN)
_FieldsChangerSuspended = False
End With
End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download)
@@ -451,12 +375,14 @@ Namespace API.Instagram
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Sub OpenSettingsForm()
Using f As New AdditionalSettingsForm(If(ASO.Changed, ASO, New SettingsExchangeOptions(Me)))
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then ASO = f.MyParameters
End Using
End Sub
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)
If Not code.IsEmptyString Then Return $"https://instagram.com/p/{code}/" Else Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "Can't open user's post", String.Empty)
End Try
End Function
#End Region
End Class
End Namespace

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

@@ -9,6 +9,7 @@
Imports System.Net
Imports System.Threading
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
@@ -25,12 +26,48 @@ Namespace API.Instagram
Private Const Name_TaggedChecked As String = "TaggedChecked"
#End Region
#Region "Declarations"
Private Structure PostKV : Implements IEContainerProvider
Private Const Name_Code As String = "Code"
Private Const Name_Section As String = "Section"
Friend Code As String
Friend ID As String
Friend Section As Sections
Friend Sub New(ByVal _Section As Sections)
Section = _Section
End Sub
Friend Sub New(ByVal _Code As String, ByVal _ID As String, ByVal _Section As Sections)
Code = _Code
ID = _ID
Section = _Section
End Sub
Private Sub New(ByVal e As EContainer)
Code = e.Attribute(Name_Code)
Section = e.Attribute(Name_Section)
ID = e.Value
End Sub
Public Shared Widening Operator CType(ByVal e As EContainer) As PostKV
Return New PostKV(e)
End Operator
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) AndAlso TypeOf Obj Is PostKV Then
With DirectCast(Obj, PostKV)
Return Code = .Code And ID = .ID And Section = .Section
End With
Else
Return False
End If
End Function
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer("Post", ID, {New EAttribute(Name_Section, CInt(Section)), New EAttribute(Name_Code, Code)})
End Function
End Structure
Private ReadOnly Property MySiteSettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Private ReadOnly _SavedPostsIDs As New List(Of String)
Private ReadOnly PostsKVIDs As List(Of PostKV)
Private ReadOnly PostsToReparse As List(Of PostKV)
Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False
Friend Property GetStories As Boolean
@@ -51,6 +88,8 @@ Namespace API.Instagram
#End Region
#Region "Initializer, loader"
Friend Sub New()
PostsKVIDs = New List(Of PostKV)
PostsToReparse = New List(Of PostKV)
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
@@ -78,48 +117,127 @@ Namespace API.Instagram
End If
Throw New ExitException
End Sub
Friend Sub New()
End Sub
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class
Private Sub LoadSavePostsKV(ByVal Load As Boolean)
Dim x As XmlFile
Dim f As SFile = MyFilePosts
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
If Load Then
PostsKVIDs.Clear()
x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then PostsKVIDs.ListAddList(x, LAP.IgnoreICopier)
x.Dispose()
Else
x = New XmlFile With {.AllowSameNames = True}
x.AddRange(PostsKVIDs)
x.Name = "Posts"
x.Save(f, EDP.SendInLog)
x.Dispose()
End If
End If
End Sub
Private Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean
Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section)
End Function
Private Overloads Function PostKvExists(ByVal PostCodeId As String, ByVal IsCode As Boolean, ByVal Section As Sections) As Boolean
If Not PostCodeId.IsEmptyString And PostsKVIDs.Count > 0 Then
If PostsKVIDs.FindIndex(Function(p) p.Section = Section AndAlso If(IsCode, p.Code = PostCodeId, p.ID = PostCodeId)) >= 0 Then
Return True
ElseIf Not IsCode Then
Return _TempPostsList.Contains(GetPostIdBySection(PostCodeId, Section)) Or
_TempPostsList.Contains(PostCodeId.Replace($"_{ID}", String.Empty)) Or
_TempPostsList.Contains(GetPostIdBySection(PostCodeId.Replace($"_{ID}", String.Empty), Section))
End If
End If
Return False
End Function
Friend Function GetPostCodeById(ByVal PostID As String) As String
Try
If Not PostID.IsEmptyString Then
Dim f As SFile = MyFilePosts
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Dim l As List(Of PostKV) = Nothing
Using x As New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
l.ListAddList(x, LAP.IgnoreICopier)
End Using
Dim code$ = String.Empty
If l.ListExists Then
Dim i% = l.FindIndex(Function(p) p.ID = PostID)
If i >= 0 Then code = l(i).Code
l.Clear()
End If
Return code
End If
End If
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"{ToStringForLog()}: Cannot find post code by ID ({PostID})", String.Empty)
End Try
End Function
Private Function GetPostIdBySection(ByVal ID As String, ByVal Section As Sections) As String
If Section = Sections.Timeline Then
Return ID
Else
Return $"{Section}_{ID}"
End If
End Function
Private _DownloadingInProgress As Boolean = False
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False
Try
LoadSavePostsKV(True)
_DownloadingInProgress = True
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
ThrowAny(Token)
_InstaHash = String.Empty
HasError = False
Dim fc As Boolean = IIf(IsSavedPosts, MySiteSettings.DownloadSaved.Value, MySiteSettings.DownloadTimeline.Value)
If fc And Not LastCursor.IsEmptyString Then
If CBool(MySiteSettings.DownloadTimeline.Value) And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If fc And Not HasError Then
If CBool(MySiteSettings.DownloadTimeline.Value) And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then
If MySiteSettings.DownloadSaved Then s = Sections.SavedPosts : DownloadPosts(Token)
ElseIf MySiteSettings.BaseAuthExists() Then
DownloadedTags = 0
If MySiteSettings.DownloadStoriesTagged And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If MySiteSettings.DownloadStoriesTagged And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
If MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadTimeline.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException
Catch ex As Exception
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF]", False, s)
errorFound = True
Throw ex
Finally
E560Thrown = False
UpdateResponser()
If Not errorFound Then LoadSavePostsKV(False)
End Try
End Sub
Private _InstaHash As String = String.Empty
Private Sub UpdateResponser()
Try
If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
_DownloadingInProgress = False
RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
Declarations.UpdateResponser(Responser, MySiteSettings.Responser)
End If
Catch
End Try
End Sub
Private Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser)
End Sub
Private Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
@@ -145,7 +263,7 @@ Namespace API.Instagram
"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("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."}
},
@@ -180,13 +298,11 @@ Namespace API.Instagram
#Region "Tags"
Private TaggedChecked As Boolean = False
Friend TaggedCheckSession As Boolean = True
Private DownloadedTags As Integer = 0
Private DownloadTagsLimit As Integer? = Nothing
Private ReadOnly Property TaggedLimitsNotifications(Optional ByVal v As Integer? = Nothing) As Boolean
Private ReadOnly Property TaggedLimitsNotifications(ByVal v As Integer) As Boolean
Get
Return Not TaggedChecked AndAlso TaggedCheckSession AndAlso
CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso
(Not v.HasValue OrElse v.Value > CInt(MySiteSettings.TaggedNotifyLimit.Value))
CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso v > CInt(MySiteSettings.TaggedNotifyLimit.Value)
End Get
End Property
Private Function SetTagsLimit(ByVal Max As Integer, ByVal p As ANumbers) As DialogResult
@@ -219,8 +335,9 @@ Namespace API.Instagram
End Function
Private Function TaggedContinue(ByVal TaggedCount As Integer) As DialogResult
Dim agi As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Dim msg As New MMessage($"The number of tagged posts by user [{ToString()}] is {TaggedCount.NumToString(agi)}" & vbCr &
$"This is about {(TaggedCount / 12).RoundUp.NumToString(agi)} requests." & vbCr &
Dim msg As New MMessage($"The number of already downloaded tagged posts by user [{ToString()}] is {TaggedCount.NumToString(agi)}" & vbCr &
"There is currently no way to know how many posts exist." & vbCr &
"One request will be spent per post." & vbCr &
"The tagged data download operation can take a long time.",
"Too much tagged data",
{
@@ -252,40 +369,46 @@ Namespace API.Instagram
Dim URL$ = String.Empty
Dim StoriesList As List(Of String) = Nothing
Dim StoriesRequested As Boolean = False
Dim _DownloadComplete As Boolean = False
Dim dValue% = 1
LastCursor = Cursor
Try
Do While Not _DownloadComplete
Do While dValue = 1
ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
Try
Dim n As EContainer, nn As EContainer, node As EContainer
Dim n As EContainer, nn As EContainer
Dim HasNextPage As Boolean = False
Dim Pinned As Boolean
Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TaggedCount%
Dim PostIDKV As PostKV
Dim ENode() As Object = Nothing
NextRequest(True)
'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value)
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
If Not IsSavedPosts Then
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
End If
'Create query
Select Case Section
Case Sections.Timeline, Sections.SavedPosts
Case Sections.Timeline
URL = $"https://www.instagram.com/api/v1/feed/user/{Name}/username/?count=50" &
If(Cursor.IsEmptyString, String.Empty, $"&max_id={Cursor}")
ENode = Nothing
Case Sections.SavedPosts
SavedPostsDownload(String.Empty, Token)
Exit Sub
Case Sections.Tagged
Dim h$ = AConvert(Of String)(MySiteSettings.HashTagged.Value, String.Empty)
If h.IsEmptyString Then Throw New ExitException
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}"
URL = $"https://www.instagram.com/graphql/query/?query_hash={h}&variables={vars}"
ENode = {"data", "user", 0}
Case Sections.Tagged
URL = $"https://i.instagram.com/api/v1/usertags/{ID}/feed/?count=50&max_id={Cursor}"
ENode = {"items"}
SpecFolder = TaggedFolder
Case Sections.Stories
If Not StoriesRequested Then
@@ -303,7 +426,7 @@ Namespace API.Instagram
If StoriesList.ListExists Then
Continue Do
Else
Throw New ExitException(_DownloadComplete)
Throw New ExitException
End If
End Select
@@ -316,78 +439,73 @@ Namespace API.Instagram
'Parsing
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
n = j.ItemF(ENode).XmlIfNothing
n = If(ENode Is Nothing, j, j.ItemF(ENode)).XmlIfNothing
If n.Count > 0 Then
Select Case Section
Case Sections.Timeline, Sections.SavedPosts
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 AndAlso _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
End If
PostID = node.Value("id")
Pinned = CBool(If(node("pinned_for_users")?.Count, 0))
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) And Not Pinned Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
If IsSavedPosts Then
_SavedPostsIDs.Add(PostID)
Else
Select Case CheckDatesLimit(PostDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Throw New ExitException(_DownloadComplete)
End Select
ObtainMedia(node, PostID, PostDate, SpecFolder)
End If
Next
End If
Case Sections.Timeline
With n
HasNextPage = .Value("more_available").FromXML(Of Boolean)(False)
EndCursor = .Value("next_max_id")
If If(.Item("items")?.Count, 0) > 0 Then
If Not DefaultParser(.Item("items"), Section, Token) Then Throw New ExitException
Else
HasNextPage = False
End If
End With
Case Sections.Tagged
HasNextPage = j.Value("more_available").FromXML(Of Boolean)(False)
EndCursor = j.Value("next_max_id")
For Each nn In n
PostID = $"Tagged_{nn.Value("id")}"
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
ObtainMedia2(nn, PostID, SpecFolder)
DownloadedTags += 1
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then Throw New ExitException(_DownloadComplete)
Next
If TaggedLimitsNotifications Then
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0)
With n
If .Contains("page_info") Then
With .Item("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
Else
HasNextPage = False
End If
If If(.Item("edges")?.Count, 0) > 0 Then
For Each nn In .Item("edges")
PostIDKV = New PostKV(Section)
If nn.Count > 0 AndAlso nn(0).Count > 0 Then
With nn(0)
PostIDKV = New PostKV(.Value("shortcode"), .Value("id"), Section)
If PostKvExists(PostIDKV) Then
Throw New ExitException
Else
If Not DownloadTagsLimit.HasValue OrElse PostsToReparse.Count + 1 < DownloadTagsLimit.Value Then
_TempPostsList.Add(GetPostIdBySection(PostIDKV.ID, Section))
PostsKVIDs.ListAddValue(PostIDKV, LAP.NotContainsOnly)
PostsToReparse.ListAddValue(PostIDKV, LNC)
ElseIf DownloadTagsLimit.HasValue OrElse PostsToReparse.Count + 1 >= DownloadTagsLimit.Value Then
Throw New ExitException
End If
End If
End With
End If
Next
Else
HasNextPage = False
End If
End With
If TaggedLimitsNotifications(PostsToReparse.Count) Then
TaggedChecked = True
If TaggedLimitsNotifications(TaggedCount) AndAlso
TaggedContinue(TaggedCount) = DialogResult.Cancel Then Throw New ExitException(_DownloadComplete)
If TaggedContinue(PostsToReparse.Count) = DialogResult.Cancel Then Throw New ExitException
End If
End Select
Else
If j.Value("status") = "ok" AndAlso j({"data", "user"}).XmlIfNothing.Count = 0 AndAlso
If j.Value("status") = "ok" AndAlso If(j("items")?.Count, 0) = 0 AndAlso
_TempMediaList.Count = 0 AndAlso Section = Sections.Timeline Then _
UserExists = False : Throw New ExitException(_DownloadComplete)
UserExists = False : Throw New ExitException
End If
End Using
Else
Throw New ExitException(_DownloadComplete)
Throw New ExitException
End If
_DownloadComplete = True
dValue = 0
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token)
Catch eex As ExitException
Throw eex
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}]", False, Section) = 1 Then Continue Do Else Exit Do
dValue = ProcessException(ex, Token, $"data downloading error [{URL}]",, Section, False)
End Try
Loop
Catch eex2 As ExitException
@@ -400,10 +518,10 @@ Namespace API.Instagram
End Sub
Private Sub DownloadPosts(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim _DownloadComplete As Boolean = False
Dim dValue% = 1
Dim _Index% = 0
Try
Do While Not _DownloadComplete
Do While dValue = 1
ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
@@ -411,13 +529,11 @@ Namespace API.Instagram
Try
Dim r$
Dim j As EContainer, jj As EContainer
Dim _MediaObtained As Boolean
If _SavedPostsIDs.Count > 0 And _Index <= _SavedPostsIDs.Count - 1 Then
If PostsToReparse.Count > 0 And _Index <= PostsToReparse.Count - 1 Then
Dim e As New ErrorsDescriber(EDP.ThrowException)
For i% = _Index To _SavedPostsIDs.Count - 1
For i% = _Index To PostsToReparse.Count - 1
_Index = i
'URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1"
URL = $"https://i.instagram.com/api/v1/media/{_SavedPostsIDs(i)}/info/"
URL = $"https://www.instagram.com/api/v1/media/{PostsToReparse(i).ID}/info/"
ThrowAny(Token)
NextRequest(((i + 1) Mod 5) = 0)
ThrowAny(Token)
@@ -427,17 +543,9 @@ Namespace API.Instagram
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, String.Empty) : _MediaObtained = True
End With
End If
If Not _MediaObtained AndAlso j.Contains("items") Then
If If(j("items")?.Count, 0) > 0 Then
With j("items")
If .Count > 0 Then
For Each jj In .Self : ObtainMedia2(jj, _SavedPostsIDs(i)) : Next
End If
For Each jj In .Self : ObtainMedia(jj, PostsToReparse(i).ID) : Next
End With
End If
j.Dispose()
@@ -445,24 +553,79 @@ Namespace API.Instagram
End If
Next
End If
_DownloadComplete = True
dValue = 0
Catch eex As ExitException
Throw eex
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}]", False, Sections.SavedPosts) = 1 Then Continue Do Else Exit Do
dValue = ProcessException(ex, Token, $"downloading posts error [{URL}]",, Sections.Tagged, False)
End Try
Loop
Catch eex2 As ExitException
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}]",, Sections.SavedPosts)
ProcessException(DoEx, Token, $"downloading posts error [{URL}]",, Sections.Tagged)
End Try
End Sub
Private Sub SavedPostsDownload(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = $"https://www.instagram.com/api/v1/feed/saved/posts/?max_id={Cursor}"
Dim HasNextPage As Boolean = False
Dim NextCursor$ = String.Empty
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
Dim nodes As IEnumerable(Of EContainer) = Nothing
If Not r.IsEmptyString Then
Using e As EContainer = JsonDocument.Parse(r)
If If(e?.Count, 0) > 0 Then
With e
HasNextPage = .Value("more_available").FromXML(Of Boolean)(False)
NextCursor = .Value("next_max_id")
If .Contains("items") Then nodes = (From ee As EContainer In .Item("items") Where ee.Count > 0 Select ee(0))
End With
If nodes.ListExists Then
DefaultParser(nodes, Sections.SavedPosts, Token)
If HasNextPage And Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
End If
End If
End Using
End If
End Sub
Private Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing) As Boolean
ThrowAny(Token)
If Items.Count > 0 Then
Dim PostIDKV As PostKV
Dim Pinned As Boolean
Dim PostDate$
If SpecFolder.IsEmptyString Then
Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder
Case Sections.Stories : SpecFolder = StoriesFolder
Case Else : SpecFolder = String.Empty
End Select
End If
For Each nn In Items
With nn
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
Pinned = .Contains("timeline_pinned_user_ids")
If PostKvExists(PostIDKV) And Not Pinned Then Return False
_TempPostsList.Add(PostIDKV.ID)
PostsKVIDs.ListAddValue(PostIDKV, LAP.NotContainsOnly)
PostDate = .Value("taken_at")
If Not IsSavedPosts Then
Select Case CheckDatesLimit(PostDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Return False
End Select
End If
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate)
End With
Next
Return True
Else
Return False
End If
End Function
#End Region
#Region "Code ID converters"
Private Shared Function CodeToID(ByVal Code As String) As String
@@ -485,25 +648,7 @@ Namespace API.Instagram
End Function
#End Region
#Region "Obtain Media"
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String, ByVal SpecFolder As String)
Dim CreateMedia As Action(Of EContainer) =
Sub(ByVal e As EContainer)
Dim t As UTypes = If(e.Value("is_video").FromXML(Of Boolean)(False), UTypes.Video, UTypes.Picture)
Dim tmpValue$
If t = UTypes.Picture Then
tmpValue = e.Value("display_url")
Else
tmpValue = e.Value("video_url")
End If
If Not tmpValue.IsEmptyString Then _TempMediaList.ListAddValue(MediaFromData(t, tmpValue, PostID, PostDate, SpecFolder), LNC)
End Sub
If node.Contains({"edge_sidecar_to_children", "edges"}) Then
For Each edge As EContainer In node({"edge_sidecar_to_children", "edges"}) : CreateMedia(edge("node").XmlIfNothing) : Next
Else
CreateMedia(node)
End If
End Sub
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Private Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing)
Try
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
@@ -575,7 +720,7 @@ Namespace API.Instagram
DateObj = mDate(n)
With n("carousel_media").XmlIfNothing
If .Count > 0 Then
For Each d In .Self : ObtainMedia2(d, PostID, SpecialFolder, DateObj) : Next
For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj) : Next
End If
End With
End Select
@@ -588,22 +733,6 @@ Namespace API.Instagram
End Sub
#End Region
#Region "GetUserId"
<Obsolete> Private Sub GetUserId_Old()
Try
Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
ID = j({"graphql", "user"}, "id").XmlIfNothingValue
End Using
End If
Catch ex As Exception
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Throw ex
Else
LogError(ex, "get Instagram user id")
End If
End Try
End Sub
Private Sub GetUserId()
Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={Name}",, EDP.ThrowException)
@@ -652,7 +781,7 @@ Namespace API.Instagram
pid = storyID & s.Value("id")
If Not _TempPostsList.Contains(pid) Then
ThrowAny(Token)
ObtainMedia2(s, pid, sFolder)
ObtainMedia(s, pid, sFolder)
_TempPostsList.Add(pid)
End If
Next
@@ -731,8 +860,7 @@ Namespace API.Instagram
Dim s As Sections = DirectCast(Section, Sections)
Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
Case Sections.SavedPosts : MySiteSettings.DownloadSaved.Value = False
Case Else : MySiteSettings.DownloadStoriesTagged.Value = False
Case Else : MySiteSettings.DownloadTagged.Value = False
End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
End If
@@ -760,7 +888,7 @@ Namespace API.Instagram
t.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False)
t.Responser = New Responser
t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID)
t.PostsToReparse.Add(New PostKV With {.ID = PID})
t.DownloadPosts(Nothing)
Return ListAddList(Nothing, t._TempMediaList)
End Using
@@ -774,7 +902,13 @@ Namespace API.Instagram
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _SavedPostsIDs.Clear()
If Not disposedValue Then
UpdateResponser()
If disposing Then
PostsKVIDs.Clear()
PostsToReparse.Clear()
End If
End If
MyBase.Dispose(disposing)
End Sub
#End Region

9
SCrawler/API/PornHub/SiteSettings.vb
View File

@@ -105,17 +105,14 @@ Namespace API.PornHub
With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, .PersonType, .NameTrue) : End With
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
'TODELETE: remove comment
Return Media.URL_BASE '$"https://www.pornhub.com/view_video.php?viewkey={Media.Post.ID}"
Return Media.URL_BASE
End Function
#End Region
#Region "User options"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
Dim e As UserExchangeOptions = Nothing
If Not Options Is Nothing AndAlso TypeOf Options Is UserExchangeOptions Then e = Options
If e Is Nothing Then e = New UserExchangeOptions(Me)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions(Me)
If OpenForm Then
Using f As New OptionsForm(e) : f.ShowDialog() : End Using
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
#End Region

2
SCrawler/API/PornHub/UserData.vb
View File

@@ -359,7 +359,7 @@ Namespace API.PornHub
End If
ThrowAny(Token)
Catch ex As Exception
ProcessException(ex, Token, $"photos downloading error")
ProcessException(ex, Token, "photos downloading error")
End Try
End Sub
Private Function DownloadUserPhotos_ModelHub(ByVal Token As CancellationToken) As Boolean

13
SCrawler/API/Redgifs/SiteSettings.vb
View File

@@ -33,7 +33,6 @@ Namespace API.RedGifs
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
Friend Property Token As PropertyValue
<PXML> Friend Property TokenLastDateUpdated As PropertyValue
<DoNotUse> Friend ReadOnly Property NoCredentialsResponser As Responser
Private Const TokenName As String = "authorization"
#End Region
#Region "Initializer"
@@ -46,18 +45,6 @@ Namespace API.RedGifs
t = .Headers.Value(TokenName)
If b Then .SaveSettings()
End With
NoCredentialsResponser = New Responser($"{SettingsFolderName}\Responser_{RedGifsSite}_NC.xml") With {
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey,
.CookiesDomain = "redgifs.com"
}
With NoCredentialsResponser
If .File.Exists Then
.LoadSettings()
Else
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.SaveSettings()
End If
End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
UrlPatternUser = "https://www.redgifs.com/users/{0}/"

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

@@ -34,21 +34,15 @@ Namespace API.RedGifs
End Sub
#End Region
#Region "Download functions"
Private NoCredentialsResponser As Responser
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
NoCredentialsResponser = MySettings.NoCredentialsResponser.Copy
DownloadData(1, Token)
Finally
NoCredentialsResponser.Dispose()
End Try
DownloadData(1, Token)
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim _page As Func(Of String) = Function() If(Page = 1, String.Empty, $"&page={Page}")
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent{_page.Invoke}"
Dim r$ = NoCredentialsResponser.GetResponse(URL,, EDP.ThrowException)
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Dim postDate$, postID$
Dim pTotal% = 0
If Not r.IsEmptyString Then
@@ -70,7 +64,7 @@ Namespace API.RedGifs
End If
If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]",, True)
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
#End Region
@@ -239,18 +233,8 @@ Namespace API.RedGifs
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Dim IsNoCredentialsResponser As Boolean = AConvert(Of Boolean)(EObj, False)
Dim s As WebExceptionStatus = -1
Dim sc As HttpStatusCode = -1
If IsNoCredentialsResponser Then
If Not NoCredentialsResponser Is Nothing Then
s = NoCredentialsResponser.Status
sc = NoCredentialsResponser.StatusCode
End If
Else
s = Responser.Client.Status
sc = Responser.Client.StatusCode
End If
Dim s As WebExceptionStatus = Responser.Client.Status
Dim sc As HttpStatusCode = Responser.Client.StatusCode
If sc = HttpStatusCode.NotFound Or s = DataGone Then
UserExists = False
ElseIf sc = HttpStatusCode.Unauthorized Then

8
SCrawler/API/UserDataBind.vb
View File

@@ -98,7 +98,7 @@ Namespace API
If Not img Is Nothing Then Return img
Next
End If
Return GetNullPicture(Settings.MaxLargeImageHeight)
Return GetNullPicture(If(Settings.ViewMode.Value = ViewModes.IconLarge, Settings.MaxLargeImageHeight, Settings.MaxSmallImageHeight))
End Function
#End Region
Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
@@ -556,7 +556,11 @@ Namespace API
"Cancel"}, vbExclamation)
Dim v%
If CollectionValue >= 0 Then
v = CollectionValue
Select Case CollectionValue
Case 2 : v = 0
Case 3 : v = 1
Case Else : v = MsgBoxE(m)
End Select
ElseIf Multiple Then
v = 0
Else

5
SCrawler/API/XVIDEOS/SiteSettings.vb
View File

@@ -57,6 +57,7 @@ Namespace API.XVIDEOS
SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
DownloadUHD = New PropertyValue(False)
SavedVideosPlaylist = New PropertyValue(String.Empty, GetType(String))
UrlPatternUser = "https://xvideos.com/{0}"
End Sub
Friend Overrides Sub EndInit()
Initialized = True
@@ -105,8 +106,8 @@ Namespace API.XVIDEOS
#Region "User: get, check"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
Dim __user$ = User.Name.Split("_").FirstOrDefault
__user &= $"/{User.Name.Replace($"{User}_", String.Empty)}"
Return __user
__user &= $"/{User.Name.Replace($"{__user}_", String.Empty)}"
Return String.Format(UrlPatternUser, __user)
End Function
Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)"
Private Const URD As String = ".*?{0}{1}"

12
SCrawler/API/XVIDEOS/UserData.vb
View File

@@ -46,11 +46,13 @@ Namespace API.XVIDEOS
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not Settings.UseM3U8 Then
If Not Settings.OS64 Then
MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
Else
MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
End If
'TODELETE: XVideos m3u8 delete after debug ffmpeg x86
'If Not Settings.OS64 Then
' MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
'Else
' 'MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
'End If
MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
Exit Sub
End If
If IsSavedPosts Then

4
SCrawler/API/Xhamster/SiteSettings.vb
View File

@@ -114,10 +114,10 @@ Namespace API.Xhamster
End If
Return Nothing
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, Silent As Boolean) As Boolean
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
If Settings.UseM3U8 AndAlso MyBase.Available(What, Silent) Then
If What = ISiteSettings.Download.SavedPosts Then
Return If(Responser.Cookies?.Count, 0) > 0
Return Responser.CookiesExists
Else
Return True
End If

4
SCrawler/Download/DownloadedInfoForm.vb
View File

@@ -150,8 +150,8 @@ Namespace DownloadObjects
Private Sub BTT_FIND_Click(sender As Object, e As EventArgs) Handles BTT_FIND.Click
Try
If _LatestSelected.ValueBetween(0, LIST_DOWN.Items.Count - 1) AndAlso _LatestSelected.ValueBetween(0, Downloader.Downloaded.Count - 1) Then
Dim i% = Settings.Users.IndexOf(_TempUsersList(_LatestSelected))
If i >= 0 Then RaiseEvent UserFind(Settings.Users(i).Key)
Dim u As IUserData = Settings.GetUser(_TempUsersList(_LatestSelected), True)
If Not u Is Nothing Then RaiseEvent UserFind(u.Key)
End If
Catch ex As Exception
End Try

1
SCrawler/Download/Feed/FeedMedia.vb
View File

@@ -115,6 +115,7 @@ Namespace DownloadObjects
Case UserMedia.Types.Video, UserMedia.Types.m3u8
infoType = UserMedia.Types.Video
MyVideo = New FeedVideo(File) With {.Tag = File, .Dock = DockStyle.Fill, .ContextMenuStrip = CONTEXT_DATA}
If MyVideo.HasError Then HasError = True
TP_MAIN.Controls.Add(MyVideo, 0, 1)
BTT_CONTEXT_OPEN_MEDIA.Text &= " video"
BTT_CONTEXT_DELETE.Text &= " video"

4
SCrawler/Download/Feed/FeedVideo.vb
View File

@@ -38,6 +38,7 @@ Namespace DownloadObjects
Private VideoLengthMs As Integer = 0
Private VideoLengthStr As String
Private MediaFile As SFile = Nothing
Friend ReadOnly HasError As Boolean = False
Public Sub New()
InitializeComponent()
End Sub
@@ -63,7 +64,6 @@ Namespace DownloadObjects
MyVideo.BackgroundImageLayout = ImageLayout.Zoom
End If
Catch img_set_ex As Exception
'TODELETE: FeedVideo set BackgroundImage error
ErrorsDescriber.Execute(EDP.SendInLog, img_set_ex, "Error setting background image for media player." & vbCr &
$"File: {File}{vbCr}Image: {f}")
End Try
@@ -71,8 +71,8 @@ Namespace DownloadObjects
End If
UpdateButtons()
Catch ex As Exception
'TODELETE: FeedVideo initialization error
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"Media player initialization error({File})")
HasError = True
End Try
End Sub
Private _Disposed As Boolean = False

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

@@ -106,10 +106,10 @@ Namespace Editors
'BTT_OTHER_SETTINGS
'
Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(330, 2)
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(329, 2)
Me.BTT_OTHER_SETTINGS.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS"
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(120, 24)
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(121, 24)
Me.BTT_OTHER_SETTINGS.TabIndex = 2
Me.BTT_OTHER_SETTINGS.Text = "Options (F2)"
TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings")
@@ -121,7 +121,7 @@ Namespace Editors
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(454, 436)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(454, 461)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -162,7 +162,7 @@ Namespace Editors
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 26.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 26.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(454, 436)
Me.TP_MAIN.Size = New System.Drawing.Size(454, 461)
Me.TP_MAIN.TabIndex = 0
'
'TXT_USER
@@ -182,7 +182,7 @@ Namespace Editors
Me.TP_SITE.ColumnCount = 3
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 79.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 122.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 123.0!))
Me.TP_SITE.Controls.Add(Me.CH_IS_CHANNEL, 0, 0)
Me.TP_SITE.Controls.Add(Me.CMB_SITE, 1, 0)
Me.TP_SITE.Controls.Add(Me.BTT_OTHER_SETTINGS, 2, 0)
@@ -225,7 +225,7 @@ Namespace Editors
Me.CMB_SITE.Location = New System.Drawing.Point(84, 3)
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3)
Me.CMB_SITE.Name = "CMB_SITE"
Me.CMB_SITE.Size = New System.Drawing.Size(241, 22)
Me.CMB_SITE.Size = New System.Drawing.Size(240, 22)
Me.CMB_SITE.TabIndex = 1
Me.CMB_SITE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
'
@@ -302,7 +302,7 @@ Namespace Editors
Me.TXT_DESCR.Location = New System.Drawing.Point(4, 290)
Me.TXT_DESCR.Multiline = True
Me.TXT_DESCR.Name = "TXT_DESCR"
Me.TXT_DESCR.Size = New System.Drawing.Size(446, 142)
Me.TXT_DESCR.Size = New System.Drawing.Size(446, 167)
Me.TXT_DESCR.TabIndex = 10
'
'TXT_USER_FRIENDLY
@@ -469,7 +469,7 @@ Namespace Editors
Me.Name = "UserCreatorForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Create User"
Me.Text = "Create user"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()

2
SCrawler/Editors/UserCreatorForm.vb
View File

@@ -241,6 +241,8 @@ Namespace Editors
CMB_SITE.Enabled = False
CH_IS_CHANNEL.Checked = User.IsChannel
If Not UserInstance Is Nothing Then
Text = $"User: {UserInstance.Name}"
If Not UserInstance.FriendlyName.IsEmptyString Then Text &= $" ({UserInstance.FriendlyName})"
TXT_USER.Enabled = False
TXT_SPEC_FOLDER.TextBoxReadOnly = True
TXT_SPEC_FOLDER.Buttons.Clear()

176
SCrawler/ListImagesLoader.vb
View File

@@ -6,11 +6,12 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API
Imports SCrawler.API.Base
Friend Class ListImagesLoader
Private ReadOnly Property MyList As ListView
Private Class UserOption : Implements IComparable(Of UserOption)
Private Structure UserOption : Implements IComparable(Of UserOption)
Friend ReadOnly User As IUserData
Friend ReadOnly LVI As ListViewItem
Friend Index As Integer
@@ -19,93 +20,106 @@ Friend Class ListImagesLoader
Return LVI.Name
End Get
End Property
Friend [Image] As Image
Friend Sub New(ByVal u As IUserData, ByVal l As ListView, ByVal GetImage As Boolean)
Friend Sub New(ByVal u As IUserData, ByVal l As ListView)
User = u
LVI = u.GetLVI(l)
Index = u.Index
If GetImage Then Image = u.GetPicture
End Sub
Friend Sub UpdateImage()
Image = User.GetPicture
End Sub
Friend Function CompareTo(ByVal Other As UserOption) As Integer Implements IComparable(Of UserOption).CompareTo
Return Index.CompareTo(Other.Index)
End Function
End Class
End Structure
Friend Sub New(ByRef l As ListView)
MyList = l
End Sub
Private UserDataList As List(Of UserOption)
Private UpdateInProgress As Boolean = False
Private ImageThread As Thread
Private Sub UpdateImages()
If UserDataList.ListExists And Not If(ImageThread?.IsAlive, False) Then
ImageThread = New Thread(New ThreadStart(Sub()
Dim ar As IAsyncResult = Nothing
Dim a As Action = Sub()
If UserDataList.ListExists Then
For i% = 0 To UserDataList.Count - 1
With UserDataList(i).User
Select Case Settings.ViewMode.Value
Case View.LargeIcon : MyList.LargeImageList.Images.Add(.Key, .GetPicture())
Case View.SmallIcon : MyList.SmallImageList.Images.Add(.Key, .GetPicture())
End Select
End With
Application.DoEvents()
Next
UserDataList.Clear()
GC.Collect()
End If
If Not ar Is Nothing Then MyList.EndInvoke(ar)
End Sub
If MyList.InvokeRequired Then
ar = MyList.BeginInvoke(a)
Else
a.Invoke
End If
End Sub)) With {.IsBackground = True}
ImageThread.SetApartmentState(ApartmentState.MTA)
ImageThread.Start()
End If
End Sub
Friend Sub Update()
Dim a As Action = Sub()
With MyList
.Items.Clear()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.LargeImageList = New ImageList
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.SmallImageList = New ImageList
If Settings.ViewModeIsPicture Then
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value)
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value)
End If
End With
End Sub
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
If Settings.Users.Count > 0 Then
Settings.Users.Sort()
Dim v As View = Settings.ViewMode.Value
Dim i%
If Not UpdateInProgress Then
UpdateInProgress = True
Dim a As Action = Sub()
With MyList
.Items.Clear()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.LargeImageList = New ImageList
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.SmallImageList = New ImageList
If Settings.ViewModeIsPicture Then
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value)
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value)
End If
End With
End Sub
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
If Settings.Users.Count > 0 Then
Settings.Users.Sort()
Dim v As View = Settings.ViewMode.Value
With MyList
MyList.BeginUpdate()
With MyList
MyList.BeginUpdate()
If Settings.FastProfilesLoading Then
Settings.Users.ListReindex
Dim UData As List(Of UserOption)
If Settings.FastProfilesLoading Then
Settings.Users.ListReindex
If Settings.ViewModeIsPicture Then
UData = GetUsersWithImages()
If UData.ListExists Then
UData.Sort()
Select Case v
Case View.LargeIcon : .LargeImageList.Images.AddRange(UData.Select(Function(u) u.Image).ToArray)
Case View.SmallIcon : .SmallImageList.Images.AddRange(UData.Select(Function(u) u.Image).ToArray)
End Select
UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing
If UserDataList.ListExists Then UserDataList.Sort()
If UserDataList.ListExists Then
.Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray)
If Settings.ViewModeIsPicture Then MyList.EndUpdate() : UpdateImages() Else UserDataList.Clear()
End If
Else
UData = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList, False)).ListIfNothing
If UData.ListExists Then UData.Sort()
End If
If UData.ListExists Then
If Settings.ViewModeIsPicture Then
For i = 0 To UData.Count - 1
Select Case v
Case View.LargeIcon : .LargeImageList.Images.SetKeyName(i, UData(i).Key)
Case View.SmallIcon : .SmallImageList.Images.SetKeyName(i, UData(i).Key)
End Select
Next
End If
.Items.AddRange(UData.Select(Function(u) u.LVI).ToArray)
UData.Clear()
End If
Else
Dim t As New List(Of Task)
For Each User As IUserData In Settings.Users
If User.FitToAddParams Then
If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True)))
Else
UpdateUser(User, True)
Dim t As New List(Of Task)
For Each User As IUserData In Settings.Users
If User.FitToAddParams Then
If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True)))
Else
UpdateUser(User, True)
End If
End If
End If
Next
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
End If
End With
MyList.EndUpdate()
Next
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
End If
End With
MyList.EndUpdate()
End If
UpdateInProgress = False
Else
MsgBoxE({"The user list is currently being updated. Please wait for the update operation to complete and try again.", "Update user list"}, vbExclamation)
End If
End Sub
Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
@@ -172,24 +186,4 @@ Friend Class ListImagesLoader
Return False
End If
End Function
Private Function GetUsersWithImages() As List(Of UserOption)
Try
Dim t As New List(Of Task)
Dim l As New List(Of UserOption)
t.AddRange(From u As IUserData In Settings.Users Where u.FitToAddParams Select Task.Run(Sub() l.Add(New UserOption(u, MyList, True))))
If t.Count > 0 Then Task.WaitAll(t.ToArray)
If l.Count > 0 Then
For i% = 0 To l.Count - 1
If l(i) Is Nothing Then Throw New ArgumentNullException("UserOption", $"One of the UserOptions [{i} / {l.Count - 1}] is null.")
If l(i).Image Is Nothing Then l(i).UpdateImage()
Next
End If
Return l
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.LogMessageValue, ex,
"Image fast loading error." & vbCr &
"Click the ""Refresh"" button to manually refresh the user list." & vbCr &
"[ListImagesLoader.GetUsersWithImages]")
End Try
End Function
End Class

13
SCrawler/MainFrame.Designer.vb generated
View File

@@ -124,6 +124,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CHANNELS = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
@@ -825,9 +826,9 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'
'TRAY_CONTEXT
'
Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_TRAY_PAUSE_AUTOMATION, Me.BTT_TRAY_SILENT_MODE, Me.BTT_TRAY_FEED_SHOW, TRAY_SEP_1, Me.BTT_TRAY_SHOW_HIDE, TRAY_SEP_2, Me.BTT_TRAY_CLOSE, Me.BTT_TRAY_CLOSE_NO_SCRIPT})
Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_TRAY_PAUSE_AUTOMATION, Me.BTT_TRAY_SILENT_MODE, Me.BTT_TRAY_FEED_SHOW, Me.BTT_TRAY_CHANNELS, TRAY_SEP_1, Me.BTT_TRAY_SHOW_HIDE, TRAY_SEP_2, Me.BTT_TRAY_CLOSE, Me.BTT_TRAY_CLOSE_NO_SCRIPT})
Me.TRAY_CONTEXT.Name = "TRAY_CONTEXT"
Me.TRAY_CONTEXT.Size = New System.Drawing.Size(171, 148)
Me.TRAY_CONTEXT.Size = New System.Drawing.Size(171, 170)
'
'BTT_TRAY_PAUSE_AUTOMATION
'
@@ -884,6 +885,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_CLOSE_NO_SCRIPT.ToolTipText = "Close the program without executing the script"
Me.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = False
'
'BTT_TRAY_CHANNELS
'
Me.BTT_TRAY_CHANNELS.Name = "BTT_TRAY_CHANNELS"
Me.BTT_TRAY_CHANNELS.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_CHANNELS.Text = "Channels"
Me.BTT_TRAY_CHANNELS.Image = Global.SCrawler.My.Resources.SiteResources.RedditPic_512
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -987,4 +995,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Friend WithEvents BTT_DOWN_AUTOMATION_PAUSE As ToolStripMenuItem
Private WithEvents BTT_TRAY_FEED_SHOW As ToolStripMenuItem
Friend WithEvents MENU_DOWN_ALL As ToolStripDropDownButton
Private WithEvents BTT_TRAY_CHANNELS As ToolStripMenuItem
End Class

3
SCrawler/MainFrame.vb
View File

@@ -250,7 +250,6 @@ CloseResume:
#Region "List refill, update"
Friend Sub RefillList()
UserListLoader.Update()
GC.Collect()
End Sub
Private Sub UserListUpdate(ByVal User As IUserData, ByVal Add As Boolean)
UserListLoader.UpdateUser(User, Add)
@@ -380,7 +379,7 @@ CloseResume:
If MyFeed Is Nothing Then MyFeed = New DownloadFeedForm : AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged
If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show()
End Sub
Private Sub BTT_CHANNELS_Click(sender As Object, e As EventArgs) Handles BTT_CHANNELS.Click
Private Sub BTT_CHANNELS_Click(sender As Object, e As EventArgs) Handles BTT_CHANNELS.Click, BTT_TRAY_CHANNELS.Click
If MyChannels Is Nothing Then
MyChannels = New ChannelViewForm
AddHandler MyChannels.OnUsersAdded, AddressOf OnUsersAddedHandler

4
SCrawler/My Project/AssemblyInfo.vb
View File

@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2022.11.16.0")>
<Assembly: AssemblyFileVersion("2022.11.16.0")>
<Assembly: AssemblyVersion("2022.12.26.0")>
<Assembly: AssemblyFileVersion("2022.12.26.0")>
<Assembly: NeutralResourcesLanguage("en")>

10
SCrawler/SCrawler.vbproj
View File

@@ -165,12 +165,6 @@
<Compile Include="API\Base\ProfileSaved.vb" />
<Compile Include="API\Base\SiteSettingsBase.vb" />
<Compile Include="API\Base\Structures.vb" />
<Compile Include="API\Instagram\AdditionalSettingsForm.Designer.vb">
<DependentUpon>AdditionalSettingsForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Instagram\AdditionalSettingsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Instagram\EditorExchangeOptions.vb" />
<Compile Include="API\Instagram\OptionsForm.Designer.vb">
<DependentUpon>OptionsForm.vb</DependentUpon>
@@ -178,7 +172,6 @@
<Compile Include="API\Instagram\OptionsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Instagram\SettingsExchangeOptions.vb" />
<Compile Include="API\LPSG\Declarations.vb" />
<Compile Include="API\LPSG\SiteSettings.vb" />
<Compile Include="API\LPSG\UserData.vb" />
@@ -414,9 +407,6 @@
</Compile>
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="API\Instagram\AdditionalSettingsForm.resx">
<DependentUpon>AdditionalSettingsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Instagram\OptionsForm.resx">
<DependentUpon>OptionsForm.vb</DependentUpon>
</EmbeddedResource>

8
SCrawler/SettingsCLS.vb
View File

@@ -23,12 +23,14 @@ Friend Class SettingsCLS : Implements IDisposable
Friend Const CookieEncryptKey As String = "SCrawlerCookiesEncryptKeyword"
Friend ReadOnly Design As XmlFile
Private ReadOnly MyXML As XmlFile
Friend ReadOnly OS64 As Boolean
Private ReadOnly OS64 As Boolean
Private ReadOnly FfmpegExists As Boolean
Friend ReadOnly FfmpegFile As SFile
Friend ReadOnly Property UseM3U8 As Boolean
Get
Return OS64 And FfmpegExists
'TODELETE: SETTINGS m3u8 delete after debug ffmpeg x86
'Return OS64 And FfmpegExists
Return FfmpegExists
End Get
End Property
Private ReadOnly FFMPEGNotification As XMLValue(Of Boolean)
@@ -259,7 +261,7 @@ Friend Class SettingsCLS : Implements IDisposable
If cUsers.ListExists Then
Dim d As New Dictionary(Of String, List(Of UserInfo))
cUsers = cUsers.ListForEachCopy(Of List(Of UserInfo))(Function(ByVal f As UserInfo, ByVal f_indx As Integer) As UserInfo
Dim m% = IIf(f.Merged Or f.IsVirual, 1, 2)
Dim m% = IIf(f.Merged Or f.IsVirtual, 1, 2)
If Not f.Protected AndAlso SFile.GetPath(f.File.CutPath(m - 1).Path).Exists(SFO.Path, False) Then
If Not d.ContainsKey(f.CollectionName) Then
d.Add(f.CollectionName, New List(Of UserInfo) From {f})

3
SCrawler/UserFinder.vb
View File

@@ -86,6 +86,7 @@ Friend Class UserFinder : Implements IDisposable
.CollectionName = x.Value(UserInfo.Name_Collection),
.IsChannel = x.Value(UserInfo.Name_IsChannel).FromXML(Of Boolean)(False)
}
'TODELETE: UserFinder remove old 'merge' constant
#Disable Warning BC40000
If x.Contains(UserDataBase.Name_DataMerging) Then
u.Merged = x.Value(UserDataBase.Name_DataMerging).FromXML(Of Boolean)(False)
@@ -182,7 +183,7 @@ Friend Class UserFinder : Implements IDisposable
End If
__added = {__added, __dup, __skipped}.ListToString(vbCr.StringDup(2))
If Not __added.IsEmptyString Then
Using t As New TextSaver($"LOGs\ImportUsers.txt") With {.ForceAddDateTimeToFileName = True}
Using t As New TextSaver("LOGs\ImportUsers.txt") With {.ForceAddDateTimeToFileName = True}
t.Append(__added)
If Added.Count > 0 Then
t.AppendLine(vbNewLine.StringDup(2))

4
SCrawler/UserInfo.vb
View File

@@ -39,7 +39,7 @@ Partial Friend Module MainMod
Return Not CollectionName.IsEmptyString
End Get
End Property
Friend ReadOnly Property IsVirual As Boolean
Friend ReadOnly Property IsVirtual As Boolean
Get
Return CollectionModel = UsageModel.Virtual Or UserModel = UsageModel.Virtual
End Get
@@ -123,7 +123,7 @@ Partial Friend Module MainMod
ElseIf Merged And IncludedInCollection Then
Return $"{ColPath}\{SettingsFolderName}"
Else
If IncludedInCollection And Not IsVirual Then
If IncludedInCollection And Not IsVirtual Then
Return $"{ColPath}\{Site}_{Name}\{SettingsFolderName}"
ElseIf Not Settings(Plugin) Is Nothing Then
Return $"{Settings(Plugin).Path.PathNoSeparator}\{Name}\{SettingsFolderName}"