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

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

23
Changelog.md
View File

@@ -1,3 +1,26 @@
# 2022.12.26.0
*2022-12-26*
**ATTENTION!**
**Instagram requirements changed. Headers and cookies are now required to download Timeline, Stories and Saved posts; hash to download tagged posts. Please update your credentials.**
**Instagram tagged posts no longer provide the total amount of tagged posts. I've corrected the tagged posts notification, but now I can't tell how many requests will be spent on downloading tagged posts. And from now on, one request will be spent on downloading each tagged post, because Instagram doesn't provide complete information about the tagged post with the site's response. In this case, if the number of tagged posts is 1000, 1000 requests will be spent. Be careful when downloading them. I highly recommend that you forcefully disable the downloading of tagged posts for a while.**
- Added
- Updated user loading algorithm
- Channels button to tray context menu
- (Request #96) Add FFmpeg to x86 version
- Fixed
- PornHub wrong behavior when downloading images
- Unable open XVideos user profile
- Cannot delete multiple collections at once
- Can't focus user from the download info form
- Instagram downloader not working
- (Issue #69) **RedGifs data is not downloading**. Again.
- Minor bugs
# 2022.11.16.0 # 2022.11.16.0
*2022-11-16* *2022-11-16*

BIN
ProgramScreenshots/SettingsSiteInstagram.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 28 KiB

After

Width:  |  Height:  |  Size: 26 KiB

BIN
ProgramScreenshots/SettingsSiteInstagramAdditional.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 5.8 KiB

5
README.md
View File

@@ -1,7 +1,10 @@
# :rainbow_flag: Social networks crawler :rainbow_flag: # :rainbow_flag: Social networks crawler :rainbow_flag: :christmas_tree:
# :christmas_tree: Happy new year :christmas_tree:
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest) [![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE) [![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
[![GitHub all releases](https://img.shields.io/github/downloads/aandyprogram/scrawler/total?label=Total%20downloads)](https://github.com/AAndyProgram/SCrawler/releases)
[![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md) [![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md)
[![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki) [![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki)
[![How to support](https://img.shields.io/badge/HowToSupport-green)](HowToSupport.md) [![How to support](https://img.shields.io/badge/HowToSupport-green)](HowToSupport.md)

4
SCrawler.PluginProvider/My Project/AssemblyInfo.vb
View File

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

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

@@ -104,7 +104,7 @@ Namespace API.Base
Return Post.ID Return Post.ID
End Get End Get
Set(ByVal PostID As String) Set(ByVal PostID As String)
Post.ID = PostID Post = New UserPost(PostID, Post.Date)
End Set End Set
End Property End Property
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
@@ -112,7 +112,7 @@ Namespace API.Base
Return Post.Date Return Post.Date
End Get End Get
Set(ByVal PostDate As Date?) Set(ByVal PostDate As Date?)
Post.Date = PostDate Post = New UserPost(Post.ID, PostDate)
End Set End Set
End Property End Property
Private Property IUserMedia_SpecialFolder As String Implements IUserMedia.SpecialFolder 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) LastUpdated = AConvert(Of Date)(x.Value(Name_LastUpdated), ADateTime.Formats.BaseDateTime, Nothing)
ScriptUse = x.Value(Name_ScriptUse).FromXML(Of Boolean)(False) ScriptUse = x.Value(Name_ScriptUse).FromXML(Of Boolean)(False)
ScriptData = x.Value(Name_ScriptData) ScriptData = x.Value(Name_ScriptData)
'TODELETE: UserDataBase remove old 'merge' constant
#Disable Warning BC40000 #Disable Warning BC40000
If x.Contains(Name_DataMerging) Then If x.Contains(Name_DataMerging) Then
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False) 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, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports PersonalUtilities.Tools.Web.Cookies
Namespace API.Instagram Namespace API.Instagram
Friend Module Declarations Friend Module Declarations
Friend Const InstagramSite As String = "Instagram" Friend Const InstagramSite As String = "Instagram"
Friend Const InstagramSiteKey As String = "AndyProgram_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 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 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 Module
End Namespace 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
Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False), SpecialForm(True)> <Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Images" #Region "Images"
@@ -77,28 +79,23 @@ Namespace API.Instagram
End Class End Class
#End Region #End Region
#Region "Authorization properties" #Region "Authorization properties"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True, AllowNull:=False), PXML("InstaHash"), ControlNumber(0)> <PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property Hash As PropertyValue Friend ReadOnly Property HashTagged As PropertyValue
Private Const HashSavedPosts_Text As String = "Hash 2" <PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(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)>
Friend ReadOnly Property CSRF_TOKEN As PropertyValue Friend ReadOnly Property CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)> <PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)>
Friend Property IG_APP_ID As PropertyValue Friend Property IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=False), ControlNumber(4)> <PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=False), ControlNumber(4)>
Friend Property IG_WWW_CLAIM As PropertyValue 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 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 End Function
Private Const Header_IG_APP_ID As String = "x-ig-app-id" Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim" Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Const Header_CSRF_TOKEN As String = "x-csrftoken" 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) 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 Dim f$ = String.Empty
Select Case PropName Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
@@ -114,33 +111,34 @@ Namespace API.Instagram
End Sub End Sub
#End Region #End Region
#Region "Download properties" #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 Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider 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 Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider 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 Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)> <Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider 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 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 Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit", <PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr & 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 Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)> <Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region #End Region
#Region "Download ready" #Region "Download ready"
Friend ReadOnly Property DownloadTimeline As XMLValue(Of Boolean) <PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline, stories and saved posts"), PXML, ControlNumber(6)>
Friend ReadOnly Property DownloadStoriesTagged As XMLValue(Of Boolean) Friend ReadOnly Property DownloadTimeline As PropertyValue
Friend ReadOnly Property DownloadSaved As XMLValue(Of Boolean) <PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(7)>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region #End Region
#Region "429 bypass" #Region "429 bypass"
Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date) Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
@@ -206,6 +204,9 @@ Namespace API.Instagram
app_id = .Headers.Value(Header_IG_APP_ID) app_id = .Headers.Value(Header_IG_APP_ID)
www_claim = .Headers.Value(Header_IG_WWW_CLAIM) www_claim = .Headers.Value(Header_IG_WWW_CLAIM)
End If End If
.CookiesExtractMode = Responser.CookiesExtractModes.Response
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
If Not .Cookies Is Nothing Then If Not .Cookies Is Nothing Then
.Cookies.ChangedAllowInternalDrop = False .Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False .Cookies.Changed = False
@@ -214,17 +215,13 @@ Namespace API.Instagram
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString} Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String)) HashTagged = New PropertyValue(String.Empty, GetType(String))
Hash = New PropertyValue(String.Empty, GetType(String))
HashSavedPosts = New PropertyValue(String.Empty, GetType(String))
CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v)) 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_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)) 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) DownloadTimeline = New PropertyValue(True)
DownloadStoriesTagged = New XMLValue(Of Boolean)("DownloadStoriesTagged", True, _XML, n) DownloadTagged = New PropertyValue(False)
DownloadSaved = New XMLValue(Of Boolean)("DownloadSaved", True, _XML, n)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100) RequestsWaitTimerProvider = New TimersChecker(100)
@@ -251,7 +248,6 @@ Namespace API.Instagram
End Sub End Sub
Private Structure LatestValues Private Structure LatestValues
Friend Hash As String Friend Hash As String
Friend Hash2 As String
Friend Token As String Friend Token As String
Friend AppID As String Friend AppID As String
Friend WwwClaim As String Friend WwwClaim As String
@@ -259,8 +255,7 @@ Namespace API.Instagram
Friend Sub New(ByVal Source As SiteSettings) Friend Sub New(ByVal Source As SiteSettings)
Exists = True Exists = True
With Source With Source
Hash = AConvert(Of String)(.Hash.Value, String.Empty) Hash = AConvert(Of String)(.HashTagged.Value, String.Empty)
Hash2 = AConvert(Of String)(.HashSavedPosts.Value, String.Empty)
With .Responser With .Responser
Token = .Headers.Value(Header_CSRF_TOKEN) Token = .Headers.Value(Header_CSRF_TOKEN)
AppID = .Headers.Value(Header_IG_APP_ID) AppID = .Headers.Value(Header_IG_APP_ID)
@@ -270,69 +265,31 @@ Namespace API.Instagram
End Sub End Sub
End Structure End Structure
Private LV As LatestValues = Nothing Private LV As LatestValues = Nothing
Private ASO As SettingsExchangeOptions = Nothing
Friend Overrides Sub BeginEdit() Friend Overrides Sub BeginEdit()
LV = New LatestValues(Me) LV = New LatestValues(Me)
ASO = Nothing
MyBase.BeginEdit() MyBase.BeginEdit()
End Sub End Sub
Friend Overrides Sub EndEdit() Friend Overrides Sub EndEdit()
LV = Nothing LV = Nothing
ASO = Nothing
MyBase.EndEdit() MyBase.EndEdit()
End Sub End Sub
Friend Overrides Sub Update() Friend Overloads Overrides Sub Update()
If LV.Exists Then If LV.Exists Then
Dim __lv As New LatestValues(Me) Dim __lv As New LatestValues(Me)
If If(Responser.Cookies?.Count, 0) > 0 Then If If(Responser.Cookies?.Count, 0) > 0 Then
Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False) Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False) And Responser.CookiesExists
If Not DownloadTimeline AndAlso (_cookiesChanged Or Dim _tokensChanged As Boolean = (Not __lv.Token.IsEmptyString And Not __lv.WwwClaim.IsEmptyString And Not __lv.AppID.IsEmptyString) And
(Not LV.Hash = __lv.Hash And Not __lv.Hash.IsEmptyString)) Then DownloadTimeline.Value = True (Not LV.Token = __lv.Token Or Not LV.WwwClaim = __lv.WwwClaim Or Not LV.AppID = __lv.AppID)
If Not DownloadSaved AndAlso (_cookiesChanged Or (Not LV.Hash2 = __lv.Hash2 And Not __lv.Hash2.IsEmptyString)) Then DownloadSaved.Value = True If _cookiesChanged Or _tokensChanged Then DownloadTimeline.Value = True
If Not DownloadStoriesTagged AndAlso ( If Not __lv.Hash.IsEmptyString And (_cookiesChanged Or _tokensChanged Or Not LV.Hash = __lv.Hash) Then DownloadTagged.Value = True
_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
End If End If
End If End If
If ASO.Changed Then
DownloadTimeline.Value = ASO.DownloadTimeline
DownloadStoriesTagged.Value = ASO.DownloadStoriesTagged
DownloadSaved.Value = ASO.DownloadSaved
End If
LV = Nothing LV = Nothing
ASO = Nothing
If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False
MyBase.Update() MyBase.Update()
End Sub End Sub
#End Region #End Region
#Region "PropertiesDataChecker" #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)})> <PropertiesDataChecker({NameOf(TaggedNotifyLimit)})>
Private Function CheckNotifyLimit(ByVal p As IEnumerable(Of PropertyData)) As Boolean Private Function CheckNotifyLimit(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then If p.ListExists Then
@@ -351,37 +308,6 @@ Namespace API.Instagram
End If End If
Return False Return False
End Function 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 #End Region
#Region "Plugin functions" #Region "Plugin functions"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider 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.Main : Return New UserData
Case Download.SavedPosts Case Download.SavedPosts
Dim u As New UserData 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 Return u
End Select End Select
Return Nothing Return Nothing
@@ -397,13 +323,7 @@ Namespace API.Instagram
#Region "Downloading" #Region "Downloading"
Friend Property SkipUntilNextSession As Boolean = False Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() Then Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso DownloadTimeline.Value
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
End Function End Function
Private ActiveJobs As Integer = 0 Private ActiveJobs As Integer = 0
Private _NextWNM As UserData.WNM = UserData.WNM.Notify Private _NextWNM As UserData.WNM = UserData.WNM.Notify
@@ -432,6 +352,10 @@ Namespace API.Instagram
_NextTagged = .TaggedCheckSession _NextTagged = .TaggedCheckSession
LastDownloadDate.Value = Now LastDownloadDate.Value = Now
LastRequestsCount.Value = .RequestsCount 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 With
End Sub End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download) 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 Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
Friend Overrides Sub OpenSettingsForm() Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Using f As New AdditionalSettingsForm(If(ASO.Changed, ASO, New SettingsExchangeOptions(Me))) Try
f.ShowDialog() Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)
If f.DialogResult = DialogResult.OK Then ASO = f.MyParameters If Not code.IsEmptyString Then Return $"https://instagram.com/p/{code}/" Else Return String.Empty
End Using Catch ex As Exception
End Sub Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "Can't open user's post", String.Empty)
End Try
End Function
#End Region #End Region
End Class End Class
End Namespace End Namespace

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

