Compare commits

...

7 Commits

Author SHA1 Message Date
Andy
fc226d549a 2023.1.24.1
Some Imgur albums won't download
Added icon for standalone downloader
2023-01-24 16:13:46 +03:00
Andy
602771d982 2023.1.24.0
Imgur albums not downloading
Collections: users in the collection are not banned
2023-01-24 06:05:40 +03:00
Andy
3e472b4f2b Update HowToSupport.md 2023-01-13 00:21:48 +03:00
Andy
30c3fe3b68 Update info
Update info
2023-01-12 07:38:17 +03:00
Andy
38c81b7a0b 2022.1.2.0
Redgifs: added token refresh interval; reduced interval value
Updated labels collection
PornHub: fixed bugs
Notifications: pressing any button opens SCrawler
User list loader finished
2023-01-02 18:53:24 +03:00
Andy
0fb6add751 Update UserData.vb 2022-12-27 15:19:40 +03:00
Andy
5d64b8c7ce 2022.12.27.0
XVideos: added 'Quickies'; fixed downloading.
Instagram: added more enable/disable options.
2022-12-27 15:04:56 +03:00
32 changed files with 405 additions and 294 deletions

View File

@@ -8,14 +8,16 @@ I welcome requests! Follow these steps to contribute:
1. If you have a code change suggestion, you can post a replacement code block. I also accept pull requests.
# How to build from source
1. Delete the "PersonalUtilities" project from the solution.
1. Delete the "PersonalUtilities.Notifications" project from the solution.
1. Delete the ```PersonalUtilities``` project from the solution.
1. Delete the ```PersonalUtilities.Notifications``` project from the solution.
1. Delete the ```cURL``` folder from the solution.
1. Delete the ```ffmpeg.exe``` from the solution.
1. The following libraries must be added to project references with the '**Copy to output folder**' option:
- ```PersonalUtilities.dll```
- ```PersonalUtilities.Notifications.dll```
- ```Microsoft.Toolkit.Uwp.Notifications.dll```
- ```System.ValueTuple.dll```
1. Import PersonalUtilities.Functions for the whole project.
- ```PersonalUtilities.dll```
- ```PersonalUtilities.Notifications.dll```
- ```Microsoft.Toolkit.Uwp.Notifications.dll```
- ```System.ValueTuple.dll```
1. Import ```PersonalUtilities.Functions``` for the whole project.
**Always use the correct libraries. You must download libraries from the same release date as the code commit date.**

View File

