Compare commits

..

8 Commits

Author SHA1 Message Date
Andy
1f1148020c 2023.1.27.0
Plugins: added 'Interaction' to 'Provider' attribute; added 'IPropertyProvider' interface
Hosts: update classes to work with new options
Instagram: fixed pinned post reload
Twitter: advanced options for GIFs
UserCreatorForm: change icon based on the selected site
UserSearchForm: change search function
2023-01-27 16:43:57 +03:00
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
50 changed files with 1020 additions and 354 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,59 @@
# 2023.1.27.0
*2023-01-27*
- Added
- Advanced Twitter options for GIFs
- Changing the icon of the user creation form based on the selected site
- Fixed
- Pinned Instagram posts reload every time
- Plugins
- Added
- `Interaction` option to the `Provider` attribute
- `IPropertyProvider` interface
# 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

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 19 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

@@ -100,6 +100,8 @@ Namespace Plugin.Attributes
''' <see langword="False"/> - only for conversion
''' </summary>
Public FieldsChecker As Boolean = False
''' <summary>Interaction with changing text field. Default: <see langword="False"/></summary>
Public Interaction As Boolean = False
''' <summary>Initialize a new Provider attribute. <see cref="IFormatProvider"/> is only allowed</summary>
''' <param name="PropertyName">The name of the property for which this provider is used</param>
Public Sub New(ByVal PropertyName As String)

View File

@@ -0,0 +1,13 @@
' 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 Plugin
Public Interface IPropertyProvider : Inherits IFormatProvider
Property PropertyName As String
End Interface
End Namespace

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.27.0")>
<Assembly: AssemblyFileVersion("2023.1.27.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -102,6 +102,7 @@
</ItemGroup>
<ItemGroup>
<Compile Include="Attributes\Attributes.vb" />
<Compile Include="Interfaces\IPropertyProvider.vb" />
<Compile Include="Objects\ExchangeOptions.vb" />
<Compile Include="ObjectInterfaces\ILogProvider.vb" />
<Compile Include="Interfaces\IPluginContentProvider.vb" />

View File

@@ -1023,12 +1023,14 @@ BlockNullPicture:
End If
If Not v.SpecialFolder.IsEmptyString Then
f.Path = $"{f.PathWithSeparator}{v.SpecialFolder}\".CSFileP.Path
f.Path = $"{f.PathWithSeparator}{v.SpecialFolder.StringTrimEnd("*")}\".CSFileP.Path
f.Exists(SFO.Path)
End If
If __isVideo And vsf Then
f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
If v.SpecialFolder.IsEmptyString OrElse Not v.SpecialFolder.EndsWith("*") Then
f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
End If
End If
If v.Type = UTypes.m3u8 And UseInternalM3U8Function Then

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
@@ -608,17 +613,20 @@ Namespace API.Instagram
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
If PostKvExists(PostIDKV) Then
If Not Pinned Then Return False
Else
_TempPostsList.Add(PostIDKV.ID)
PostsKVIDs.ListAddValue(PostIDKV, LNC)
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 If
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate)
End With
Next
Return True

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

@@ -12,6 +12,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Twitter
Friend Module Declarations
Friend Const TwitterSite As String = "Twitter"
Friend Const TwitterSiteKey As String = "AndyProgram_Twitter"
Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
Friend ReadOnly VideoNode As NodeParams() = {New NodeParams("video_info", True, True, True, True, 10)}
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)

View File

@@ -0,0 +1,27 @@
' 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.Twitter
Friend Class EditorExchangeOptions
Friend Property GifsDownload As Boolean
Friend Property GifsSpecialFolder As String
Friend Property GifsPrefix As String
Friend Sub New()
End Sub
Friend Sub New(ByVal s As SiteSettings)
GifsDownload = s.GifsDownload.Value
GifsSpecialFolder = s.GifsSpecialFolder.Value
GifsPrefix = s.GifsPrefix.Value
End Sub
Friend Sub New(ByVal u As UserData)
GifsDownload = u.GifsDownload
GifsSpecialFolder = u.GifsSpecialFolder
GifsPrefix = u.GifsPrefix
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,148 @@
' 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.Twitter
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class OptionsForm : 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
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(OptionsForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.CH_DOWN_GIFS = New System.Windows.Forms.CheckBox()
Me.TXT_GIF_FOLDER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_GIF_PREFIX = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_GIF_FOLDER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_GIF_PREFIX, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(304, 84)
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(304, 109)
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_GIFS, 0, 0)
TP_MAIN.Controls.Add(Me.TXT_GIF_FOLDER, 0, 1)
TP_MAIN.Controls.Add(Me.TXT_GIF_PREFIX, 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, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(304, 84)
TP_MAIN.TabIndex = 0
'
'CH_DOWN_GIFS
'
Me.CH_DOWN_GIFS.AutoSize = True
Me.CH_DOWN_GIFS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_GIFS.Location = New System.Drawing.Point(4, 4)
Me.CH_DOWN_GIFS.Name = "CH_DOWN_GIFS"
Me.CH_DOWN_GIFS.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_DOWN_GIFS.Size = New System.Drawing.Size(296, 19)
Me.CH_DOWN_GIFS.TabIndex = 0
Me.CH_DOWN_GIFS.Text = "Download GIFs"
Me.CH_DOWN_GIFS.UseVisualStyleBackColor = True
'
'TXT_GIF_FOLDER
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Clear"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_GIF_FOLDER.Buttons.Add(ActionButton1)
Me.TXT_GIF_FOLDER.CaptionText = "GIFs special folder"
Me.TXT_GIF_FOLDER.CaptionToolTipText = "Put the GIFs in a special folder"
Me.TXT_GIF_FOLDER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GIF_FOLDER.Location = New System.Drawing.Point(4, 30)
Me.TXT_GIF_FOLDER.Name = "TXT_GIF_FOLDER"
Me.TXT_GIF_FOLDER.Size = New System.Drawing.Size(296, 22)
Me.TXT_GIF_FOLDER.TabIndex = 1
'
'TXT_GIF_PREFIX
'
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_GIF_PREFIX.Buttons.Add(ActionButton2)
Me.TXT_GIF_PREFIX.CaptionText = "GIF prefix"
Me.TXT_GIF_PREFIX.CaptionToolTipText = "This prefix will be added to the beginning of the filename"
Me.TXT_GIF_PREFIX.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GIF_PREFIX.Location = New System.Drawing.Point(4, 59)
Me.TXT_GIF_PREFIX.Name = "TXT_GIF_PREFIX"
Me.TXT_GIF_PREFIX.Size = New System.Drawing.Size(296, 22)
Me.TXT_GIF_PREFIX.TabIndex = 2
'
'OptionsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(304, 109)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.TwitterIcon_32
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(320, 148)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(320, 148)
Me.Name = "OptionsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Options"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
CType(Me.TXT_GIF_FOLDER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_GIF_PREFIX, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_DOWN_GIFS As CheckBox
Private WithEvents TXT_GIF_FOLDER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_GIF_PREFIX As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -0,0 +1,143 @@
<?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>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
</root>

View File

@@ -0,0 +1,78 @@
' 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 System.Reflection
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls
Namespace API.Twitter
Friend Class OptionsForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyExchangeOptions As EditorExchangeOptions
Private ReadOnly MyGifTextProvider As SiteSettings.GifStringProvider
Friend Sub New(ByRef ExchangeOptions As EditorExchangeOptions)
InitializeComponent()
MyExchangeOptions = ExchangeOptions
MyGifTextProvider = New SiteSettings.GifStringProvider
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub OptionsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(True)
.AddOkCancelToolbar()
With MyExchangeOptions
CH_DOWN_GIFS.Checked = .GifsDownload
TXT_GIF_FOLDER.Text = .GifsSpecialFolder
TXT_GIF_FOLDER.Tag = NameOf(SiteSettings.GifsSpecialFolder)
TXT_GIF_PREFIX.Text = .GifsPrefix
TXT_GIF_PREFIX.Tag = NameOf(SiteSettings.GifsPrefix)
Try
Dim p As PropertyOption
With Settings(TwitterSiteKey)
p = .PropList.Find(Function(pp) pp.Name = TXT_GIF_FOLDER.Tag).Options
If Not p Is Nothing Then
TXT_GIF_FOLDER.CaptionText = p.ControlText
TXT_GIF_FOLDER.CaptionToolTipText = p.ControlToolTip
TXT_GIF_FOLDER.CaptionToolTipEnabled = Not TXT_GIF_FOLDER.CaptionToolTipText.IsEmptyString
End If
p = .PropList.Find(Function(pp) pp.Name = TXT_GIF_PREFIX.Tag).Options
If Not p Is Nothing Then
TXT_GIF_PREFIX.CaptionText = p.ControlText
TXT_GIF_PREFIX.CaptionToolTipText = p.ControlToolTip
TXT_GIF_PREFIX.CaptionToolTipEnabled = Not TXT_GIF_PREFIX.CaptionToolTipText.IsEmptyString
End If
End With
Catch
End Try
End With
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyExchangeOptions
.GifsDownload = CH_DOWN_GIFS.Checked
.GifsSpecialFolder = TXT_GIF_FOLDER.Text
.GifsPrefix = TXT_GIF_PREFIX.Text
End With
MyDefs.CloseForm()
End Sub
Private Sub TXT_ActionOnTextChanged(ByVal Sender As TextBoxExtended, ByVal e As EventArgs) Handles TXT_GIF_FOLDER.ActionOnTextChanged,
TXT_GIF_PREFIX.ActionOnTextChanged
If Not MyDefs.Initializing Then
With Sender
MyGifTextProvider.PropertyName = .Tag
Dim s% = .SelectionStart
Dim t$ = AConvert(Of String)(.Text, String.Empty, MyGifTextProvider)
If Not .Text = t Then .Text = t : .Select(s, 0)
End With
End If
End Sub
End Class
End Namespace

View File

@@ -13,10 +13,11 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Namespace API.Twitter
<Manifest("AndyProgram_Twitter"), SavedPosts>
<Manifest(TwitterSiteKey), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Const Header_Authorization As String = "authorization"
Friend Const Header_Token As String = "x-csrf-token"
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.TwitterIcon_32
@@ -27,14 +28,50 @@ Namespace API.Twitter
Return My.Resources.SiteResources.TwitterPic_400
End Get
End Property
<PropertyOption(AllowNull:=False, ControlText:="Authorization",
#Region "Auth"
<PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Authorization",
ControlToolTip:="Set authorization from [authorization] response header. This field must start from [Bearer] key word")>
Private ReadOnly Property Auth As PropertyValue
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")>
<PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")>
Private ReadOnly Property Token As PropertyValue
<PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
<PropertyOption(IsAuth:=True, ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region
#Region "Other properties"
<PropertyOption(IsAuth:=False, ControlText:="Download GIFs"), PXML>
Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="GIFs special folder",
ControlToolTip:="Put the GIFs in a special folder" & vbCr &
"This is a folder name, not an absolute path." & vbCr &
"This folder(s) will be created relative to the user's root folder." & vbCr &
"Examples:" & vbCr & "SomeFolderName" & vbCr & "SomeFolderName\SomeFolderName2"), PXML>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="GIF prefix", ControlToolTip:="This prefix will be added to the beginning of the filename"), PXML>
Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider
Friend Class GifStringProvider : Implements ICustomProvider, IPropertyProvider
Friend Property PropertyName As String Implements IPropertyProvider.PropertyName
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
Dim v$ = AConvert(Of String)(Value, String.Empty)
If Not v.IsEmptyString Then
If PropertyName = NameOf(GifsPrefix) Then
v = v.StringRemoveWinForbiddenSymbols
Else
v = v.StringReplaceSymbols(GetWinForbiddenSymbols.ToList.ListWithRemove("\").ToArray, String.Empty, EDP.ReturnValue)
v = v.StringTrim("\")
End If
End If
Return v
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 [TimersChecker]")
End Function
End Class
#End Region
Friend Overrides ReadOnly Property Responser As Responser
#End Region
Friend Sub New()
MyBase.New(TwitterSite)
Responser = New Responser($"{SettingsFolderName}\Responser_{Site}.xml")
@@ -72,6 +109,11 @@ Namespace API.Twitter
Token = New PropertyValue(t, GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
GifsDownload = New PropertyValue(True)
GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String))
GifsPrefix = New PropertyValue("GIF_")
GifStringChecker = New GifStringProvider
UserRegex = RParams.DMS("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1)
UrlPatternUser = "https://twitter.com/{0}"
ImageVideoContains = "twitter"
@@ -106,5 +148,11 @@ Namespace API.Twitter
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(Token.Value) And ACheck(Auth.Value)
End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
If OpenForm Then
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
End Class
End Namespace

View File

@@ -17,15 +17,50 @@ Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase
Private Const SinglePostUrl As String = "https://api.twitter.com/1.1/statuses/show.json?id={0}&tweet_mode=extended"
#Region "XML names"
Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
#End Region
#Region "Declarations"
Friend Property GifsDownload As Boolean
Friend Property GifsSpecialFolder As String
Friend Property GifsPrefix As String
Private ReadOnly _DataNames As List(Of String)
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(Me)
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)
GifsDownload = .GifsDownload
GifsSpecialFolder = .GifsSpecialFolder
GifsPrefix = .GifsPrefix
End With
End If
End Sub
#End Region
#Region "Initializer"
#Region "Initializer, loader"
Friend Sub New()
_DataNames = New List(Of String)
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
GifsDownload = Container.Value(Name_GifsDownload).FromXML(Of Boolean)(True)
GifsSpecialFolder = Container.Value(Name_GifsSpecialFolder)
If Not Container.Contains(Name_GifsPrefix) Then
GifsPrefix = "GIF_"
Else
GifsPrefix = Container.Value(Name_GifsPrefix)
End If
Else
Container.Add(Name_GifsDownload, GifsDownload.BoolToInteger)
Container.Add(Name_GifsSpecialFolder, GifsSpecialFolder)
Container.Add(Name_GifsPrefix, GifsPrefix)
End If
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
@@ -182,10 +217,11 @@ Namespace API.Twitter
url = .Value("url")
ff = UrlFile(url)
If Not ff.IsEmptyString Then
If Not _DataNames.Contains(ff) Then
If GifsDownload And Not _DataNames.Contains(ff) Then
m = MediaFromData(url, PostID, PostDate,, State)
f = m.File
If Not f.IsEmptyString Then f.Name = $"GIF_{f.Name}" : m.File = f
If Not f.IsEmptyString And Not GifsPrefix.IsEmptyString Then f.Name = $"{GifsPrefix}{f.Name}" : m.File = f
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = $"{GifsSpecialFolder}*"
_TempMediaList.ListAddValue(m, LNC)
End If
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

@@ -397,6 +397,7 @@ CloseForm:
CMB_SITE.SelectedIndex = -1
CMB_SITE.Clear(ComboBoxExtended.ClearMode.Text)
CH_IS_CHANNEL.Checked = False
If Not UserIsCollection Then Icon = My.Resources.UsersIcon_32
End If
End If
_TextChangeInvoked = False
@@ -412,6 +413,9 @@ CloseForm:
MyExchangeOptions = Nothing
SetParamsBySite()
End Sub
Private Sub CMB_SITE_ActionOnTextChanged(sender As Object, e As EventArgs) Handles CMB_SITE.ActionOnTextChanged
If CMB_SITE.Text.IsEmptyString And Not UserIsCollection Then CMB_SITE.SelectedIndex = -1 : Icon = My.Resources.UsersIcon_32
End Sub
Private Sub BTT_OTHER_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_OTHER_SETTINGS.Click
Dim s As SettingsHost = GetSiteByCheckers()
If Not s Is Nothing Then
@@ -604,9 +608,17 @@ CloseForm:
Else
BTT_OTHER_SETTINGS.Enabled = False
End If
If Not UserIsCollection Then
If Not s.Source.Icon Is Nothing Then
Icon = s.Source.Icon
ElseIf Not s.Source.Image Is Nothing Then
Icon = ImageRenderer.GetIcon(s.Source.Image, New ErrorsDescriber(False, False, False, My.Resources.UsersIcon_32))
End If
End If
End With
Else
BTT_OTHER_SETTINGS.Enabled = False
If Not UserIsCollection Then Icon = My.Resources.UsersIcon_32
End If
End Sub
Private Sub ChangeLabels()

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.27.0")>
<Assembly: AssemblyFileVersion("2023.1.27.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -76,6 +76,7 @@ Namespace Plugin.Hosts
.EndInit(True)
End With
AddHandler .ActionOnButtonClick, AddressOf TextBoxClick
If Not ProviderValue Is Nothing AndAlso ProviderValueInteraction Then AddHandler .ActionOnTextChanged, AddressOf TextBoxTextChanged
End With
End If
End If
@@ -98,6 +99,14 @@ Namespace Plugin.Hosts
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"Updating [{Name}] property")
End Try
End Sub
Private Sub TextBoxTextChanged(ByVal Sender As Object, ByVal e As EventArgs)
UpdateProviderPropertyName()
With DirectCast(Sender, TextBoxExtended)
Dim s% = .SelectionStart
Dim t$ = AConvert(Of String)(.Text, ProviderValue, String.Empty)
If Not t = .Text Then .Text = t : .Select(s, 0)
End With
End Sub
Friend Sub UpdateValueByControl()
If Not Control Is Nothing AndAlso Not TypeOf Control Is Label Then
If TypeOf Control Is CheckBox Then
@@ -105,6 +114,7 @@ Namespace Plugin.Hosts
If Options.ThreeStates Then Value = CInt(.CheckState) Else Value = .Checked
End With
Else
UpdateProviderPropertyName()
Value = AConvert(DirectCast(Control, TextBoxExtended).Text, AModes.Var, [Type],,,, ProviderValue)
End If
End If
@@ -116,12 +126,16 @@ Namespace Plugin.Hosts
If Options.ThreeStates Then Return CInt(.CheckState) Else Return .Checked
End With
Else
UpdateProviderPropertyName()
Return AConvert(DirectCast(Control, TextBoxExtended).Text, AModes.Var, [Type],,,, ProviderValue)
End If
Else
Return Nothing
End If
End Function
Private Sub UpdateProviderPropertyName()
If ProviderValueIsPropertyProvider Then DirectCast(ProviderValue, IPropertyProvider).PropertyName = Name
End Sub
#End Region
#Region "Compatibility"
Private ReadOnly Source As Object
@@ -143,9 +157,17 @@ Namespace Plugin.Hosts
End Property
#Region "Providers"
Friend Property ProviderFieldsChecker As IFormatProvider
Friend Property ProviderValue As IFormatProvider
Friend Sub SetProvider(ByVal Provider As IFormatProvider, ByVal FC As Boolean)
If FC Then ProviderFieldsChecker = Provider Else ProviderValue = Provider
Private Property ProviderValue As IFormatProvider
Private Property ProviderValueInteraction As Boolean = False
Private Property ProviderValueIsPropertyProvider As Boolean = False
Friend Sub SetProvider(ByVal Provider As IFormatProvider, ByVal Instance As Provider)
If Instance.FieldsChecker Then
ProviderFieldsChecker = Provider
Else
ProviderValue = Provider
ProviderValueIsPropertyProvider = TypeOf ProviderValue Is IPropertyProvider
ProviderValueInteraction = Instance.Interaction
End If
End Sub
#End Region
Friend PropertiesChecking As String()

View File

@@ -204,7 +204,7 @@ Namespace Plugin.Hosts
End If
Next
ElseIf m.MemberType = MemberTypes.Property Then
If Not m.GetCustomAttribute(Of Provider)() Is Nothing Then Providers.Add(m)
If m.GetCustomAttributes(Of Provider)().ListExists Then Providers.Add(m)
End If
End If
End With
@@ -220,13 +220,15 @@ Namespace Plugin.Hosts
Updaters.Clear()
End If
If Providers.Count > 0 Then
Dim prov As Provider
Dim prov As IEnumerable(Of Provider)
Dim _prov As Provider
For Each m In Providers
prov = m.GetCustomAttribute(Of Provider)()
i = PropList.FindIndex(Function(p) p.Name = prov.Name)
If i >= 0 Then
PropList(i).SetProvider(DirectCast(DirectCast(m, PropertyInfo).GetValue(Source), IFormatProvider),
m.GetCustomAttribute(Of Provider)().FieldsChecker)
prov = m.GetCustomAttributes(Of Provider)()
If prov.ListExists Then
For Each _prov In prov
i = PropList.FindIndex(Function(p) p.Name = _prov.Name)
If i >= 0 Then PropList(i).SetProvider(DirectCast(DirectCast(m, PropertyInfo).GetValue(Source), IFormatProvider), _prov)
Next
End If
Next
Providers.Clear()

View File

@@ -196,6 +196,13 @@
<Compile Include="API\TikTok\Declarations.vb" />
<Compile Include="API\TikTok\SiteSettings.vb" />
<Compile Include="API\TikTok\UserData.vb" />
<Compile Include="API\Twitter\EditorExchangeOptions.vb" />
<Compile Include="API\Twitter\OptionsForm.Designer.vb">
<DependentUpon>OptionsForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Twitter\OptionsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Xhamster\Declarations.vb" />
<Compile Include="API\Xhamster\M3U8.vb" />
<Compile Include="API\Xhamster\SiteSettings.vb" />
@@ -416,6 +423,9 @@
<EmbeddedResource Include="API\Reddit\RedditViewSettingsForm.resx">
<DependentUpon>RedditViewSettingsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Twitter\OptionsForm.resx">
<DependentUpon>OptionsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Channels\ChannelsStatsForm.resx">
<DependentUpon>ChannelsStatsForm.vb</DependentUpon>
</EmbeddedResource>

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

View File

@@ -94,56 +94,49 @@ Friend Class UserSearchForm
LIST_SEARCH.BeginUpdate()
ControlInvokeFast(LIST_SEARCH, Sub() LIST_SEARCH.Items.Clear())
Results.Clear()
Dim t$ = TXT_SEARCH.Text.Trim
Dim t$ = TXT_SEARCH.Text.StringTrim.StringToLower
With Settings
If Not t.IsEmptyString And .Users.Count > 0 Then
Dim i%
Dim s As Plugin.ExchangeOptions = Nothing
Dim cu As Boolean = False
Dim __descr As Boolean = CH_SEARCH_IN_DESCR.Checked
Dim __name As Boolean = CH_SEARCH_IN_NAME.Checked
Dim __lbl As Boolean = CH_SEARCH_IN_LABEL.Checked
Dim _CheckUrl As Action(Of IUserData) = Sub(ByVal u As IUserData)
If cu AndAlso ((u.Site = s.SiteName Or u.HOST.Key = s.HostKey) And u.Name.ToLower = s.UserName) Then _
Results.ListAddValue(New SearchResult(u, SearchResult.Modes.URL), RLP)
End Sub
Dim _CheckDescr As Action(Of IUserData) = Sub(ByVal u As IUserData)
If __descr AndAlso Not u.Description.IsEmptyString AndAlso
u.Description.Contains(t) Then _
Results.ListAddValue(New SearchResult(u, SearchResult.Modes.Description), RLP)
End Sub
Dim _LabelPredicate As Predicate(Of String) = Function(l) l.ToLower.Contains(t)
Dim _CheckLabels As Action(Of IUserData) = Sub(ByVal u As IUserData)
If __lbl AndAlso u.Labels.ListExists AndAlso u.Labels.Exists(_LabelPredicate) Then _
Results.ListAddValue(New SearchResult(u, SearchResult.Modes.Label), RLP)
End Sub
Dim __isUrl As Boolean = t.StartsWith("http")
Dim __urlFound As Boolean = False
Dim _p_url As Predicate(Of IUserData) = Function(u) __urlFound AndAlso ((u.Site = s.SiteName Or u.HOST.Key = s.HostKey) And u.Name.ToLower = s.UserName.ToLower)
Dim _p_descr As Predicate(Of IUserData) = Function(u) __descr AndAlso Not u.Description.IsEmptyString AndAlso u.Description.ToLower.Contains(t)
Dim _p_labels_p As Predicate(Of String) = Function(l) l.ToLower.Contains(t)
Dim _p_labels As Predicate(Of IUserData) = Function(u) __lbl AndAlso u.Labels.ListExists AndAlso u.Labels.Exists(_p_labels_p)
Dim _addValue As Action(Of IUserData, SearchResult.Modes, Predicate(Of IUserData)) = Sub(u, m, p) If p.Invoke(u) Then Results.ListAddValue(New SearchResult(u, m), RLP)
If t.Length >= 4 AndAlso t.StartsWith("http") Then
If __isUrl Then
For Each p In Settings.Plugins
s = p.Settings.IsMyUser(t)
If Not s.UserName.IsEmptyString Then Exit For
Next
__urlFound = Not s.UserName.IsEmptyString
End If
cu = Not s.UserName.IsEmptyString
t = t.ToLower
For Each user As IUserData In .Users
If __name AndAlso user.Name.ToLower.Contains(t) Then Results.ListAddValue(New SearchResult(user, SearchResult.Modes.Name), RLP)
If Not __isUrl AndAlso __name AndAlso user.Name.ToLower.Contains(t) Then Results.ListAddValue(New SearchResult(user, SearchResult.Modes.Name), RLP)
If user.IsCollection Then
With DirectCast(user, UserDataBind)
If .Count > 0 Then
For i = 0 To .Count - 1
If __name AndAlso .Item(i).Name.ToLower = t Then Results.ListAddValue(New SearchResult(.Item(i), SearchResult.Modes.Name), RLP)
_CheckUrl(.Item(i))
_CheckDescr(.Item(i))
_CheckLabels(.Item(i))
With .Item(i)
If Not __isUrl AndAlso __name AndAlso .Self.Name.ToLower = t Then Results.ListAddValue(New SearchResult(.Self, SearchResult.Modes.Name), RLP)
_addValue(.Self, SearchResult.Modes.URL, _p_url)
_addValue(.Self, SearchResult.Modes.Description, _p_descr)
_addValue(.Self, SearchResult.Modes.Label, _p_labels)
End With
Next
End If
End With
Else
_CheckUrl(user)
_CheckDescr(user)
_CheckLabels(user)
_addValue(user, SearchResult.Modes.URL, _p_url)
_addValue(user, SearchResult.Modes.Description, _p_descr)
_addValue(user, SearchResult.Modes.Label, _p_labels)
End If
Next
If Results.Count > 0 Then