@@ -9,6 +9,7 @@
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.Messaging Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
@@ -25,12 +26,48 @@ Namespace API.Instagram
Private Const Name_TaggedChecked As String = "TaggedChecked" Private Const Name_TaggedChecked As String = "TaggedChecked"
#End Region #End Region
#Region "Declarations" #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 Private ReadOnly Property MySiteSettings As SiteSettings
Get Get
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
End Get End Get
End Property 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 LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False Private FirstLoadingDone As Boolean = False
Friend Property GetStories As Boolean Friend Property GetStories As Boolean
@@ -51,6 +88,8 @@ Namespace API.Instagram
#End Region #End Region
#Region "Initializer, loader" #Region "Initializer, loader"
Friend Sub New() Friend Sub New()
PostsKVIDs = New List(Of PostKV)
PostsToReparse = New List(Of PostKV)
End Sub End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then If Loading Then
@@ -78,48 +117,127 @@ Namespace API.Instagram
End If End If
Throw New ExitException Throw New ExitException
End Sub End Sub
Friend Sub New()
End Sub
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class 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) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim s As Sections = Sections.Timeline Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False
Try Try
LoadSavePostsKV(True)
_DownloadingInProgress = True
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
ThrowAny(Token) ThrowAny(Token)
_InstaHash = String.Empty
HasError = False HasError = False
Dim fc As Boolean = IIf(IsSavedPosts, MySiteSettings.DownloadSaved.Value, MySiteSettings.DownloadTimeline.Value) If CBool(MySiteSettings.DownloadTimeline.Value) And Not LastCursor.IsEmptyString Then
If fc And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token) DownloadData(LastCursor, s, Token)
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If fc And Not HasError Then If CBool(MySiteSettings.DownloadTimeline.Value) And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token) DownloadData(String.Empty, s, Token)
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If FirstLoadingDone Then LastCursor = String.Empty If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then If MySiteSettings.BaseAuthExists() Then
If MySiteSettings.DownloadSaved Then s = Sections.SavedPosts : DownloadPosts(Token) If CBool(MySiteSettings.DownloadTimeline.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
ElseIf MySiteSettings.BaseAuthExists() Then If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
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)
End If End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException Catch eex As ExitException
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF]", False, s) errorFound = True
Throw ex
Finally Finally
E560Thrown = False E560Thrown = False
UpdateResponser()
If Not errorFound Then LoadSavePostsKV(False)
End Try End Try
End Sub 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 Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories" Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged" Private Const TaggedFolder As String = "Tagged"
@@ -145,7 +263,7 @@ Namespace API.Instagram
"What do you want to do?", "Waiting for Instagram download...", "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") 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("Abort") With {.ToolTip = "Abort operation"},
New MsgBoxButton("Wait (disable all)") With {.ToolTip = "Wait and skip future prompts while downloading the current session."} 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" #Region "Tags"
Private TaggedChecked As Boolean = False Private TaggedChecked As Boolean = False
Friend TaggedCheckSession As Boolean = True Friend TaggedCheckSession As Boolean = True
Private DownloadedTags As Integer = 0
Private DownloadTagsLimit As Integer? = Nothing 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 Get
Return Not TaggedChecked AndAlso TaggedCheckSession AndAlso Return Not TaggedChecked AndAlso TaggedCheckSession AndAlso
CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso v > CInt(MySiteSettings.TaggedNotifyLimit.Value)
(Not v.HasValue OrElse v.Value > CInt(MySiteSettings.TaggedNotifyLimit.Value))
End Get End Get
End Property End Property
Private Function SetTagsLimit(ByVal Max As Integer, ByVal p As ANumbers) As DialogResult Private Function SetTagsLimit(ByVal Max As Integer, ByVal p As ANumbers) As DialogResult
@@ -219,8 +335,9 @@ Namespace API.Instagram
End Function End Function
Private Function TaggedContinue(ByVal TaggedCount As Integer) As DialogResult Private Function TaggedContinue(ByVal TaggedCount As Integer) As DialogResult
Dim agi As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral} 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 & Dim msg As New MMessage($"The number of already downloaded tagged posts by user [{ToString()}] is {TaggedCount.NumToString(agi)}" & vbCr &
$"This is about {(TaggedCount / 12).RoundUp.NumToString(agi)} requests." & 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.", "The tagged data download operation can take a long time.",
"Too much tagged data", "Too much tagged data",
{ {
@@ -252,40 +369,46 @@ Namespace API.Instagram
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim StoriesList As List(Of String) = Nothing Dim StoriesList As List(Of String) = Nothing
Dim StoriesRequested As Boolean = False Dim StoriesRequested As Boolean = False
Dim _DownloadComplete As Boolean = False Dim dValue% = 1
LastCursor = Cursor LastCursor = Cursor
Try Try
Do While Not _DownloadComplete Do While dValue = 1
ThrowAny(Token) ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter() ReconfigureAwaiter()
Try Try
Dim n As EContainer, nn As EContainer, node As EContainer Dim n As EContainer, nn As EContainer
Dim HasNextPage As Boolean = False Dim HasNextPage As Boolean = False
Dim Pinned As Boolean
Dim EndCursor$ = String.Empty Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TaggedCount% Dim PostIDKV As PostKV
Dim ENode() As Object = Nothing Dim ENode() As Object = Nothing
NextRequest(True) NextRequest(True)
'Check environment 'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _ If Not IsSavedPosts Then
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value) If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then GetUserId() If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID") End If
'Create query 'Create query
Select Case Section 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 & """}" Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars) 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} 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 SpecFolder = TaggedFolder
Case Sections.Stories Case Sections.Stories
If Not StoriesRequested Then If Not StoriesRequested Then
@@ -303,7 +426,7 @@ Namespace API.Instagram
If StoriesList.ListExists Then If StoriesList.ListExists Then
Continue Do Continue Do
Else Else
Throw New ExitException(_DownloadComplete) Throw New ExitException
End If End If
End Select End Select
@@ -316,78 +439,73 @@ Namespace API.Instagram
'Parsing 'Parsing
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing 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 If n.Count > 0 Then
Select Case Section Select Case Section
Case Sections.Timeline, Sections.SavedPosts Case Sections.Timeline
If n.Contains("page_info") Then With n
With n("page_info") HasNextPage = .Value("more_available").FromXML(Of Boolean)(False)
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False) EndCursor = .Value("next_max_id")
EndCursor = .Value("end_cursor") If If(.Item("items")?.Count, 0) > 0 Then
End With If Not DefaultParser(.Item("items"), Section, Token) Then Throw New ExitException
End If Else
n = n("edges").XmlIfNothing HasNextPage = False
If n.Count > 0 Then End If
For Each nn In n End With
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.Tagged Case Sections.Tagged
HasNextPage = j.Value("more_available").FromXML(Of Boolean)(False) With n
EndCursor = j.Value("next_max_id") If .Contains("page_info") Then
For Each nn In n With .Item("page_info")
PostID = $"Tagged_{nn.Value("id")}" HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) EndCursor = .Value("end_cursor")
_TempPostsList.Add(PostID) End With
ObtainMedia2(nn, PostID, SpecFolder) Else
DownloadedTags += 1 HasNextPage = False
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then Throw New ExitException(_DownloadComplete) End If
Next If If(.Item("edges")?.Count, 0) > 0 Then
If TaggedLimitsNotifications Then For Each nn In .Item("edges")
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0) 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 TaggedChecked = True
If TaggedLimitsNotifications(TaggedCount) AndAlso If TaggedContinue(PostsToReparse.Count) = DialogResult.Cancel Then Throw New ExitException
TaggedContinue(TaggedCount) = DialogResult.Cancel Then Throw New ExitException(_DownloadComplete)
End If End If
End Select End Select
Else 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 _ _TempMediaList.Count = 0 AndAlso Section = Sections.Timeline Then _
UserExists = False : Throw New ExitException(_DownloadComplete) UserExists = False : Throw New ExitException
End If End If
End Using End Using
Else Else
Throw New ExitException(_DownloadComplete) Throw New ExitException
End If End If
_DownloadComplete = True dValue = 0
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token) If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token)
Catch eex As ExitException Catch eex As ExitException
Throw eex Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
Catch ex As Exception 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 End Try
Loop Loop
Catch eex2 As ExitException Catch eex2 As ExitException
@@ -400,10 +518,10 @@ Namespace API.Instagram
End Sub End Sub
Private Sub DownloadPosts(ByVal Token As CancellationToken) Private Sub DownloadPosts(ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim _DownloadComplete As Boolean = False Dim dValue% = 1
Dim _Index% = 0 Dim _Index% = 0
Try Try
Do While Not _DownloadComplete Do While dValue = 1
ThrowAny(Token) ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter() ReconfigureAwaiter()
@@ -411,13 +529,11 @@ Namespace API.Instagram
Try Try
Dim r$ Dim r$
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
Dim _MediaObtained As Boolean If PostsToReparse.Count > 0 And _Index <= PostsToReparse.Count - 1 Then
If _SavedPostsIDs.Count > 0 And _Index <= _SavedPostsIDs.Count - 1 Then
Dim e As New ErrorsDescriber(EDP.ThrowException) Dim e As New ErrorsDescriber(EDP.ThrowException)
For i% = _Index To _SavedPostsIDs.Count - 1 For i% = _Index To PostsToReparse.Count - 1
_Index = i _Index = i
'URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1" URL = $"https://www.instagram.com/api/v1/media/{PostsToReparse(i).ID}/info/"
URL = $"https://i.instagram.com/api/v1/media/{_SavedPostsIDs(i)}/info/"
ThrowAny(Token) ThrowAny(Token)
NextRequest(((i + 1) Mod 5) = 0) NextRequest(((i + 1) Mod 5) = 0)
ThrowAny(Token) ThrowAny(Token)
@@ -427,17 +543,9 @@ Namespace API.Instagram
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
j = JsonDocument.Parse(r) j = JsonDocument.Parse(r)
If Not j Is Nothing Then If Not j Is Nothing Then
_MediaObtained = False If If(j("items")?.Count, 0) > 0 Then
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
With j("items") With j("items")
If .Count > 0 Then For Each jj In .Self : ObtainMedia(jj, PostsToReparse(i).ID) : Next
For Each jj In .Self : ObtainMedia2(jj, _SavedPostsIDs(i)) : Next
End If
End With End With
End If End If
j.Dispose() j.Dispose()
@@ -445,24 +553,79 @@ Namespace API.Instagram
End If End If
Next Next
End If End If
_DownloadComplete = True dValue = 0
Catch eex As ExitException Catch eex As ExitException
Throw eex Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
Catch ex As Exception 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 End Try
Loop Loop
Catch eex2 As ExitException Catch eex2 As ExitException
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception 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 Try
End Sub 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 #End Region
#Region "Code ID converters" #Region "Code ID converters"
Private Shared Function CodeToID(ByVal Code As String) As String Private Shared Function CodeToID(ByVal Code As String) As String
@@ -485,25 +648,7 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "Obtain Media" #Region "Obtain Media"
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String, ByVal SpecFolder As String) Private Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
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,
Optional ByVal DateObj As String = Nothing) Optional ByVal DateObj As String = Nothing)
Try Try
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0 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) DateObj = mDate(n)
With n("carousel_media").XmlIfNothing With n("carousel_media").XmlIfNothing
If .Count > 0 Then 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 If
End With End With
End Select End Select
@@ -588,22 +733,6 @@ Namespace API.Instagram
End Sub End Sub
#End Region #End Region
#Region "GetUserId" #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() Private Sub GetUserId()
Try Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={Name}",, EDP.ThrowException) 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") pid = storyID & s.Value("id")
If Not _TempPostsList.Contains(pid) Then If Not _TempPostsList.Contains(pid) Then
ThrowAny(Token) ThrowAny(Token)
ObtainMedia2(s, pid, sFolder) ObtainMedia(s, pid, sFolder)
_TempPostsList.Add(pid) _TempPostsList.Add(pid)
End If End If
Next Next
@@ -731,8 +860,7 @@ Namespace API.Instagram
Dim s As Sections = DirectCast(Section, Sections) Dim s As Sections = DirectCast(Section, Sections)
Select Case s Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
Case Sections.SavedPosts : MySiteSettings.DownloadSaved.Value = False Case Else : MySiteSettings.DownloadTagged.Value = False
Case Else : MySiteSettings.DownloadStoriesTagged.Value = False
End Select End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
End If End If
@@ -760,7 +888,7 @@ Namespace API.Instagram
t.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False) t.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False)
t.Responser = New Responser t.Responser = New Responser
t.Responser.Copy(r) t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID) t.PostsToReparse.Add(New PostKV With {.ID = PID})
t.DownloadPosts(Nothing) t.DownloadPosts(Nothing)
Return ListAddList(Nothing, t._TempMediaList) Return ListAddList(Nothing, t._TempMediaList)
End Using End Using
@@ -774,7 +902,13 @@ Namespace API.Instagram
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) 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) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #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 With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, .PersonType, .NameTrue) : End With
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
'TODELETE: remove comment Return Media.URL_BASE
Return Media.URL_BASE '$"https://www.pornhub.com/view_video.php?viewkey={Media.Post.ID}"
End Function End Function
#End Region #End Region
#Region "User options" #Region "User options"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
Dim e As UserExchangeOptions = Nothing If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions(Me)
If Not Options Is Nothing AndAlso TypeOf Options Is UserExchangeOptions Then e = Options
If e Is Nothing Then e = New UserExchangeOptions(Me)
If OpenForm Then 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 If
End Sub End Sub
#End Region #End Region

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

@@ -359,7 +359,7 @@ Namespace API.PornHub
End If End If
ThrowAny(Token) ThrowAny(Token)
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"photos downloading error") ProcessException(ex, Token, "photos downloading error")
End Try End Try
End Sub End Sub
Private Function DownloadUserPhotos_ModelHub(ByVal Token As CancellationToken) As Boolean 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")> <PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
Friend Property Token As PropertyValue Friend Property Token As PropertyValue
<PXML> Friend Property TokenLastDateUpdated As PropertyValue <PXML> Friend Property TokenLastDateUpdated As PropertyValue
<DoNotUse> Friend ReadOnly Property NoCredentialsResponser As Responser
Private Const TokenName As String = "authorization" Private Const TokenName As String = "authorization"
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -46,18 +45,6 @@ Namespace API.RedGifs
t = .Headers.Value(TokenName) t = .Headers.Value(TokenName)
If b Then .SaveSettings() If b Then .SaveSettings()
End With 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)) Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date)) TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
UrlPatternUser = "https://www.redgifs.com/users/{0}/" 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 Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Private NoCredentialsResponser As Responser
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try DownloadData(1, Token)
NoCredentialsResponser = MySettings.NoCredentialsResponser.Copy
DownloadData(1, Token)
Finally
NoCredentialsResponser.Dispose()
End Try
End Sub End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
Dim _page As Func(Of String) = Function() If(Page = 1, String.Empty, $"&page={Page}") 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}" 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 postDate$, postID$
Dim pTotal% = 0 Dim pTotal% = 0
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -70,7 +64,7 @@ Namespace API.RedGifs
End If End If
If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token) If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token)
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]",, True) ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try End Try
End Sub End Sub
#End Region #End Region
@@ -239,18 +233,8 @@ Namespace API.RedGifs
#Region "Exception" #Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, 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 Optional ByVal EObj As Object = Nothing) As Integer
Dim IsNoCredentialsResponser As Boolean = AConvert(Of Boolean)(EObj, False) Dim s As WebExceptionStatus = Responser.Client.Status
Dim s As WebExceptionStatus = -1 Dim sc As HttpStatusCode = Responser.Client.StatusCode
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
If sc = HttpStatusCode.NotFound Or s = DataGone Then If sc = HttpStatusCode.NotFound Or s = DataGone Then
UserExists = False UserExists = False
ElseIf sc = HttpStatusCode.Unauthorized Then 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 If Not img Is Nothing Then Return img
Next Next
End If End If
Return GetNullPicture(Settings.MaxLargeImageHeight) Return GetNullPicture(If(Settings.ViewMode.Value = ViewModes.IconLarge, Settings.MaxLargeImageHeight, Settings.MaxSmallImageHeight))
End Function End Function
#End Region #End Region
Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
@@ -556,7 +556,11 @@ Namespace API
"Cancel"}, vbExclamation) "Cancel"}, vbExclamation)
Dim v% Dim v%
If CollectionValue >= 0 Then 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 ElseIf Multiple Then
v = 0 v = 0
Else 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()) SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
DownloadUHD = New PropertyValue(False) DownloadUHD = New PropertyValue(False)
SavedVideosPlaylist = New PropertyValue(String.Empty, GetType(String)) SavedVideosPlaylist = New PropertyValue(String.Empty, GetType(String))
UrlPatternUser = "https://xvideos.com/{0}"
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
Initialized = True Initialized = True
@@ -105,8 +106,8 @@ Namespace API.XVIDEOS
#Region "User: get, check" #Region "User: get, check"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
Dim __user$ = User.Name.Split("_").FirstOrDefault Dim __user$ = User.Name.Split("_").FirstOrDefault
__user &= $"/{User.Name.Replace($"{User}_", String.Empty)}" __user &= $"/{User.Name.Replace($"{__user}_", String.Empty)}"
Return __user Return String.Format(UrlPatternUser, __user)
End Function End Function
Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)" Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)"
Private Const URD As String = ".*?{0}{1}" Private Const URD As String = ".*?{0}{1}"

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

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

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

@@ -114,10 +114,10 @@ Namespace API.Xhamster
End If End If
Return Nothing Return Nothing
End Function 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 Settings.UseM3U8 AndAlso MyBase.Available(What, Silent) Then
If What = ISiteSettings.Download.SavedPosts Then If What = ISiteSettings.Download.SavedPosts Then
Return If(Responser.Cookies?.Count, 0) > 0 Return Responser.CookiesExists
Else Else
Return True Return True
End If 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 Private Sub BTT_FIND_Click(sender As Object, e As EventArgs) Handles BTT_FIND.Click
Try Try
If _LatestSelected.ValueBetween(0, LIST_DOWN.Items.Count - 1) AndAlso _LatestSelected.ValueBetween(0, Downloader.Downloaded.Count - 1) Then 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)) Dim u As IUserData = Settings.GetUser(_TempUsersList(_LatestSelected), True)
If i >= 0 Then RaiseEvent UserFind(Settings.Users(i).Key) If Not u Is Nothing Then RaiseEvent UserFind(u.Key)
End If End If
Catch ex As Exception Catch ex As Exception
End Try End Try

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

@@ -115,6 +115,7 @@ Namespace DownloadObjects
Case UserMedia.Types.Video, UserMedia.Types.m3u8 Case UserMedia.Types.Video, UserMedia.Types.m3u8
infoType = UserMedia.Types.Video infoType = UserMedia.Types.Video
MyVideo = New FeedVideo(File) With {.Tag = File, .Dock = DockStyle.Fill, .ContextMenuStrip = CONTEXT_DATA} 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) TP_MAIN.Controls.Add(MyVideo, 0, 1)
BTT_CONTEXT_OPEN_MEDIA.Text &= " video" BTT_CONTEXT_OPEN_MEDIA.Text &= " video"
BTT_CONTEXT_DELETE.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 VideoLengthMs As Integer = 0
Private VideoLengthStr As String Private VideoLengthStr As String
Private MediaFile As SFile = Nothing Private MediaFile As SFile = Nothing
Friend ReadOnly HasError As Boolean = False
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
End Sub End Sub
@@ -63,7 +64,6 @@ Namespace DownloadObjects
MyVideo.BackgroundImageLayout = ImageLayout.Zoom MyVideo.BackgroundImageLayout = ImageLayout.Zoom
End If End If
Catch img_set_ex As Exception 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 & ErrorsDescriber.Execute(EDP.SendInLog, img_set_ex, "Error setting background image for media player." & vbCr &
$"File: {File}{vbCr}Image: {f}") $"File: {File}{vbCr}Image: {f}")
End Try End Try
@@ -71,8 +71,8 @@ Namespace DownloadObjects
End If End If
UpdateButtons() UpdateButtons()
Catch ex As Exception Catch ex As Exception
'TODELETE: FeedVideo initialization error
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"Media player initialization error({File})") ErrorsDescriber.Execute(EDP.SendInLog, ex, $"Media player initialization error({File})")
HasError = True
End Try End Try
End Sub End Sub
Private _Disposed As Boolean = False Private _Disposed As Boolean = False

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

@@ -106,10 +106,10 @@ Namespace Editors
'BTT_OTHER_SETTINGS 'BTT_OTHER_SETTINGS
' '
Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill 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.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS" 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.TabIndex = 2
Me.BTT_OTHER_SETTINGS.Text = "Options (F2)" Me.BTT_OTHER_SETTINGS.Text = "Options (F2)"
TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings") TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings")
@@ -121,7 +121,7 @@ Namespace Editors
'CONTAINER_MAIN.ContentPanel 'CONTAINER_MAIN.ContentPanel
' '
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TP_MAIN) 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.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0) 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.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.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 Me.TP_MAIN.TabIndex = 0
' '
'TXT_USER 'TXT_USER
@@ -182,7 +182,7 @@ Namespace Editors
Me.TP_SITE.ColumnCount = 3 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.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.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.CH_IS_CHANNEL, 0, 0)
Me.TP_SITE.Controls.Add(Me.CMB_SITE, 1, 0) Me.TP_SITE.Controls.Add(Me.CMB_SITE, 1, 0)
Me.TP_SITE.Controls.Add(Me.BTT_OTHER_SETTINGS, 2, 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.Location = New System.Drawing.Point(84, 3)
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3) Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3)
Me.CMB_SITE.Name = "CMB_SITE" 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.TabIndex = 1
Me.CMB_SITE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle 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.Location = New System.Drawing.Point(4, 290)
Me.TXT_DESCR.Multiline = True Me.TXT_DESCR.Multiline = True
Me.TXT_DESCR.Name = "TXT_DESCR" 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 Me.TXT_DESCR.TabIndex = 10
' '
'TXT_USER_FRIENDLY 'TXT_USER_FRIENDLY
@@ -469,7 +469,7 @@ Namespace Editors
Me.Name = "UserCreatorForm" Me.Name = "UserCreatorForm"
Me.ShowInTaskbar = False Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Create User" Me.Text = "Create user"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False) CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False) CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout() CONTAINER_MAIN.PerformLayout()

2
SCrawler/Editors/UserCreatorForm.vb
View File

@@ -241,6 +241,8 @@ Namespace Editors
CMB_SITE.Enabled = False CMB_SITE.Enabled = False
CH_IS_CHANNEL.Checked = User.IsChannel CH_IS_CHANNEL.Checked = User.IsChannel
If Not UserInstance Is Nothing Then If Not UserInstance Is Nothing Then
Text = $"User: {UserInstance.Name}"
If Not UserInstance.FriendlyName.IsEmptyString Then Text &= $" ({UserInstance.FriendlyName})"
TXT_USER.Enabled = False TXT_USER.Enabled = False
TXT_SPEC_FOLDER.TextBoxReadOnly = True TXT_SPEC_FOLDER.TextBoxReadOnly = True
TXT_SPEC_FOLDER.Buttons.Clear() 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, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API Imports SCrawler.API
Imports SCrawler.API.Base Imports SCrawler.API.Base
Friend Class ListImagesLoader Friend Class ListImagesLoader
Private ReadOnly Property MyList As ListView 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 User As IUserData
Friend ReadOnly LVI As ListViewItem Friend ReadOnly LVI As ListViewItem
Friend Index As Integer Friend Index As Integer
@@ -19,93 +20,106 @@ Friend Class ListImagesLoader
Return LVI.Name Return LVI.Name
End Get End Get
End Property End Property
Friend [Image] As Image Friend Sub New(ByVal u As IUserData, ByVal l As ListView)
Friend Sub New(ByVal u As IUserData, ByVal l As ListView, ByVal GetImage As Boolean)
User = u User = u
LVI = u.GetLVI(l) LVI = u.GetLVI(l)
Index = u.Index Index = u.Index
If GetImage Then Image = u.GetPicture
End Sub
Friend Sub UpdateImage()
Image = User.GetPicture
End Sub End Sub
Friend Function CompareTo(ByVal Other As UserOption) As Integer Implements IComparable(Of UserOption).CompareTo Friend Function CompareTo(ByVal Other As UserOption) As Integer Implements IComparable(Of UserOption).CompareTo
Return Index.CompareTo(Other.Index) Return Index.CompareTo(Other.Index)
End Function End Function
End Class End Structure
Friend Sub New(ByRef l As ListView) Friend Sub New(ByRef l As ListView)
MyList = l MyList = l
End Sub 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() Friend Sub Update()
Dim a As Action = Sub() If Not UpdateInProgress Then
With MyList UpdateInProgress = True
.Items.Clear() Dim a As Action = Sub()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear() With MyList
.LargeImageList = New ImageList .Items.Clear()
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear() If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.SmallImageList = New ImageList .LargeImageList = New ImageList
If Settings.ViewModeIsPicture Then If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit .SmallImageList = New ImageList
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit If Settings.ViewModeIsPicture Then
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value) .LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value) .SmallImageList.ColorDepth = ColorDepth.Depth32Bit
End If .LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value)
End With .SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value)
End Sub End If
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke End With
If Settings.Users.Count > 0 Then End Sub
Settings.Users.Sort() If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
Dim v As View = Settings.ViewMode.Value If Settings.Users.Count > 0 Then
Dim i% Settings.Users.Sort()
Dim v As View = Settings.ViewMode.Value
With MyList With MyList
MyList.BeginUpdate() MyList.BeginUpdate()
If Settings.FastProfilesLoading Then If Settings.FastProfilesLoading Then
Settings.Users.ListReindex Settings.Users.ListReindex
Dim UData As List(Of UserOption)
If Settings.ViewModeIsPicture Then UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing
UData = GetUsersWithImages() If UserDataList.ListExists Then UserDataList.Sort()
If UData.ListExists Then
UData.Sort() If UserDataList.ListExists Then
Select Case v .Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray)
Case View.LargeIcon : .LargeImageList.Images.AddRange(UData.Select(Function(u) u.Image).ToArray) If Settings.ViewModeIsPicture Then MyList.EndUpdate() : UpdateImages() Else UserDataList.Clear()
Case View.SmallIcon : .SmallImageList.Images.AddRange(UData.Select(Function(u) u.Image).ToArray)
End Select
End If End If
Else Else
UData = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList, False)).ListIfNothing Dim t As New List(Of Task)
If UData.ListExists Then UData.Sort() For Each User As IUserData In Settings.Users
End If If User.FitToAddParams Then
If Settings.ViewModeIsPicture Then
If UData.ListExists Then t.Add(Task.Run(Sub() UpdateUser(User, True)))
If Settings.ViewModeIsPicture Then Else
For i = 0 To UData.Count - 1 UpdateUser(User, True)
Select Case v End If
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)
End If End If
End If Next
Next If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear() End If
End If End With
End With MyList.EndUpdate()
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 If
End Sub End Sub
Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean) Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
@@ -172,24 +186,4 @@ Friend Class ListImagesLoader
Return False Return False
End If End If
End Function 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 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_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE = 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_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_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator() SEP_2 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = 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 '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.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 '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.ToolTipText = "Close the program without executing the script"
Me.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = False 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 'MainFrame
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) 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 Friend WithEvents BTT_DOWN_AUTOMATION_PAUSE As ToolStripMenuItem
Private WithEvents BTT_TRAY_FEED_SHOW As ToolStripMenuItem Private WithEvents BTT_TRAY_FEED_SHOW As ToolStripMenuItem
Friend WithEvents MENU_DOWN_ALL As ToolStripDropDownButton Friend WithEvents MENU_DOWN_ALL As ToolStripDropDownButton
Private WithEvents BTT_TRAY_CHANNELS As ToolStripMenuItem
End Class End Class

3
SCrawler/MainFrame.vb
View File

@@ -250,7 +250,6 @@ CloseResume:
#Region "List refill, update" #Region "List refill, update"
Friend Sub RefillList() Friend Sub RefillList()
UserListLoader.Update() UserListLoader.Update()
GC.Collect()
End Sub End Sub
Private Sub UserListUpdate(ByVal User As IUserData, ByVal Add As Boolean) Private Sub UserListUpdate(ByVal User As IUserData, ByVal Add As Boolean)
UserListLoader.UpdateUser(User, Add) 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 Is Nothing Then MyFeed = New DownloadFeedForm : AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged
If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show() If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show()
End Sub 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 If MyChannels Is Nothing Then
MyChannels = New ChannelViewForm MyChannels = New ChannelViewForm
AddHandler MyChannels.OnUsersAdded, AddressOf OnUsersAddedHandler 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: ' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2022.11.16.0")> <Assembly: AssemblyVersion("2022.12.26.0")>
<Assembly: AssemblyFileVersion("2022.11.16.0")> <Assembly: AssemblyFileVersion("2022.12.26.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

10
SCrawler/SCrawler.vbproj
View File

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

8
SCrawler/SettingsCLS.vb
View File

@@ -23,12 +23,14 @@ Friend Class SettingsCLS : Implements IDisposable
Friend Const CookieEncryptKey As String = "SCrawlerCookiesEncryptKeyword" Friend Const CookieEncryptKey As String = "SCrawlerCookiesEncryptKeyword"
Friend ReadOnly Design As XmlFile Friend ReadOnly Design As XmlFile
Private ReadOnly MyXML As XmlFile Private ReadOnly MyXML As XmlFile
Friend ReadOnly OS64 As Boolean Private ReadOnly OS64 As Boolean
Private ReadOnly FfmpegExists As Boolean Private ReadOnly FfmpegExists As Boolean
Friend ReadOnly FfmpegFile As SFile Friend ReadOnly FfmpegFile As SFile
Friend ReadOnly Property UseM3U8 As Boolean Friend ReadOnly Property UseM3U8 As Boolean
Get Get
Return OS64 And FfmpegExists 'TODELETE: SETTINGS m3u8 delete after debug ffmpeg x86
'Return OS64 And FfmpegExists
Return FfmpegExists
End Get End Get
End Property End Property
Private ReadOnly FFMPEGNotification As XMLValue(Of Boolean) Private ReadOnly FFMPEGNotification As XMLValue(Of Boolean)
@@ -259,7 +261,7 @@ Friend Class SettingsCLS : Implements IDisposable
If cUsers.ListExists Then If cUsers.ListExists Then
Dim d As New Dictionary(Of String, List(Of UserInfo)) 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 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 f.Protected AndAlso SFile.GetPath(f.File.CutPath(m - 1).Path).Exists(SFO.Path, False) Then
If Not d.ContainsKey(f.CollectionName) Then If Not d.ContainsKey(f.CollectionName) Then
d.Add(f.CollectionName, New List(Of UserInfo) From {f}) 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), .CollectionName = x.Value(UserInfo.Name_Collection),
.IsChannel = x.Value(UserInfo.Name_IsChannel).FromXML(Of Boolean)(False) .IsChannel = x.Value(UserInfo.Name_IsChannel).FromXML(Of Boolean)(False)
} }
'TODELETE: UserFinder remove old 'merge' constant
#Disable Warning BC40000 #Disable Warning BC40000
If x.Contains(UserDataBase.Name_DataMerging) Then If x.Contains(UserDataBase.Name_DataMerging) Then
u.Merged = x.Value(UserDataBase.Name_DataMerging).FromXML(Of Boolean)(False) u.Merged = x.Value(UserDataBase.Name_DataMerging).FromXML(Of Boolean)(False)
@@ -182,7 +183,7 @@ Friend Class UserFinder : Implements IDisposable
End If End If
__added = {__added, __dup, __skipped}.ListToString(vbCr.StringDup(2)) __added = {__added, __dup, __skipped}.ListToString(vbCr.StringDup(2))
If Not __added.IsEmptyString Then 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) t.Append(__added)
If Added.Count > 0 Then If Added.Count > 0 Then
t.AppendLine(vbNewLine.StringDup(2)) t.AppendLine(vbNewLine.StringDup(2))

4
SCrawler/UserInfo.vb
View File

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