@@ -1,3 +1,45 @@
# 2023.1.24.1
*2023-01-24*
- Added
- Icon for standalone downloader
- Fixed
- (Issue #100) some Imgur albums won't download
# 2023.1.24.0
*2023-01-24*
- Fixed
- (Issue #100) Imgur albums not downloading
- When deleting a collection with the 'ban' option, users in the collection are not banned
# 2023.1.2.0
*2023-01-02*
- Added
- RedGifs: an ability to customize token refresh interval
- RedGifs: token refresh interval changed from 24 hours to 12 hours
- Updated labels collection
- Fixed
- PornHub: bug in the downloader
- PornHub: download additional non-user videos
- Reddit: bug in standalone downloader
- Fixed a bug in the user list loading algorithm
- Notifications: pressing any button opens SCrawler
# 2022.12.27.0
*2022-12-27*
- Added
- XVideos: added downloading 'Quickies'
- Instagram: added more enable/disable options
- Fixed
- XVideos not downloading (sorry, I broke it in a previous release)
# 2022.12.26.0
*2022-12-26*

2
FAQ.md
View File

@@ -42,7 +42,7 @@ A: How to request a new site you can read [here](CONTRIBUTING.md#how-to-request-
#### Q: **Twitter/Instagram download failed.**
A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-settings). If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG.
A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram). If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG.
**[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**

View File

@@ -6,6 +6,7 @@ You can support the program by:
- :repeat: make a post about my program on your profile (Reddit, Twitter, Instagram and any other social networks)
- :speech_balloon: tell your friends about the program
- :heart: like the program on this site: https://alternativeto.net/software/scrawler/about/
- :heart: like the program on this site: https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml
- suggest my program as an alternative ([on this site](https://alternativeto.net/software/scrawler/about/)) to any program you have used before
I would be very grateful for any support! :blush:

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 27 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 16 KiB

View File

@@ -1,6 +1,4 @@
# :rainbow_flag: Social networks crawler :rainbow_flag: :christmas_tree:
# :christmas_tree: Happy new year :christmas_tree:
# :rainbow_flag: Social networks crawler :rainbow_flag:
[![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)
@@ -39,18 +37,18 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- Download [saved Reddit, Twitter and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
- Add users from parsed channel
- **Advanced user management**
- **Automation** (downloading data automatically every ```X``` minutes)
- **Feed** (feed of downloaded media files)
- **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every ```X``` minutes)
- **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files)
- Labeling users
- Create download groups
- Create [download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups)
- Adding users to favorites and temporary
- Filter exists users by label or group
- [Filter exists users](https://github.com/AAndyProgram/SCrawler/wiki#view) by label or group
- Selection of media types you want to download (images only, videos only, both)
- Download a special video, image or gallery
- Making collections (grouping users into collections)
- [Download a special video](https://github.com/AAndyProgram/SCrawler/wiki#download-separate-video), image or gallery
- Making [collections](https://github.com/AAndyProgram/SCrawler/wiki#collections) (grouping users into collections)
- Specifying a user folder (for downloading data to another location)
- Changing user icons
- Changing view modes
- Changing [view modes](https://github.com/AAndyProgram/SCrawler/wiki#view)
- ...and many others...
# Supported sites
@@ -76,11 +74,11 @@ First, the program downloads the full profile. After the program downloads only
## Reddit
The program parses all user posts, obtain MD5 images hash and compares them with existing ones to remove duplicates. Then the media will be downloaded.
The program parses user posts, obtain MD5 images hash and compares them with existing ones to remove duplicates. Then the media will be downloaded.
## Other sites
The program parses all user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
The program parses user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
## How to request a new site
@@ -122,7 +120,7 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
# Installation
**Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder, copy the file ```ffmpeg.exe``` into it and enjoy.** :blush:
**Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder and enjoy.** :blush:
**Don't put program in the ```Program Files``` system folder (this is portable program and program settings are stored in the program folder)**
@@ -140,7 +138,7 @@ Read about how to make plugin [here](https://github.com/AAndyProgram/SCrawler/wi
# How to support
Read more about how to support the program [here](HowToSupport.md).
Read about how to support the program [here](HowToSupport.md).
# Settings and usage

View File

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Imgur
Namespace Declarations
Friend Module Imgur_Declarations
Friend ReadOnly PostRegex As RParams = RParams.DMS("/([\w\d]+?)(|\.[\w]{0,4})\Z", 1)
Friend ReadOnly PostRegex As RParams = RParams.DMS("/([^/]+?)(|#.*?|\.[\w]{0,4})(|\?.*?)\Z", 1)
End Module
End Namespace
Friend NotInheritable Class Envir
@@ -70,11 +70,12 @@ Namespace API.Imgur
Friend Shared Function GetVideoInfo(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.ToLower.Contains("imgur") AndAlso Not Settings.ImgurClientID.IsEmptyString Then
Dim img$ = GetImage(URL, EDP.ReturnValue)
If Not img.IsEmptyString Then
Return {New UserMedia(img)}
Dim imgList As List(Of String) = GetGallery(URL, EDP.ReturnValue)
If imgList.ListExists Then
Return imgList.Select(Function(u) New UserMedia(u))
Else
Return GetGallery(URL, EDP.ReturnValue).ListIfNothing.Select(Function(u) New UserMedia(u))
Dim img$ = GetImage(URL, EDP.ReturnValue)
If Not img.IsEmptyString Then Return {New UserMedia(img)}
End If
End If
Return Nothing

View File

@@ -9,10 +9,12 @@
Imports SCrawler.Plugin
Namespace API.Instagram
Friend Class EditorExchangeOptions
Friend Property GetTimeline As Boolean
Friend Property GetStories As Boolean
Friend Property GetTagged As Boolean
Friend Sub New(ByVal h As ISiteSettings)
With DirectCast(h, SiteSettings)
GetTimeline = CBool(.GetTimeline.Value)
GetStories = CBool(.GetStories.Value)
GetTagged = CBool(.GetTagged.Value)
End With

View File

@@ -26,6 +26,7 @@ Namespace API.Instagram
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_GET_STORIES = New System.Windows.Forms.CheckBox()
Me.CH_GET_TAGGED = New System.Windows.Forms.CheckBox()
Me.CH_GET_TIMELINE = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
@@ -39,13 +40,13 @@ Namespace API.Instagram
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(260, 53)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(260, 79)
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(260, 78)
CONTAINER_MAIN.Size = New System.Drawing.Size(260, 104)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
@@ -54,26 +55,28 @@ Namespace API.Instagram
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.Controls.Add(Me.CH_GET_STORIES, 0, 0)
TP_MAIN.Controls.Add(Me.CH_GET_TAGGED, 0, 1)
TP_MAIN.Controls.Add(Me.CH_GET_STORIES, 0, 1)
TP_MAIN.Controls.Add(Me.CH_GET_TAGGED, 0, 2)
TP_MAIN.Controls.Add(Me.CH_GET_TIMELINE, 0, 0)
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 = 3
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(260, 53)
TP_MAIN.Size = New System.Drawing.Size(260, 79)
TP_MAIN.TabIndex = 0
'
'CH_GET_STORIES
'
Me.CH_GET_STORIES.AutoSize = True
Me.CH_GET_STORIES.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_STORIES.Location = New System.Drawing.Point(4, 4)
Me.CH_GET_STORIES.Location = New System.Drawing.Point(4, 30)
Me.CH_GET_STORIES.Name = "CH_GET_STORIES"
Me.CH_GET_STORIES.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_STORIES.TabIndex = 0
Me.CH_GET_STORIES.TabIndex = 1
Me.CH_GET_STORIES.Text = "Get stories"
Me.CH_GET_STORIES.UseVisualStyleBackColor = True
'
@@ -81,26 +84,37 @@ Namespace API.Instagram
'
Me.CH_GET_TAGGED.AutoSize = True
Me.CH_GET_TAGGED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_TAGGED.Location = New System.Drawing.Point(4, 30)
Me.CH_GET_TAGGED.Location = New System.Drawing.Point(4, 56)
Me.CH_GET_TAGGED.Name = "CH_GET_TAGGED"
Me.CH_GET_TAGGED.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_TAGGED.TabIndex = 1
Me.CH_GET_TAGGED.TabIndex = 2
Me.CH_GET_TAGGED.Text = "Get tagged data"
Me.CH_GET_TAGGED.UseVisualStyleBackColor = True
'
'CH_GET_TIMELINE
'
Me.CH_GET_TIMELINE.AutoSize = True
Me.CH_GET_TIMELINE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_TIMELINE.Location = New System.Drawing.Point(4, 4)
Me.CH_GET_TIMELINE.Name = "CH_GET_TIMELINE"
Me.CH_GET_TIMELINE.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_TIMELINE.TabIndex = 0
Me.CH_GET_TIMELINE.Text = "Get Timeline"
Me.CH_GET_TIMELINE.UseVisualStyleBackColor = True
'
'OptionsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(260, 78)
Me.ClientSize = New System.Drawing.Size(260, 104)
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(276, 117)
Me.MaximumSize = New System.Drawing.Size(276, 143)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(276, 117)
Me.MinimumSize = New System.Drawing.Size(276, 143)
Me.Name = "OptionsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
@@ -116,5 +130,6 @@ Namespace API.Instagram
Private WithEvents CH_GET_STORIES As CheckBox
Private WithEvents CH_GET_TAGGED As CheckBox
Private WithEvents CH_GET_TIMELINE As CheckBox
End Class
End Namespace

View File

@@ -21,6 +21,7 @@ Namespace API.Instagram
.MyViewInitialize(True)
.AddOkCancelToolbar()
With MyExchangeOptions
CH_GET_TIMELINE.Checked = .GetTimeline
CH_GET_STORIES.Checked = .GetStories
CH_GET_TAGGED.Checked = .GetTagged
End With
@@ -29,6 +30,7 @@ Namespace API.Instagram
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyExchangeOptions
.GetTimeline = CH_GET_TIMELINE.Checked
.GetStories = CH_GET_STORIES.Checked
.GetTagged = CH_GET_TAGGED.Checked
End With

View File

@@ -111,33 +111,37 @@ Namespace API.Instagram
End Sub
#End Region
#Region "Download properties"
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(8)>
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(20)>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(9)>
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(21)>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(10)>
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(22)>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(11)>
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users"), PXML, ControlNumber(23)>
Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24)>
Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(12)>
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25)>
Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(13)>
"-1 to disable"), PXML, ControlNumber(26)>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region
#Region "Download ready"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline, stories and saved posts"), PXML, ControlNumber(6)>
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline"), PXML, ControlNumber(10)>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(7)>
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(11)>
Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(12)>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region
#Region "429 bypass"
@@ -207,10 +211,6 @@ Namespace API.Instagram
.CookiesExtractMode = Responser.CookiesExtractModes.Response
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
If Not .Cookies Is Nothing Then
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End If
End With
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
@@ -221,6 +221,7 @@ Namespace API.Instagram
IG_WWW_CLAIM = New PropertyValue(www_claim, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v))
DownloadTimeline = New PropertyValue(True)
DownloadStories = New PropertyValue(True)
DownloadTagged = New PropertyValue(False)
RequestsWaitTimer = New PropertyValue(1000)
@@ -230,6 +231,7 @@ Namespace API.Instagram
SleepTimerOnPostsLimit = New PropertyValue(60000)
SleepTimerOnPostsLimitProvider = New TimersChecker(10000)
GetTimeline = New PropertyValue(True)
GetStories = New PropertyValue(False)
GetTagged = New PropertyValue(False)
TaggedNotifyLimit = New PropertyValue(200)
@@ -246,48 +248,6 @@ Namespace API.Instagram
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
ImageVideoContains = "instagram.com"
End Sub
Private Structure LatestValues
Friend Hash As String
Friend Token As String
Friend AppID As String
Friend WwwClaim As String
Friend Exists As Boolean
Friend Sub New(ByVal Source As SiteSettings)
Exists = True
With Source
Hash = AConvert(Of String)(.HashTagged.Value, String.Empty)
With .Responser
Token = .Headers.Value(Header_CSRF_TOKEN)
AppID = .Headers.Value(Header_IG_APP_ID)
WwwClaim = .Headers.Value(Header_IG_WWW_CLAIM)
End With
End With
End Sub
End Structure
Private LV As LatestValues = Nothing
Friend Overrides Sub BeginEdit()
LV = New LatestValues(Me)
MyBase.BeginEdit()
End Sub
Friend Overrides Sub EndEdit()
LV = Nothing
MyBase.EndEdit()
End Sub
Friend Overloads Overrides Sub Update()
If LV.Exists Then
Dim __lv As New LatestValues(Me)
If If(Responser.Cookies?.Count, 0) > 0 Then
Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False) And Responser.CookiesExists
Dim _tokensChanged As Boolean = (Not __lv.Token.IsEmptyString And Not __lv.WwwClaim.IsEmptyString And Not __lv.AppID.IsEmptyString) And
(Not LV.Token = __lv.Token Or Not LV.WwwClaim = __lv.WwwClaim Or Not LV.AppID = __lv.AppID)
If _cookiesChanged Or _tokensChanged Then DownloadTimeline.Value = True
If Not __lv.Hash.IsEmptyString And (_cookiesChanged Or _tokensChanged Or Not LV.Hash = __lv.Hash) Then DownloadTagged.Value = True
End If
End If
LV = Nothing
If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False
MyBase.Update()
End Sub
#End Region
#Region "PropertiesDataChecker"
<PropertiesDataChecker({NameOf(TaggedNotifyLimit)})>

View File

@@ -21,6 +21,7 @@ Namespace API.Instagram
#Region "XML Names"
Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetTimeline As String = "GetTimeline"
Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked"
@@ -70,16 +71,18 @@ Namespace API.Instagram
Private ReadOnly PostsToReparse As List(Of PostKV)
Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False
Friend Property GetTimeline As Boolean = True
Friend Property GetStories As Boolean
Friend Property GetTaggedData As Boolean
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(HOST.Source) With {.GetStories = GetStories, .GetTagged = GetTaggedData}
Return New EditorExchangeOptions(HOST.Source) With {.GetTimeline = GetTimeline, .GetStories = GetStories, .GetTagged = GetTaggedData}
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
GetTimeline = .GetTimeline
GetStories = .GetStories
GetTaggedData = .GetTagged
End With
@@ -95,12 +98,14 @@ Namespace API.Instagram
If Loading Then
LastCursor = Container.Value(Name_LastCursor)
FirstLoadingDone = Container.Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = Container.Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetStories = Container.Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetTaggedData = Container.Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = Container.Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
Else
Container.Add(Name_LastCursor, LastCursor)
Container.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
Container.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
Container.Add(Name_GetStories, GetStories.BoolToInteger)
Container.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
@@ -197,21 +202,22 @@ Namespace API.Instagram
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
ThrowAny(Token)
HasError = False
If CBool(MySiteSettings.DownloadTimeline.Value) And Not LastCursor.IsEmptyString Then
Dim dt As Func(Of Boolean) = Function() (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts
If dt.Invoke And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If CBool(MySiteSettings.DownloadTimeline.Value) And Not HasError Then
If dt.Invoke And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If FirstLoadingDone Then LastCursor = String.Empty
If MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadTimeline.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
@@ -392,7 +398,6 @@ Namespace API.Instagram
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
End If
'Create query
Select Case Section
Case Sections.Timeline

View File

@@ -41,6 +41,7 @@ Namespace API.PornHub
Friend Sub New()
MyBase.New("PornHub", "pornhub.com")
Responser.CurlPath = $"cURL\curl.exe"
Responser.CurlArgumentsRight = "--ssl-no-revoke"
CurlPathExists = Responser.CurlPath.Exists
Responser.DeclaredError = EDP.ThrowException

View File

@@ -210,6 +210,7 @@ Namespace API.PornHub
If __continue And Not __videoDone Then
Do While DownloadUserVideos(page, Token) = DataDownloaded And page < 100 : page += 1 : Loop
End If
If _TempMediaList.Count > 0 Then _TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre)
End If
Responser.Method = "GET"
@@ -256,7 +257,7 @@ Namespace API.PornHub
If PersonType = PersonTypeUser And r.Contains(HtmlPageNotFoundVideo) Then Return DataDownloaded_NotFound
Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexVideo_Video_All}, {1, 2})
Dim lw As List(Of UserVideo) = Nothing
If Not PersonType = PersonTypeUser Then RegexFields(Of UserVideo)(r, {RegexVideo_Video_Wrong}, RegexVideo_Video_Wrong_Fields)
If Not PersonType = PersonTypeUser Then lw = RegexFields(Of UserVideo)(r, {RegexVideo_Video_Wrong}, RegexVideo_Video_Wrong_Fields)
If l.ListExists Then
If lw.ListExists Then l.ListWithRemove(lw)
If l.Count > 0 Then

View File

@@ -662,6 +662,7 @@ Namespace API.Reddit
Try
If Not URL.IsEmptyString Then
Using r As New UserData
r.SetEnvironment(Settings(RedditSiteKey), Nothing, False, False)
r.Responser = New Responser
r.Responser.Copy(resp)
r.ParsePost(URL)

View File

@@ -9,10 +9,10 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
@@ -30,10 +30,38 @@ Namespace API.RedGifs
Return My.Resources.SiteResources.RedGifsPic_32
End Get
End Property
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
Friend Property Token As PropertyValue
<PXML> Friend Property TokenLastDateUpdated As PropertyValue
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), ControlNumber(1)>
Friend ReadOnly Property Token As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization"
#Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token", AllowNull:=False, LeftOffset:=120),
PXML, ControlNumber(0)>
Friend ReadOnly Property TokenUpdateInterval As PropertyValue
Private Class TokenIntervalProvider : Implements IFieldsCheckerProvider
Private Property ErrorMessage As String Implements IFieldsCheckerProvider.ErrorMessage
Private Property Name As String Implements IFieldsCheckerProvider.Name
Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
TypeError = False
ErrorMessage = String.Empty
If Not ACheck(Of Integer)(Value) Then
TypeError = True
ElseIf CInt(Value) > 0 Then
Return Value
Else
ErrorMessage = $"The value of [{Name}] field must be greater than or equal to 1"
End If
Return Nothing
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("[GetFormat] is not available in the context of [TokenIntervalProvider]")
End Function
End Class
<Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region
#End Region
#Region "Initializer"
Friend Sub New()
@@ -47,6 +75,8 @@ Namespace API.RedGifs
End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer))
TokenUpdateIntervalProvider = New TokenIntervalProvider
UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs"
@@ -61,7 +91,7 @@ Namespace API.RedGifs
#Region "Token updaters"
Friend Function UpdateTokenIfRequired() As Boolean
Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing)
If Not d.HasValue OrElse d.Value < Now.AddDays(-1) Then
If Not d.HasValue OrElse d.Value < Now.AddMinutes(-CInt(TokenUpdateInterval.Value)) Then
Return UpdateToken()
Else
Return True

View File

@@ -104,10 +104,13 @@ Namespace API.XVIDEOS
End Function
#End Region
#Region "User: get, check"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
Friend Function GetUserUrlPart(ByVal User As UserData) As String
Dim __user$ = User.Name.Split("_").FirstOrDefault
__user &= $"/{User.Name.Replace($"{__user}_", String.Empty)}"
Return String.Format(UrlPatternUser, __user)
Return __user
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
Return String.Format(UrlPatternUser, GetUserUrlPart(User))
End Function
Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)"
Private Const URD As String = ".*?{0}{1}"

View File

@@ -45,16 +45,7 @@ Namespace API.XVIDEOS
UseInternalM3U8Function = True
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not Settings.UseM3U8 Then
'TODELETE: XVideos m3u8 delete after debug ffmpeg x86
'If Not Settings.OS64 Then
' MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
'Else
' 'MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
'End If
MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
Exit Sub
End If
If Not Settings.UseM3U8 Then MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found" : Exit Sub
If IsSavedPosts Then
If Not ACheck(MySettings.SavedVideosPlaylist.Value) Then Throw New ArgumentNullException("SavedVideosPlaylist", "Playlist of saved videos cannot be null")
DownloadSavedVideos(Token)
@@ -65,49 +56,63 @@ Namespace API.XVIDEOS
Private Sub DownloadUserVideo(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim NextPage% = 0
Dim r$
Dim NextPage%, d%
Dim limit% = If(DownloadTopCount, -1)
Dim r$, n$
Dim j As EContainer = Nothing
Dim jj As EContainer
Dim user$ = MySettings.GetUserUrl(Me, False)
Dim user$ = MySettings.GetUserUrlPart(Me)
Dim p As UserMedia
Dim EnvirSet As Boolean = False
Do
ThrowAny(Token)
URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}"
r = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
j = JsonDocument.Parse(r).XmlIfNothing
With j
If .Contains("videos") Then
With .Item("videos")
If .Count > 0 Then
NextPage += 1
For Each jj In .Self
p = New UserMedia With {
.Post = jj.Value("id"),
.URL = $"https://www.xvideos.com/{jj.Value("u").StringTrimStart("/")}"
}
If Not p.Post.ID.IsEmptyString And Not jj.Value("u").IsEmptyString Then
If Not _TempPostsList.Contains(p.Post.ID) Then
_TempPostsList.Add(p.Post.ID)
_TempMediaList.Add(p)
Else
Exit Do
If ID.IsEmptyString Then GetUserID()
For i% = 0 To 1
If i = 1 And ID.IsEmptyString Then Exit For
NextPage = 0
d = 0
n = IIf(i = 0, "u", "url")
Do
ThrowAny(Token)
If i = 0 Then
URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}"
Else 'Quickies
URL = $"https://www.xvideos.com/quickies-api/profilevideos/all/none/N/{ID}/{NextPage}"
End If
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
j = JsonDocument.Parse(r).XmlIfNothing
With j
If .Contains("videos") Then
With .Item("videos")
If .Count > 0 Then
NextPage += 1
For Each jj In .Self
p = New UserMedia With {
.Post = jj.Value("id"),
.URL = $"https://www.xvideos.com/{jj.Value(n).StringTrimStart("/")}"
}
If Not p.Post.ID.IsEmptyString And Not jj.Value(n).IsEmptyString Then
If Not _TempPostsList.Contains(p.Post.ID) Then
_TempPostsList.Add(p.Post.ID)
_TempMediaList.Add(p)
d += 1
If limit > 0 And d = limit Then Exit Do
Else
Exit Do
End If
End If
End If
Next
Continue Do
End If
End With
End If
End With
End If
If Not j Is Nothing Then j.Dispose()
Exit Do
Loop While NextPage < 100
Next
Continue Do
End If
End With
End If
End With
End If
If Not j Is Nothing Then j.Dispose()
Exit Do
Loop While NextPage < 100
Next
If Not j Is Nothing Then j.Dispose()
@@ -130,6 +135,10 @@ Namespace API.XVIDEOS
If _TempMediaList.ListExists Then _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End Try
End Sub
Private Sub GetUserID()
Dim r$ = Responser.GetResponse($"https://www.xvideos.com/{MySettings.GetUserUrlPart(Me)}",, EDP.ReturnValue)
If Not r.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""id_user"":(\d+)", 1, EDP.ReturnValue))
End Sub
Private Sub DownloadSavedVideos(ByVal Token As CancellationToken)
Dim URL$ = MySettings.SavedVideosPlaylist.Value
Try

View File

@@ -143,7 +143,8 @@ Namespace DownloadObjects
''' <returns>True to activate</returns>
Friend Function Open(ByVal _Key As String) As Boolean
If Not User Is Nothing Then
If Key = _Key Then
If KeyDismiss = _Key Then
ElseIf Key = _Key Then
Return True
ElseIf KeyFolder = _Key Then
User.OpenFolder()
@@ -152,6 +153,8 @@ Namespace DownloadObjects
ElseIf Images.ContainsKey(_Key) Then
Images(_Key).Open(, EDP.None)
End If
Else
Return True
End If
Return False
End Function
@@ -548,10 +551,12 @@ Namespace DownloadObjects
UserKeys.Last.ShowNotification()
End If
End Sub
Friend Function NotificationClicked(ByVal Key As String) As Boolean
Friend Function NotificationClicked(ByVal Key As String, ByRef Found As Boolean, ByRef ActivateForm As Boolean) As Boolean
Dim i% = UserKeys.IndexOf(Key)
If i >= 0 Then
MainFrameObj.FocusUser(UserKeys(i).IUserDataKey, UserKeys(i).Open(Key))
Found = True
ActivateForm = UserKeys(i).Open(Key)
MainFrameObj.FocusUser(UserKeys(i).IUserDataKey, ActivateForm)
Return True
Else
Return False

View File

@@ -52,8 +52,13 @@ Namespace DownloadObjects
Return Plans.Count
End Get
End Property
Friend Function NotificationClicked(ByVal Key As String) As Boolean
Return Count > 0 AndAlso Plans.Exists(Function(p) p.NotificationClicked(Key))
Friend Function NotificationClicked(ByVal Key As String, ByRef Found As Boolean, ByRef ActivateForm As Boolean) As Boolean
If Count > 0 Then
For Each plan As AutoDownloader In Plans
If plan.NotificationClicked(Key, Found, ActivateForm) Then Return True
Next
End If
Return False
End Function
Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me

View File

@@ -34,9 +34,6 @@ Namespace DownloadObjects.Groups
End If
GroupsList.ListReindex
End Sub
Friend Function GetLabels() As List(Of String)
Return ListAddList(Nothing, GroupsList.SelectMany(Function(g) g.Labels), LAP.NotContainsOnly)
End Function
Default Friend ReadOnly Property Item(ByVal Index As Integer) As DownloadGroup Implements IMyEnumerator(Of DownloadGroup).MyEnumeratorObject
Get
Return GroupsList(Index)

View File

@@ -151,10 +151,10 @@ Namespace DownloadObjects
Me.Controls.Add(Me.LIST_VIDEOS)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.Icon = Global.SCrawler.My.Resources.Resources.ArrowDownIcon_Blue_24
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(540, 400)
Me.Name = "VideosDownloaderForm"
Me.ShowIcon = False
Me.Text = "Download videos"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()

View File

@@ -72,7 +72,7 @@ Friend Class LabelsForm
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
Try
LabelsList.ListAddList(CMB_LABELS.Items.CheckedItems.Select(Function(l) CStr(l.Value(0))), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
If _AnyLabelAdd And _Source Is Nothing Then Settings.Labels.Update()
If _Source Is Nothing Then Settings.Labels.Update()
MyDefs.CloseForm()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Label selection")

View File

@@ -25,30 +25,16 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
Friend ReadOnly Property Current As XMLValuesCollection(Of String)
Friend ReadOnly Property Excluded As XMLValuesCollection(Of String)
Friend ReadOnly Property ExcludedIgnore As XMLValue(Of Boolean)
Private ReadOnly Property SourceXML As XmlFile
Friend Sub New(ByRef x As XmlFile)
SourceXML = x
LabelsList = New List(Of String)
NewLabels = New List(Of String)
If LabelsFile.Exists Then LabelsList.ListAddList(IO.File.ReadAllLines(LabelsFile), LAP.NotContainsOnly)
Current = New XMLValuesCollection(Of String)(XMLValueBase.ListModes.String, "LatestSelectedLabels", x) With {.ListAddParameters = LAP.NotContainsOnly}
Excluded = New XMLValuesCollection(Of String)(XMLValueBase.ListModes.String, "LatestExcludedLabels", x) With {.ListAddParameters = LAP.NotContainsOnly}
ExcludedIgnore = New XMLValue(Of Boolean)("LatestExcludedLabelsIgnore", False, x)
End Sub
Friend Sub Verify()
SourceXML.BeginUpdate()
Dim r As Predicate(Of String) = Function(l) Not LabelsList.Contains(l)
Dim c% = Current.Count
If c > 0 Then
Current.ValuesList.RemoveAll(r)
If Not Current.Count = c Then Current.Update()
End If
c = Excluded.Count
If c > 0 Then
Excluded.ValuesList.RemoveAll(r)
If Not c = Excluded.Count Then Excluded.Update()
End If
SourceXML.EndUpdate()
Dim lp As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier)
If Current.Count > 0 Then LabelsList.ListAddList(Current, lp)
If Excluded.Count > 0 Then LabelsList.ListAddList(Excluded, lp)
End Sub
Friend ReadOnly Property ToList As List(Of String)
Get
@@ -69,10 +55,14 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
LabelsList.Clear()
NewLabels.Clear()
End Sub
Friend Sub Update()
Friend Sub Update(Optional ByVal Force As Boolean = False)
If LabelsList.Count > 0 Then
LabelsList.Sort()
TextSaver.SaveTextToFile(LabelsList.ListToString(vbNewLine), LabelsFile, True, False, EDP.SendInLog)
If NewLabelsExists Or Force Then
If LabelsList.Contains(NoParsedUser) Then LabelsList.Remove(NoParsedUser)
LabelsList.Sort()
TextSaver.SaveTextToFile(LabelsList.ListToString(vbNewLine), LabelsFile, True, False, EDP.SendInLog)
If NewLabels.Count > 0 Then NewLabels.Clear()
End If
Else
LabelsFile.Delete(, Settings.DeleteMode, EDP.SendInLog)
End If

View File

@@ -40,20 +40,26 @@ Friend Class ListImagesLoader
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
Try
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
Catch iex As ArgumentOutOfRangeException
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[ListImagesLoader.UpdateImages]")
End Try
If Not ar Is Nothing Then MyList.EndInvoke(ar)
UpdateInProgress = False
End Sub
If MyList.InvokeRequired Then
ar = MyList.BeginInvoke(a)
@@ -65,62 +71,81 @@ Friend Class ListImagesLoader
ImageThread.Start()
End If
End Sub
Private Sub InterruptUpdate()
Try
If UserDataList.ListExists Then UserDataList.Clear() : Application.DoEvents()
If If(ImageThread?.IsAlive, False) Then ImageThread.Abort() : Application.DoEvents()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[ListImagesLoader.InterruptUpdate]")
End Try
End Sub
Friend Sub Update()
If Not UpdateInProgress Then
UpdateInProgress = True
Dim a As Action = Sub()
With MyList
.Items.Clear()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.LargeImageList = New ImageList
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.SmallImageList = New ImageList
If Settings.ViewModeIsPicture Then
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value)
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value)
End If
End With
End Sub
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
If Settings.Users.Count > 0 Then
Settings.Users.Sort()
Dim v As View = Settings.ViewMode.Value
Try
If UpdateInProgress Then InterruptUpdate()
If Not UpdateInProgress Then
UpdateInProgress = True
Dim a As Action = Sub()
With MyList
.Items.Clear()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.LargeImageList = New ImageList
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.SmallImageList = New ImageList
If Settings.ViewModeIsPicture Then
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value)
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value)
End If
End With
End Sub
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
If Settings.Users.Count > 0 Then
Settings.Users.Sort()
Dim v As View = Settings.ViewMode.Value
With MyList
MyList.BeginUpdate()
With MyList
MyList.BeginUpdate()
If Settings.FastProfilesLoading Then
Settings.Users.ListReindex
If Settings.FastProfilesLoading Then
Settings.Users.ListReindex
UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing
If UserDataList.ListExists Then UserDataList.Sort()
UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing
If UserDataList.ListExists Then UserDataList.Sort()
If UserDataList.ListExists Then
.Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray)
If Settings.ViewModeIsPicture Then MyList.EndUpdate() : UpdateImages() Else UserDataList.Clear()
End If
Else
Dim t As New List(Of Task)
For Each User As IUserData In Settings.Users
If User.FitToAddParams Then
If UserDataList.ListExists Then
.Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray)
If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True)))
MyList.EndUpdate()
UpdateImages()
Else
UpdateUser(User, True)
UserDataList.Clear()
UpdateInProgress = False
End If
End If
Next
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
End If
End With
MyList.EndUpdate()
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
Next
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
UpdateInProgress = False
End If
End With
MyList.EndUpdate()
End If
Else
MsgBoxE({"User list update aborted. Click the 'Refresh' button to refresh the user list.", "Update user list"}, vbExclamation)
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
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[ListImagesLoader.Update]")
End Try
End Sub
Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
Try

View File

@@ -121,10 +121,10 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_PAUSE_AUTOMATION = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_SILENT_MODE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_FEED_SHOW = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CHANNELS = 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_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CHANNELS = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
@@ -419,7 +419,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'BTT_DOWN_VIDEO
'
Me.BTT_DOWN_VIDEO.AutoToolTip = True
Me.BTT_DOWN_VIDEO.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.BTT_DOWN_VIDEO.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_DOWN_VIDEO.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DOWN_VIDEO.Name = "BTT_DOWN_VIDEO"
Me.BTT_DOWN_VIDEO.Size = New System.Drawing.Size(231, 22)
@@ -856,6 +856,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_FEED_SHOW.Text = "Feed"
Me.BTT_TRAY_FEED_SHOW.ToolTipText = "Show feed of recently downloaded data." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+Click the tray icon to show the feed" &
"."
'
'BTT_TRAY_CHANNELS
'
Me.BTT_TRAY_CHANNELS.Image = Global.SCrawler.My.Resources.SiteResources.RedditPic_512
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"
'
'BTT_TRAY_SHOW_HIDE
'
@@ -885,13 +892,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_CLOSE_NO_SCRIPT.ToolTipText = "Close the program without executing the script"
Me.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = False
'
'BTT_TRAY_CHANNELS
'
Me.BTT_TRAY_CHANNELS.Name = "BTT_TRAY_CHANNELS"
Me.BTT_TRAY_CHANNELS.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_CHANNELS.Text = "Channels"
Me.BTT_TRAY_CHANNELS.Image = Global.SCrawler.My.Resources.SiteResources.RedditPic_512
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)

View File

@@ -88,32 +88,33 @@ Public Class MainFrame
LIST_PROFILES.ShowGroups = .UseGrouping
ApplyViewPattern(.ViewMode.Value)
AddHandler .Labels.NewLabelAdded, AddressOf UpdateLabelsGroups
UserListLoader = New ListImagesLoader(LIST_PROFILES)
RefillList()
UpdateLabelsGroups()
SetShowButtonsCheckers(.ShowingMode.Value)
CheckVersion(False)
BTT_SITE_ALL.Checked = .SelectedSites.Count = 0
BTT_SITE_SPECIFIC.Checked = .SelectedSites.Count > 0
BTT_SHOW_LIMIT_DATES_NOT.Tag = ShowingDates.Not
BTT_SHOW_LIMIT_DATES_NOT.Checked = .ViewDateMode.Value = ShowingDates.Not
BTT_SHOW_LIMIT_DATES_IN.Tag = ShowingDates.In
BTT_SHOW_LIMIT_DATES_IN.Checked = .ViewDateMode.Value = ShowingDates.In
With .Groups
AddHandler .Added, AddressOf GROUPS_Added
AddHandler .Deleted, AddressOf GROUPS_Deleted
AddHandler .Updated, AddressOf GROUPS_Updated
If .Count > 0 Then
For Each ugroup As Groups.DownloadGroup In Settings.Groups : GROUPS_Added(ugroup) : Next
End If
End With
.Automation = New Scheduler
AddHandler .Groups.Updated, AddressOf .Automation.GROUPS_Updated
AddHandler .Groups.Deleted, AddressOf .Automation.GROUPS_Deleted
AddHandler .Automation.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons
If .Automation.Count > 0 Then .Labels.AddRange(.Automation.GetGroupsLabels, False) : .Labels.Update()
_UFinit = False
Await .Automation.Start(True)
End With
UserListLoader = New ListImagesLoader(LIST_PROFILES)
RefillList()
UpdateLabelsGroups()
SetShowButtonsCheckers(Settings.ShowingMode.Value)
CheckVersion(False)
BTT_SITE_ALL.Checked = Settings.SelectedSites.Count = 0
BTT_SITE_SPECIFIC.Checked = Settings.SelectedSites.Count > 0
BTT_SHOW_LIMIT_DATES_NOT.Tag = ShowingDates.Not
BTT_SHOW_LIMIT_DATES_NOT.Checked = Settings.ViewDateMode.Value = ShowingDates.Not
BTT_SHOW_LIMIT_DATES_IN.Tag = ShowingDates.In
BTT_SHOW_LIMIT_DATES_IN.Checked = Settings.ViewDateMode.Value = ShowingDates.In
With Settings.Groups
AddHandler .Added, AddressOf GROUPS_Added
AddHandler .Deleted, AddressOf GROUPS_Deleted
AddHandler .Updated, AddressOf GROUPS_Updated
If .Count > 0 Then
For Each ugroup As Groups.DownloadGroup In Settings.Groups : GROUPS_Added(ugroup) : Next
End If
End With
Settings.Automation = New Scheduler
AddHandler Settings.Groups.Updated, AddressOf Settings.Automation.GROUPS_Updated
AddHandler Settings.Groups.Deleted, AddressOf Settings.Automation.GROUPS_Deleted
AddHandler Settings.Automation.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons
_UFinit = False
Await Settings.Automation.Start(True)
UpdatePauseButtonsVisibility()
GoTo EndFunction
FormClosingInvoker:
@@ -1395,6 +1396,7 @@ ResumeDownloadingOperation:
If result < 6 Then
Dim collectionResult% = -1
Dim tmpResult%
Dim tmpUserNames As New List(Of String)
Dim IsMultiple As Boolean = users.Count > 1
Dim removedUsers As New List(Of String)
Dim keepData As Boolean = Not (result Mod 2) = 0
@@ -1429,10 +1431,18 @@ ResumeDownloadingOperation:
removedUsers.Add(ugn(user))
user.Dispose()
Else
If banUser Then
tmpUserNames.Clear()
If user.IsCollection Then
tmpUserNames.ListAddList(DirectCast(user, UserDataBind).Collections.Select(Function(u) u.Name), l)
Else
tmpUserNames.Add(user.Name)
End If
End If
tmpResult = user.Delete(IsMultiple, collectionResult)
If user.IsCollection And collectionResult = -1 Then collectionResult = tmpResult
If tmpResult > 0 Then
If banUser Then Settings.BlackList.ListAddValue(New UserBan(user.Name, reason), l) : b = True
If banUser And tmpUserNames.Count > 0 Then Settings.BlackList.ListAddList(tmpUserNames.Select(Function(u) New UserBan(u, reason)), l) : b = True
RemoveUserFromList(user)
removedUsers.Add(ugn(user))
Else

View File

@@ -74,14 +74,18 @@ Friend Class MainFrameObjects
End Sub
Private Sub Notificator_OnClicked(ByVal Key As String) Handles Notificator.OnClicked
If Not Key.IsEmptyString Then
Dim found As Boolean = False
Dim activateForm As Boolean = False
If Key.StartsWith(NotificationInternalKey) Then
Select Case Key
Case $"{NotificationInternalKey}_{NotifyObj.Channels}" : MF.MyChannels.FormShowS()
Case $"{NotificationInternalKey}_{NotifyObj.SavedPosts}" : MF.MySavedPosts.FormShowS()
Case Else : Focus(True)
End Select
ElseIf Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key) Then
ElseIf Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key, found, activateForm) Then
Focus(True)
ElseIf found Then
Focus(activateForm)
Else
Focus(True)
End If

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Runtime.CompilerServices
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Forms.Toolbars
@@ -147,6 +148,14 @@ Friend Module MainMod
Return $"{If(Host?.Name, String.Empty)}{Opt}"
End If
End Function
<Extension> Friend Function GetGroupsLabels(Of T As Groups.IGroup)(ByVal Groups As IEnumerable(Of T)) As List(Of String)
If Groups.ListExists Then
Return ListAddList(Nothing, Groups.SelectMany(Function(g) g.Labels), LAP.NotContainsOnly).
ListAddList(Groups.SelectMany(Function(g) g.LabelsExcluded), LAP.NotContainsOnly)
Else
Return Nothing
End If
End Function
#Region "Standalone video download functions"
Friend Function GetCurrentBuffer() As String
Dim b$ = BufferText

View File

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

View File

@@ -23,13 +23,10 @@ Friend Class SettingsCLS : Implements IDisposable
Friend Const CookieEncryptKey As String = "SCrawlerCookiesEncryptKeyword"
Friend ReadOnly Design As XmlFile
Private ReadOnly MyXML As XmlFile
Private ReadOnly OS64 As Boolean
Private ReadOnly FfmpegExists As Boolean
Friend ReadOnly FfmpegFile As SFile
Friend ReadOnly Property UseM3U8 As Boolean
Get
'TODELETE: SETTINGS m3u8 delete after debug ffmpeg x86
'Return OS64 And FfmpegExists
Return FfmpegExists
End Get
End Property
@@ -69,7 +66,6 @@ Friend Class SettingsCLS : Implements IDisposable
End Sub
Friend Sub New()
RemoveUnusedPlugins()
OS64 = Environment.Is64BitOperatingSystem
FfmpegFile = "ffmpeg.exe"
FfmpegExists = FfmpegFile.Exists
@@ -83,7 +79,7 @@ Friend Class SettingsCLS : Implements IDisposable
LastCollections = New List(Of String)
FFMPEGNotification = New XMLValue(Of Boolean)("FFMPEGNotification", True, MyXML)
If OS64 And Not FfmpegExists Then
If Not FfmpegExists Then
If FFMPEGNotification.Value AndAlso MsgBoxE(New MMessage("[ffmpeg.exe] is missing", "ffmpeg.exe",
{"OK", New MsgBoxButton("Disable notification") With {
.IsDialogResultButton = False, .ToolTip = "Disable ffmpeg missing notification"}}, vbExclamation) With {
@@ -123,7 +119,7 @@ Friend Class SettingsCLS : Implements IDisposable
If tmpPluginList.ListExists Then Plugins.AddRange(tmpPluginList)
CookiesEncrypted.Value = True
FastProfilesLoading = New XMLValue(Of Boolean)("FastProfilesLoading", False, MyXML)
FastProfilesLoading = New XMLValue(Of Boolean)("FastProfilesLoading", True, MyXML)
MaxLargeImageHeight = New XMLValue(Of Integer)("MaxLargeImageHeight", 150, MyXML)
MaxSmallImageHeight = New XMLValue(Of Integer)("MaxSmallImageHeight", 15, MyXML)
DownloadOpenInfo = New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenInfo", "OpenAgain", False, False, MyXML)
@@ -210,7 +206,7 @@ Friend Class SettingsCLS : Implements IDisposable
Labels = New LabelsKeeper(MyXML)
Groups = New Groups.DownloadGroupCollection
Labels.AddRange(Groups.GetLabels, False)
Labels.AddRange(Groups.GetGroupsLabels, False)
MyXML.EndUpdate()
If MyXML.ChangesDetected Then MyXML.Sort() : MyXML.UpdateData()
@@ -321,11 +317,8 @@ Friend Class SettingsCLS : Implements IDisposable
If NeedUpdate Then UpdateUsersList()
End If
If Users.Count > 0 Then
Dim tul As IEnumerable(Of String) = Users.SelectMany(Function(u) u.Labels)
Labels.AddRange(tul, False)
If Labels.NewLabelsExists Or
(tul.ListExists AndAlso Not tul.Contains(LabelsKeeper.NoParsedUser) AndAlso Labels.Remove(LabelsKeeper.NoParsedUser)) Then _
Labels.Update() : Labels.NewLabels.Clear() : Labels.Verify()
Labels.AddRange(Users.SelectMany(Function(u) u.Labels), False)
Labels.Update()
End If
Catch ex As Exception
End Try