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

2023.6.19.0

Browse Source 
YT.Progress: make the playlists parsing progress more informative; change form display method
YT.YouTubeMediaContainerBase: fix sort algo
YT.Tray: add 'Add' button; add 'Ctrl+Click' on tray icon to add download
YT.Settings: add setting 'Download on click in tray: show form'
LPSG: some files didn't download (encoding)
Twitter: hide cache deletion errors
Mastogon: fixed bug in 'ReparseMissing' function
Reddit: downloaded gifs are static
XHamster: videos are not downloading or downloading incorrectly
Progress: fix bugs; minor improvements
This commit is contained in:
Andy
2023-06-19 06:05:28 +03:00
parent d34414359c
commit 82ef4f4410
33 changed files with 780 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
Changelog.md
View File

@@ -1,3 +1,23 @@
# 2023.6.19.0
*2023-06-19*
- Added
- **OnlyFans**
- YouTube: make the playlists parsing progress more informative
- YouTube: add `Add` button to tray
- YouTube: add `Ctrl+Click` on tray icon to add download
- YouTube: add setting `Download on click in tray: show form`
- Minor improvements to progress bars
- Other improvements
- Fixed
- YouTube: incorrect sorting algorithm
- LPSG: some files didn't download
- Reddit: downloaded gifs are static (Issue #141)
- xHamster: videos are not downloading or downloading incorrectly (Issue #144)
- Progress bar bugs
- Minor bugs
# 2023.6.9.0 # 2023.6.9.0
*2023-06-09* *2023-06-09*

BIN
ProgramScreenshots/SavedPosts.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 30 KiB

After

Width:  |  Height:  |  Size: 34 KiB

BIN
ProgramScreenshots/SettingsSiteOnlyFans.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 20 KiB

2
ProgramsComparison.md
View File

@@ -117,7 +117,7 @@ https://github.com/RipMeApp/ripme
| **Free options** | The program is completely free | The program is completely free, but site limits are not declared | | **Free options** | The program is completely free | The program is completely free, but site limits are not declared |
| Operating Systems | Windows 10+ | Windows, MacOS, Linux | | Operating Systems | Windows 10+ | Windows, MacOS, Linux |
| Select want content type to download | Yes | Yes | | Select want content type to download | Yes | Yes |
| Suported sites | 15 internal and any site using plugins | 86+ sites (declared) | | Suported sites | 15+ internal and any site using plugins | 86+ sites (declared) |
| Other sites support | **Yes** | No | | Other sites support | **Yes** | No |
| Still supported | **Yes** | **No (last release date May 4, 2021)** | | Still supported | **Yes** | **No (last release date May 4, 2021)** |

5
README.md
View File

@@ -11,7 +11,7 @@
:eu: :eu:
:greece: :greece:
A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, Reddit, Twitter, Mastodon, Instagram, TikTok, RedGifs, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest). A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, TikTok, RedGifs, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest).
**If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)** **If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)**
<!---Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush: <!---Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
@@ -31,6 +31,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- Reddit images, galleries of images, videos, saved posts; - Reddit images, galleries of images, videos, saved posts;
- Redgifs videos (https://www.redgifs.com/); - Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts; - Twitter images and videos, saved (bookmarked) posts;
- OnlyFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts; - Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts; - Instagram images and videos, tagged posts, stories, saved posts;
- TikTok videos (*currently broken*; [limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits)); - TikTok videos (*currently broken*; [limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits));
@@ -65,6 +66,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **YouTube Music** - **YouTube Music**
- **Reddit** - **Reddit**
- **Twitter** - **Twitter**
- **OnlyFans**
- **Mastodon** - **Mastodon**
- **Instagram** - **Instagram**
- TikTok (*currently broken*; [limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits)) - TikTok (*currently broken*; [limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits))
@@ -122,6 +124,7 @@ The program parses user posts and compares file names with existing ones to remo
- **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)** - **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
- [Reddit](https://github.com/AAndyProgram/SCrawler/wiki/Settings#reddit) - [Reddit](https://github.com/AAndyProgram/SCrawler/wiki/Settings#reddit)
- [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter) - [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter)
- [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans)
- [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#Mastodon) - [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#Mastodon)
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) - [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok) - [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)

3
SCrawler.YouTube/Base/YouTubeSettings.vb
View File

@@ -152,6 +152,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}, False), Category("Defaults"), DisplayName("Confirm exit"), <Browsable(True), GridVisible(False), XMLVN({"Defaults"}, False), Category("Defaults"), DisplayName("Confirm exit"),
Description("Exit confirmation when closing the program.")> Description("Exit confirmation when closing the program.")>
Public ReadOnly Property ExitConfirm As XMLValue(Of Boolean) Public ReadOnly Property ExitConfirm As XMLValue(Of Boolean)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Download on click in tray: show form"),
Description("Show main window when download by clicking (Ctrl+Click) the tray icon. Default: false")>
Public ReadOnly Property ShowFormDownTrayClick As XMLValue(Of Boolean)
#End Region #End Region
#Region "Defaults Video" #Region "Defaults Video"
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, "MKV"), Category("Defaults Video"), DisplayName("Default format"), <Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, "MKV"), Category("Defaults Video"), DisplayName("Default format"),

1
SCrawler.YouTube/Controls/ParsingProgressForm.Designer.vb generated
View File

@@ -82,7 +82,6 @@ Namespace API.YouTube.Controls
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent
Me.Text = "Parsing progress" Me.Text = "Parsing progress"
Me.TopMost = True
TP_MAIN.ResumeLayout(False) TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout() TP_MAIN.PerformLayout()
Me.ResumeLayout(False) Me.ResumeLayout(False)

22
SCrawler.YouTube/Controls/ParsingProgressForm.vb
View File

@@ -17,9 +17,27 @@ Namespace API.YouTube.Controls
Return TokenSource.Token Return TokenSource.Token
End Get End Get
End Property End Property
Public Sub New() Private ReadOnly CountMax As Integer
Private CountCurrent As Integer = 1
Friend Sub NextPlaylist()
CountCurrent += 1
MyProgress.InformationTemporary(True) = InfoStr
MyProgress.Information = InfoStr
End Sub
Private ReadOnly Property InfoStr As String
Get
Const MainMsg$ = "Data parsing in progress"
If CountMax > 1 Then
Return $"{MainMsg} [{CountCurrent - 1}/{CountMax}]"
Else
Return MainMsg
End If
End Get
End Property
Public Sub New(Optional ByVal _Count As Integer = 1)
InitializeComponent() InitializeComponent()
MyProgress = New MyProgress(PR_MAIN, LBL_MAIN, "Data parsing in progress") With {.ResetProgressOnMaximumChanges = False} CountMax = _Count
MyProgress = New MyProgress(PR_MAIN, LBL_MAIN, InfoStr) With {.ResetProgressOnMaximumChanges = False}
TokenSource = New CancellationTokenSource TokenSource = New CancellationTokenSource
End Sub End Sub
Public Sub SetInitialValues(ByVal Count As Integer, ByVal Info As String) Public Sub SetInitialValues(ByVal Count As Integer, ByVal Info As String)

22
SCrawler.YouTube/Downloader/VideoListForm.vb
View File

@@ -237,6 +237,7 @@ Namespace DownloadObjects.STDownloader
Dim pForm As ParsingProgressForm = Nothing Dim pForm As ParsingProgressForm = Nothing
Try Try
Dim useCookies As Boolean = MyYouTubeSettings.DefaultUseCookies Dim useCookies As Boolean = MyYouTubeSettings.DefaultUseCookies
Dim sTag$ = If(Sender?.Tag, String.Empty)
Dim disableDown As Boolean = e.Shift Dim disableDown As Boolean = e.Shift
If e.Control Then useCookies = True If e.Control Then useCookies = True
Dim useCookiesParse As Boolean? = Nothing Dim useCookiesParse As Boolean? = Nothing
@@ -247,21 +248,28 @@ Namespace DownloadObjects.STDownloader
Dim GetDefault As Boolean = True Dim GetDefault As Boolean = True
Dim GetShorts As Boolean = True Dim GetShorts As Boolean = True
If Sender.Tag = "pls" Then If sTag = "pls" Then
Using pf As New PlaylistArrayForm With {.DesignXML = DesignXML} Using pf As New PlaylistArrayForm With {.DesignXML = DesignXML}
pf.ShowDialog() pf.ShowDialog()
If pf.DialogResult = DialogResult.OK Then If pf.DialogResult = DialogResult.OK Then
With pf.URLs With pf.URLs
If .Count > 0 Then If .Count > 0 Then
pForm = New ParsingProgressForm pForm = New ParsingProgressForm(.Count)
pForm.Show() pForm.Show(Me)
pForm.SetInitialValues(.Count, "Parsing playlists...") pForm.SetInitialValues(.Count, "Parsing playlists...")
Dim containers As New List(Of IYouTubeMediaContainer) Dim containers As New List(Of IYouTubeMediaContainer)
For Each u$ In .Self : containers.Add(YouTubeFunctions.Parse(u, useCookiesParse, pForm.Token, pForm.MyProgress, True, False)) : pForm.MyProgress.Perform() : Next For Each u$ In .Self
containers.Add(YouTubeFunctions.Parse(u, useCookiesParse, pForm.Token, pForm.MyProgress, True, False))
pForm.NextPlaylist()
pForm.MyProgress.Perform()
Next
pForm.Dispose() pForm.Dispose()
If containers.Count > 0 Then containers.ListDisposeRemoveAll(Function(cc) cc.HasError Or Not cc.Exists) If containers.Count > 0 Then containers.ListDisposeRemoveAll(Function(cc) cc.HasError Or Not cc.Exists)
If containers.Count > 0 Then If containers.Count > 0 Then
c = New Channel With {.UserTitle = IIf(pf.IsOneArtist, containers(0).UserTitle, "Playlists")} c = New Channel With {
.UserTitle = IIf(pf.IsOneArtist, containers(0).UserTitle, "Playlists"),
.IsMusic = containers.Any(Function(cc) cc.IsMusic)
}
c.Elements.AddRange(containers) c.Elements.AddRange(containers)
End If End If
End If End If
@@ -269,7 +277,7 @@ Namespace DownloadObjects.STDownloader
End If End If
End Using End Using
Else Else
Select Case CStr(Sender.Tag) Select Case sTag
Case "ans" : GetShorts = False Case "ans" : GetShorts = False
Case "as" : GetDefault = False : GetShorts = True Case "as" : GetDefault = False : GetShorts = True
End Select End Select
@@ -280,7 +288,7 @@ Namespace DownloadObjects.STDownloader
If Not c Is Nothing OrElse YouTubeFunctions.IsMyUrl(url) Then If Not c Is Nothing OrElse YouTubeFunctions.IsMyUrl(url) Then
If c Is Nothing Then If c Is Nothing Then
pForm = New ParsingProgressForm pForm = New ParsingProgressForm
pForm.Show() pForm.Show(Me)
pForm.SetInitialValues(1, "Parsing data...") pForm.SetInitialValues(1, "Parsing data...")
c = YouTubeFunctions.Parse(url, useCookiesParse, pForm.Token, pForm.MyProgress, GetDefault, GetShorts) c = YouTubeFunctions.Parse(url, useCookiesParse, pForm.Token, pForm.MyProgress, GetDefault, GetShorts)
pForm.Dispose() pForm.Dispose()

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

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

11
SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb
View File

@@ -22,17 +22,8 @@ Imports UMStates = SCrawler.Plugin.UserMediaStates
Imports CollectionModes = PersonalUtilities.Functions.XML.Objects.IXMLValuesCollection.Modes Imports CollectionModes = PersonalUtilities.Functions.XML.Objects.IXMLValuesCollection.Modes
Namespace API.YouTube.Objects Namespace API.YouTube.Objects
Public Class ContainerDateComparer : Implements IComparer(Of IYouTubeMediaContainer) Public Class ContainerDateComparer : Implements IComparer(Of IYouTubeMediaContainer)
Private ReadOnly NullDateValue As New Date
Public Function Compare(ByVal x As IYouTubeMediaContainer, ByVal y As IYouTubeMediaContainer) As Integer Implements IComparer(Of IYouTubeMediaContainer).Compare Public Function Compare(ByVal x As IYouTubeMediaContainer, ByVal y As IYouTubeMediaContainer) As Integer Implements IComparer(Of IYouTubeMediaContainer).Compare
If x.DateDownloaded = NullDateValue And y.DateDownloaded = NullDateValue Then Return x.DateCreated.CompareTo(y.DateCreated) * -1
Return x.DateCreated.CompareTo(y.DateCreated) * -1
ElseIf x.DateDownloaded = NullDateValue Then
Return -1
ElseIf y.DateDownloaded = NullDateValue Then
Return 1
Else
Return x.DateDownloaded.CompareTo(y.DateDownloaded) * -1
End If
End Function End Function
End Class End Class
Public MustInherit Class YouTubeMediaContainerBase : Implements IYouTubeMediaContainer Public MustInherit Class YouTubeMediaContainerBase : Implements IYouTubeMediaContainer

23
SCrawler.YouTubeDownloader/MainFrame.Designer.vb generated
View File

@@ -20,9 +20,12 @@ Partial Public Class MainFrame : Inherits SCrawler.DownloadObjects.STDownloader.
Private Sub InitializeComponent() Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container() Me.components = New System.ComponentModel.Container()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(MainFrame)) Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(MainFrame))
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Me.TRAY_ICON = New System.Windows.Forms.NotifyIcon(Me.components) Me.TRAY_ICON = New System.Windows.Forms.NotifyIcon(Me.components)
Me.TRAY_CONTEXT = New System.Windows.Forms.ContextMenuStrip(Me.components) Me.TRAY_CONTEXT = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_BTT_ADD = New PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
Me.TRAY_CONTEXT.SuspendLayout() Me.TRAY_CONTEXT.SuspendLayout()
Me.SuspendLayout() Me.SuspendLayout()
' '
@@ -32,13 +35,13 @@ Partial Public Class MainFrame : Inherits SCrawler.DownloadObjects.STDownloader.
Me.TRAY_ICON.BalloonTipTitle = "YouTube Downloader" Me.TRAY_ICON.BalloonTipTitle = "YouTube Downloader"
Me.TRAY_ICON.ContextMenuStrip = Me.TRAY_CONTEXT Me.TRAY_ICON.ContextMenuStrip = Me.TRAY_CONTEXT
Me.TRAY_ICON.Icon = CType(resources.GetObject("TRAY_ICON.Icon"), System.Drawing.Icon) Me.TRAY_ICON.Icon = CType(resources.GetObject("TRAY_ICON.Icon"), System.Drawing.Icon)
Me.TRAY_ICON.Text = "YouTube Downloader" Me.TRAY_ICON.Text = "YouTube Downloader" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+Click to add download"
' '
'TRAY_CONTEXT 'TRAY_CONTEXT
' '
Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_TRAY_CLOSE}) Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.CONTEXT_BTT_ADD, CONTEXT_SEP_1, Me.BTT_TRAY_CLOSE})
Me.TRAY_CONTEXT.Name = "ContextMenuStrip1" Me.TRAY_CONTEXT.Name = "ContextMenuStrip1"
Me.TRAY_CONTEXT.Size = New System.Drawing.Size(181, 48) Me.TRAY_CONTEXT.Size = New System.Drawing.Size(181, 76)
' '
'BTT_TRAY_CLOSE 'BTT_TRAY_CLOSE
' '
@@ -47,11 +50,24 @@ Partial Public Class MainFrame : Inherits SCrawler.DownloadObjects.STDownloader.
Me.BTT_TRAY_CLOSE.Size = New System.Drawing.Size(180, 22) Me.BTT_TRAY_CLOSE.Size = New System.Drawing.Size(180, 22)
Me.BTT_TRAY_CLOSE.Text = "Close" Me.BTT_TRAY_CLOSE.Text = "Close"
' '
'CONTEXT_BTT_ADD
'
Me.CONTEXT_BTT_ADD.Name = "CONTEXT_BTT_ADD"
Me.CONTEXT_BTT_ADD.Size = New System.Drawing.Size(180, 22)
Me.CONTEXT_BTT_ADD.Text = "Add"
Me.CONTEXT_BTT_ADD.Image = Global.PersonalUtilities.My.Resources.PlusPic_Green_24
'
'CONTEXT_SEP_1
'
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(177, 6)
'
'MainFrame 'MainFrame
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.ClientSize = New System.Drawing.Size(1008, 729) Me.ClientSize = New System.Drawing.Size(1008, 729)
Me.Name = "MainFrame" Me.Name = "MainFrame"
Me.Text = "SCrawler: Happy LGBT Pride Month! :-)"
Me.TRAY_CONTEXT.ResumeLayout(False) Me.TRAY_CONTEXT.ResumeLayout(False)
Me.ResumeLayout(False) Me.ResumeLayout(False)
Me.PerformLayout() Me.PerformLayout()
@@ -61,4 +77,5 @@ Partial Public Class MainFrame : Inherits SCrawler.DownloadObjects.STDownloader.
Private WithEvents TRAY_ICON As NotifyIcon Private WithEvents TRAY_ICON As NotifyIcon
Private WithEvents TRAY_CONTEXT As ContextMenuStrip Private WithEvents TRAY_CONTEXT As ContextMenuStrip
Private WithEvents BTT_TRAY_CLOSE As ToolStripMenuItem Private WithEvents BTT_TRAY_CLOSE As ToolStripMenuItem
Private WithEvents CONTEXT_BTT_ADD As PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick
End Class End Class

3
SCrawler.YouTubeDownloader/MainFrame.resx
View File

@@ -123,6 +123,9 @@
<metadata name="TRAY_CONTEXT.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="TRAY_CONTEXT.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>425, 17</value> <value>425, 17</value>
</metadata> </metadata>
<metadata name="CONTEXT_SEP_1.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" /> <assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="BTT_TRAY_CLOSE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_TRAY_CLOSE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>

10
SCrawler.YouTubeDownloader/MainFrame.vb
View File

@@ -9,6 +9,7 @@
Imports System.ComponentModel Imports System.ComponentModel
Imports SCrawler.API.YouTube Imports SCrawler.API.YouTube
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.KeyClick
Public Class MainFrame Public Class MainFrame
Private WithEvents MyActivator As FormActivator Private WithEvents MyActivator As FormActivator
Public Sub New() Public Sub New()
@@ -66,6 +67,12 @@ CloseResume:
Private Sub BTT_TRAY_CLOSE_Click(sender As Object, e As EventArgs) Handles BTT_TRAY_CLOSE.Click Private Sub BTT_TRAY_CLOSE_Click(sender As Object, e As EventArgs) Handles BTT_TRAY_CLOSE.Click
If CheckForClose(False) Then _IgnoreCloseConfirm = True : _IgnoreTrayOptions = True : Close() If CheckForClose(False) Then _IgnoreCloseConfirm = True : _IgnoreTrayOptions = True : Close()
End Sub End Sub
Private Sub MyActivator_TrayIconClick(ByVal Sender As Object, ByVal e As KeyClickEventArgs) Handles MyActivator.TrayIconClick
If e.MouseButton = MouseButtons.Left And e.Control Then
BTT_ADD_KeyClick(Nothing, New KeyClickEventArgs)
e.Handled = Not MyYouTubeSettings.ShowFormDownTrayClick
End If
End Sub
Private Function CheckForClose(ByVal _Ignore As Boolean) As Boolean Private Function CheckForClose(ByVal _Ignore As Boolean) As Boolean
If MyYouTubeSettings.ExitConfirm And Not _Ignore Then If MyYouTubeSettings.ExitConfirm And Not _Ignore Then
Return MsgBoxE({"Do you want to close the program?", "Closing the program"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Return MsgBoxE({"Do you want to close the program?", "Closing the program"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes
@@ -77,6 +84,9 @@ CloseResume:
MyBase.BTT_SETTINGS_Click(sender, e) MyBase.BTT_SETTINGS_Click(sender, e)
TRAY_ICON.Visible = MyYouTubeSettings.CloseToTray TRAY_ICON.Visible = MyYouTubeSettings.CloseToTray
End Sub End Sub
Protected Overrides Sub BTT_ADD_KeyClick(ByVal Sender As ToolStripMenuItemKeyClick, ByVal e As KeyClickEventArgs) Handles CONTEXT_BTT_ADD.KeyClick
MyBase.BTT_ADD_KeyClick(Sender, e)
End Sub
Protected Overrides Sub MyJob_Started(ByVal Sender As Object, ByVal e As EventArgs) Protected Overrides Sub MyJob_Started(ByVal Sender As Object, ByVal e As EventArgs)
TRAY_ICON.Icon = My.Resources.ArrowDownIcon_Orange_24 TRAY_ICON.Icon = My.Resources.ArrowDownIcon_Orange_24
End Sub End Sub

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

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

8
SCrawler/API/LPSG/Declarations.vb
View File

@@ -19,7 +19,10 @@ Namespace API.LPSG
Friend ReadOnly Property NextPageRegex As RParams = RParams.DMS("<link rel=""next"" href=""(.+?/page-(\d+))""", 2) Friend ReadOnly Property NextPageRegex As RParams = RParams.DMS("<link rel=""next"" href=""(.+?/page-(\d+))""", 2)
Private Const FileUrlRegexDefault As String = "([^/]+?)(jpg|jpeg|gif|png|webm)" Private Const FileUrlRegexDefault As String = "([^/]+?)(jpg|jpeg|gif|png|webm)"
Private ReadOnly InputFReplacer As New ErrorsDescriber(EDP.ReturnValue) Private ReadOnly InputFReplacer As New ErrorsDescriber(EDP.ReturnValue)
Private ReadOnly InputForbidRemover As Func(Of String, String) = Function(Input) If(Input.IsEmptyString, Input, Input.StringRemoveWinForbiddenSymbols(, InputFReplacer)) Private ReadOnly InputForbidRemover As Func(Of String, String) = Function(Input) If(Input.IsEmptyString,
Input,
Input.StringRemoveWinForbiddenSymbols(, InputFReplacer)).
IfNullOrEmpty($"{Settings.Cache.NewFile.Name}.file")
Private ReadOnly FileRegEx As RParams = RParams.DMS(FileUrlRegexDefault, 0, RegexReturn.ListByMatch, InputFReplacer) Private ReadOnly FileRegEx As RParams = RParams.DMS(FileUrlRegexDefault, 0, RegexReturn.ListByMatch, InputFReplacer)
#Disable Warning IDE0060 #Disable Warning IDE0060
Friend Function FileRegExF(ByVal Input As String, ByVal Index As Integer) As String Friend Function FileRegExF(ByVal Input As String, ByVal Index As Integer) As String
@@ -28,7 +31,8 @@ Namespace API.LPSG
Dim l As List(Of String) = RegexReplace(Input, FileRegEx) Dim l As List(Of String) = RegexReplace(Input, FileRegEx)
If l.ListExists(3) Then If l.ListExists(3) Then
Dim ext$ = l(2) Dim ext$ = l(2)
Dim f$ = l(1).StringTrim("-", ".") Dim f$ = l(1).StringTrim("-", ".").StringRemoveWinForbiddenSymbols
If f.IsEmptyString Then f = Settings.Cache.NewFile.Name
Input = $"{f}.{ext}" Input = $"{f}.{ext}"
End If End If
End If End If

3
SCrawler/API/Mastodon/UserData.vb
View File

@@ -261,8 +261,9 @@ Namespace API.Mastodon
If Not j Is Nothing Then If Not j Is Nothing Then
PostDate = String.Empty PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, UStates.Missing) ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE)
rList.Add(i) rList.Add(i)
j.Dispose()
End If End If
End If End If
End If End If

15
SCrawler/API/OnlyFans/Declarations.vb Normal file
View File

@@ -0,0 +1,15 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.OnlyFans
Friend Module Declarations
Friend ReadOnly DateProvider As New ADateTime("O")
Friend ReadOnly RegExPostID As RParams = RParams.DM("(?<=onlyfans\.com/)(\d+)", 0, EDP.ReturnValue)
End Module
End Namespace

165
SCrawler/API/OnlyFans/SiteSettings.vb Normal file
View File

@@ -0,0 +1,165 @@
' 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 SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.OnlyFans
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Icon"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.OnlyFansIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.OnlyFansPic_32
End Get
End Property
#End Region
#Region "Declarations"
Private Const HeaderBrowser As String = "sec-ch-ua"
Private Const HeaderUserID As String = "User-Id"
Private Const HeaderXBC As String = "X-Bc"
Private Const HeaderAppToken As String = "App-Token"
<PropertyOption(ControlText:=HeaderUserID, AllowNull:=False)>
Friend ReadOnly Property HH_USER_ID As PropertyValue
<PropertyOption(ControlText:=HeaderXBC, AllowNull:=False)>
Private ReadOnly Property HH_X_BC As PropertyValue
<PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False)>
Private ReadOnly Property HH_APP_TOKEN As PropertyValue
<PropertyOption(ControlText:=HeaderBrowser, AllowNull:=False)>
Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(AllowNull:=False)>
Private ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String)
Dim hName$ = String.Empty
Dim isUserAgent As Boolean = False
Select Case PropertyName
Case NameOf(HH_USER_ID) : hName = HeaderUserID
Case NameOf(HH_X_BC) : hName = HeaderXBC
Case NameOf(HH_APP_TOKEN) : hName = HeaderAppToken
Case NameOf(HH_BROWSER) : hName = HeaderBrowser
Case NameOf(UserAgent) : isUserAgent = True
End Select
If Not hName.IsEmptyString Then
Responser.Headers.Add(hName, Value)
ElseIf isUserAgent Then
Responser.UserAgent = Value
End If
End Sub
<PXML("LastDateUpdated")> Private ReadOnly Property LastDateUpdated_XML As PropertyValue
Friend Property LastDateUpdated As Date
Get
Return LastDateUpdated_XML.Value
End Get
Set(ByVal d As Date)
LastDateUpdated_XML.Value = d
End Set
End Property
<PropertyOption(ControlText:="Use old authorization rules",
ControlToolTip:="Use old dynamic rules (from 'DATAHOARDERS') or new ones (from 'DIGITALCRIMINALS')." & vbCr &
"Change this value only if you know what you are doing."), PXML>
Friend ReadOnly Property UseOldAuthRules As PropertyValue
<PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440", LeftOffset:=110), PXML>
Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue
<Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider
<PropertyOption(ControlText:="Dynamic rules",
ControlToolTip:="Overwrite 'Dynamic rules' with this URL" & vbCr &
"Change this value only if you know what you are doing."), PXML>
Friend ReadOnly Property DynamicRules As PropertyValue
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New("OnlyFans", ".onlyfans.com")
With Responser
.Accept = "application/json, text/plain, */*"
.AutomaticDecompression = Net.DecompressionMethods.GZip
.CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesExtractedAutoSave = False
.CookiesUpdateMode = CookieKeeper.UpdateModes.Disabled
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
With .Headers
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.DHT))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "onlyfans.com"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.AcceptEncoding))
HH_USER_ID = New PropertyValue(.Value(HeaderUserID), GetType(String), Sub(v) UpdateHeader(NameOf(HH_USER_ID), v))
HH_X_BC = New PropertyValue(.Value(HeaderXBC), GetType(String), Sub(v) UpdateHeader(NameOf(HH_X_BC), v))
HH_APP_TOKEN = New PropertyValue(.Value(HeaderAppToken), GetType(String), Sub(v) UpdateHeader(NameOf(HH_APP_TOKEN), v))
HH_BROWSER = New PropertyValue(.Value(HeaderBrowser), GetType(String), Sub(v) UpdateHeader(NameOf(HH_BROWSER), v))
End With
UserAgent = New PropertyValue(IIf(.UserAgentExists, .UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
End With
LastDateUpdated_XML = New PropertyValue(Now.AddYears(-1), GetType(Date))
UseOldAuthRules = New PropertyValue(False)
DynamicRulesUpdateInterval = New PropertyValue(60 * 24)
DynamicRulesUpdateIntervalProvider = New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0) > 0, v, Nothing),
"The value of [{0}] field must be greater than 0")
DynamicRules = New PropertyValue(String.Empty, GetType(String))
UserRegex = RParams.DMS("onlyfans.com/(\w+)", 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}"
ImageVideoContains = "onlyfans.com"
End Sub
#End Region
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
#End Region
#Region "Update"
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then Responser.Cookies.Changed = False
MyBase.Update()
End Sub
#End Region
#Region "Download"
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And {HH_USER_ID, HH_X_BC, HH_APP_TOKEN, HH_BROWSER, UserAgent}.All(Function(v) ACheck(v.Value))
End Function
Friend Overrides Function ReadyToDownload(ByVal What As ISiteSettings.Download) As Boolean
Return BaseAuthExists() And Not SessionAborted
End Function
Friend Property SessionAborted As Boolean = False
Friend Overrides Sub AfterDownload(ByVal User As Object, ByVal What As ISiteSettings.Download)
Responser.Cookies.Update(DirectCast(User, UserData).CCookie)
End Sub
Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download)
MyBase.DownloadDone(What)
SessionAborted = False
If Responser.Cookies.Changed Then Responser.SaveCookies() : Responser.Cookies.Changed = False
End Sub
#End Region
#Region "GetUserUrl, GetUserPostUrl"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
If Not Media.Post.ID.IsEmptyString Then
Return String.Format("https://onlyfans.com/{0}/{1}", Media.Post.ID, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
Else
Return String.Empty
End If
End Function
#End Region
End Class
End Namespace

362
SCrawler/API/OnlyFans/UserData.vb Normal file
View File

@@ -0,0 +1,362 @@
' 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.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.EventArguments
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
Namespace API.OnlyFans
Friend Class UserData : Inherits UserDataBase
#Region "Declarations"
Friend Property CCookie As CookieKeeper = Nothing
Private Const HeaderSign As String = "Sign"
Private Const HeaderTime As String = "Time"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not CCookie Is Nothing Then CCookie.Dispose()
CCookie = Responser.Cookies.Copy
Responser.Cookies.Clear()
AddHandler Responser.ResponseReceived, AddressOf OnResponseReceived
UpdateCookieHeader()
DownloadData(IIf(IsSavedPosts, 0, String.Empty), Token)
End Sub
Private Sub OnResponseReceived(ByVal Sender As Object, ByVal e As WebDataResponse)
If e.CookiesExists Then
CCookie.Update(e.Cookies, CookieKeeper.UpdateModes.ReplaceByNameAll,, EDP.ReturnValue)
UpdateCookieHeader()
End If
End Sub
Private Sub UpdateCookieHeader()
Responser.Headers.Add("Cookie", CCookie.ToString(False))
End Sub
Private Const BaseUrlPattern As String = "https://onlyfans.com{0}"
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim url$ = String.Empty
Dim _complete As Boolean = True
Do
Try
Dim tmpCursor$ = String.Empty
Dim hasMore As Boolean = False
Dim path$ = String.Empty
Dim postDate$, postID$
Dim n As EContainer
Dim mediaList As List(Of UserMedia)
Dim mediaResult As Boolean
If IsSavedPosts Then
path = $"/api2/v2/posts/bookmarks/all/?format=infinite&limit=10&offset={Cursor}"
Else
If ID.IsEmptyString Then GetUserID()
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID")
path = $"/api2/v2/users/{ID}/posts/medias?limit=50&order=publish_date_desc&skip_users=all&format=infinite&counters=1"
If Not Cursor.IsEmptyString Then path &= $"&counters=0&beforePublishTime={Cursor}" Else path &= "&counters=1"
End If
If UpdateSignature(path) Then
url = String.Format(BaseUrlPattern, path)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
If IsSavedPosts Then
hasMore = j.Value("hasMore").FromXML(Of Boolean)(False)
Else
tmpCursor = j.Value("tailMarker")
hasMore = Not tmpCursor.IsEmptyString
End If
With j("list")
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each n In .Self
ProgressPre.Perform()
postID = n.Value("id")
postDate = n.Value("postedAt")
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.Add(postID)
Else
Exit Sub
End If
Select Case MyBase.CheckDatesLimit(postDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
mediaResult = False
mediaList = TryCreateMedia(n, postID, postDate, mediaResult)
If mediaResult Then _TempMediaList.ListAddList(mediaList, LNC)
Next
Else
hasMore = False
End If
End With
End If
End Using
End If
End If
If hasMore Then
If IsSavedPosts Then tmpCursor = CInt(Cursor.IfNullOrEmpty(0)) + 10
DownloadData(tmpCursor, Token)
End If
Catch ex As Exception
If ProcessException(ex, Token, $"data downloading error [{url}]") = 2 Then _complete = False
End Try
Loop While Not _complete
End Sub
Private Function TryCreateMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal PostDate As String = Nothing,
Optional ByRef Result As Boolean = False) As List(Of UserMedia)
Dim postUrl$, ext$
Dim t As UTypes
Dim mList As New List(Of UserMedia)
Result = False
With n("media")
If .ListExists Then
For Each m In .Self
postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg"
Case "video" : t = UTypes.Video : ext = "mp4"
Case Else : t = UTypes.Undefined : ext = String.Empty
End Select
If Not t = UTypes.Undefined And Not postUrl.IsEmptyString Then
Dim media As New UserMedia(postUrl, t) With {
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing))}
media.File.Extension = ext
Result = True
mList.Add(media)
End If
Next
End If
End With
Return mList
End Function
Private Sub GetUserID()
Dim path$ = $"/api2/v2/users/{Name}"
Dim url$ = String.Format(BaseUrlPattern, path)
Try
If ID.IsEmptyString AndAlso UpdateSignature(path) Then
Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
ID = j.Value("id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
UserSiteNameUpdate(j.Value("name"))
UserDescriptionUpdate(j.Value("about"))
Dim a As Action(Of String) = Sub(ByVal address As String)
If Not address.IsEmptyString Then
Dim f As SFile = address
f.Separator = "\"
f.Path = DownloadContentDefault_GetRootDir()
If Not f.Exists Then GetWebFile(address, f, EDP.None)
End If
End Sub
a.Invoke(j.Value("avatar"))
a.Invoke(j.Value("header"))
End If
End Using
End If
End If
Catch ex As Exception
ProcessException(ex, Nothing, $"user info parsing error [{url}]")
End Try
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const PathPattern$ = "/api2/v2/posts/{0}?skip_users=all"
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim mList As List(Of UserMedia)
Dim mediaResult As Boolean
Dim r$, path$, postDate$
Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
path = String.Format(PathPattern, m.Post.ID)
If UpdateSignature(path) Then
URL = String.Format(BaseUrlPattern, path)
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
postDate = j.Value("postedAt")
mediaResult = False
mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult)
If mediaResult Then
_TempMediaList.ListAddList(mList, LNC)
rList.Add(i)
mList.Clear()
End If
j.Dispose()
End If
End If
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(i) : Next
rList.Clear()
End If
End Try
End Sub
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim postID$ = RegexReplace(Data.URL, RegExPostID)
If Not postID.IsEmptyString Then _ContentList.Add(New UserMedia With {.Post = postID, .State = UStates.Missing}) : ReparseMissing(Token)
End Sub
#End Region
#Region "Auth"
Private ReadOnly Property AuthFile As SFile
Get
Dim f As SFile = MySettings.Responser.File
f.Name &= "_Auth"
f.Extension = "json"
Return f
End Get
End Property
Private Function UpdateSignature(ByVal Path As String, Optional ByVal ForceUpdateAuth As Boolean = False) As Boolean
Try
If UpdateAuthFile(ForceUpdateAuth) Then
Const nullMsg$ = "The auth parameter is null"
Dim j As EContainer = JsonDocument.Parse(AuthFile.GetText)
Dim pattern$ = j.Value("format")
If pattern.IsEmptyString Then Throw New ArgumentNullException("format", nullMsg)
pattern = pattern.Replace("{}", "{0}").Replace("{:x}", "{1:x}")
Dim li%() = j("checksum_indexes").Select(Function(e) CInt(e(0).Value)).ToArray
If Not li.ListExists Then Throw New ArgumentNullException("checksum_indexes", nullMsg)
If j.Value("static_param").IsEmptyString Then Throw New ArgumentNullException("static_param", nullMsg)
If j.Value("checksum_constant").IsEmptyString Then Throw New ArgumentNullException("checksum_constant", nullMsg)
Dim t$ = ADateTime.ConvertToUnix64(Now.ToUniversalTime).ToString
Dim h$ = String.Join(vbLf, j.Value("static_param"), t, Path, MySettings.HH_USER_ID.Value.ToString)
Dim hash$ = GetHashSha1(h)
Dim hashBytes() As Byte = System.Text.Encoding.ASCII.GetBytes(hash)
Dim hashSum% = li.Sum(Function(i) hashBytes(i)) + CInt(j.Value("checksum_constant"))
Dim sign$ = String.Format(pattern, hash, Math.Abs(hashSum))
'#If DEBUG Then
'Debug.WriteLine(sign)
'Debug.WriteLine(t)
'#End If
Responser.Headers.Add(HeaderSign, sign)
Responser.Headers.Add(HeaderTime, t)
j.Dispose()
Return True
Else
Return False
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateSignature", False)
End Try
End Function
Private Function UpdateAuthFile(ByVal Force As Boolean) As Boolean
Const urlOld$ = "https://raw.githubusercontent.com/DATAHOARDERS/dynamic-rules/main/onlyfans.json"
Const urlNew$ = "https://raw.githubusercontent.com/DIGITALCRIMINALS/dynamic-rules/main/onlyfans.json"
Try
If MySettings.LastDateUpdated.AddMinutes(CInt(MySettings.DynamicRulesUpdateInterval.Value)) < Now Or Not AuthFile.Exists Or Force Then
Dim r$ = GetWebString(If(ACheck(Of String)(MySettings.DynamicRules.Value),
CStr(MySettings.DynamicRules.Value),
IIf(MySettings.UseOldAuthRules.Value, urlOld, urlNew)),, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
If Not j.Value("format").IsEmptyString And j("checksum_indexes").ListExists And
Not j.Value("static_param").IsEmptyString And Not j.Value("checksum_constant").IsEmptyString Then _
TextSaver.SaveTextToFile(r, AuthFile, True, False, EDP.ThrowException) : MySettings.LastDateUpdated = Now
End If
End Using
End If
End If
Return AuthFile.Exists
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateAuthFile", False)
End Try
End Function
Private Function GetHashSha1(ByVal Input As String) As String
Dim s As New Security.Cryptography.SHA1CryptoServiceProvider
Dim inputBytes() As Byte = System.Text.Encoding.UTF8.GetBytes(Input)
Dim hashBytes() As Byte = s.ComputeHash(inputBytes)
s.Dispose()
Dim result As String = String.Empty
For Each b As Byte In hashBytes : result &= b.ToString("x2") : Next
Return result
End Function
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
#End Region
#Region "DownloadingException"
Private _DownloadingException_AuthFileUpdate As Boolean = False
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then
If Not _DownloadingException_AuthFileUpdate AndAlso UpdateAuthFile(True) Then
_DownloadingException_AuthFileUpdate = True
Return 2
Else
MySettings.SessionAborted = True
MyMainLOG = $"{ToStringForLog()}: OnlyFans credentials expired"
Return 1
End If
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then
UserExists = False
Return 1
Else
Return 0
End If
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then CCookie.DisposeIfReady(False) : CCookie = Nothing
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

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

@@ -585,12 +585,32 @@ Namespace API.Reddit
End If End If
End If End If
If Not added And e.Contains("preview") Then If Not added And e.Contains("preview") Then
tmpUrl = If(e.ItemF({"preview", "images", eCount, "source", "url"})?.Value, String.Empty) With e.ItemF({"preview", "images", eCount})
If Not tmpUrl.IsEmptyString Then If .ListExists Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, UserID), LNC) tmpType = UTypes.Undefined
_TotalPostsDownloaded += 1 tmpUrl = String.Empty
added = True Dim sv$ = .Value({"source"}, "url")
End If If Not sv.IsEmptyString AndAlso sv.Contains(".gif") Then
tmpUrl = .Value({"variants", "gif", "source"}, "url")
If Not tmpUrl.IsEmptyString Then tmpType = UTypes.GIF
End If
If tmpUrl.IsEmptyString Then
tmpUrl = .Value({"variants", "mp4", "source"}, "url")
If Not tmpUrl.IsEmptyString Then tmpType = UTypes.Video
End If
If tmpUrl.IsEmptyString Then
tmpUrl = .Value({"source"}, "url")
If Not tmpUrl.IsEmptyString Then tmpType = UTypes.Picture
End If
If Not tmpUrl.IsEmptyString And Not tmpType = UTypes.Undefined Then
Dim m As UserMedia = MediaFromData(tmpType, tmpUrl, PostID, PostDate, UserID)
If tmpType = UTypes.Video Then m.File.Extension = "mp4"
_TempMediaList.ListAddValue(m, LNC)
_TotalPostsDownloaded += 1
added = True
End If
End If
End With
End If End If
End If End If
End If End If

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

@@ -186,7 +186,8 @@ Namespace API.Twitter
Return True Return True
End Function End Function
tCache = New CacheKeeper($"{DownloadContentDefault_GetRootDir()}\_tCache\") tCache = New CacheKeeper($"{DownloadContentDefault_GetRootDir()}\_tCache\") With {
.CacheDeleteError = New ErrorsDescriber(EDP.None) With {.Action = Sub(ee, eex, msg, obj) Settings.Cache.AddPath(tCache)}}
If tCache.RootDirectory.Exists(SFO.Path, False) Then tCache.RootDirectory.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.ReturnValue) If tCache.RootDirectory.Exists(SFO.Path, False) Then tCache.RootDirectory.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.ReturnValue)
tCache.Validate() tCache.Validate()

8
SCrawler/API/Xhamster/UserData.vb
View File

@@ -10,6 +10,7 @@ Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
@@ -287,8 +288,11 @@ Namespace API.Xhamster
End Try End Try
End Function End Function
Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal j As EContainer) As Boolean Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal j As EContainer) As Boolean
Dim url$ = j.Value({"xplayerSettings", "sources", "hls"}, "url") Dim node As EContainer = j({"xplayerSettings", "sources", "hls"})
If Not url.IsEmptyString Then m.URL = url : m.Type = UTypes.m3u8 : Return True If node.ListExists Then
Dim url$ = node.GetNode({New NodeParams("url", True, True, True, True, 2)})
If Not url.IsEmptyString Then m.URL = url : m.Type = UTypes.m3u8 : Return True
End If
Return False Return False
End Function End Function
#End Region #End Region

BIN
SCrawler/Content/Icons/SiteIcons/OnlyFansIcon_32.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 15 KiB

BIN
SCrawler/Content/Pictures/SitePictures/OnlyFansPic_32.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

21
SCrawler/Download/ActiveDownloadingProgress.vb
View File

@@ -62,8 +62,7 @@ Namespace DownloadObjects
.RowStyles.Add(New RowStyle(SizeType.Absolute, RowHeight)) .RowStyles.Add(New RowStyle(SizeType.Absolute, RowHeight))
.RowCount += 1 .RowCount += 1
JobsList.Add(New DownloadProgress(j)) JobsList.Add(New DownloadProgress(j))
AddHandler JobsList.Last.ProgressMaximumChanged, AddressOf Jobs_ProgressMaximumChanged AddHandler JobsList.Last.ProgressChanged, AddressOf Jobs_ProgressChanged
AddHandler JobsList.Last.ProgressMaximum0Changed, AddressOf Jobs_ProgressMaximum0Changed
.Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1) .Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1)
End With End With
Next Next
@@ -84,16 +83,18 @@ Namespace DownloadObjects
End Sub End Sub
If TP_MAIN.InvokeRequired Then TP_MAIN.Invoke(a) Else a.Invoke If TP_MAIN.InvokeRequired Then TP_MAIN.Invoke(a) Else a.Invoke
End Sub End Sub
Private Sub Jobs_ProgressMaximumChanged() Private Sub Jobs_ProgressChanged(ByVal Main As Boolean, ByVal IsMaxValue As Boolean, ByVal IsDone As Boolean)
If JobsList.Count > 0 And Not DisableProgressChange Then If JobsList.Count > 0 And Not DisableProgressChange Then
MainProgress.Maximum = JobsList.Sum(Function(j) CLng(j.Job.Progress.Maximum)) If Main Then
MainProgress.Value = Math.Max(JobsList.Sum(Function(j) CLng(j.Job.Progress.Value)) - 1, 0) MainProgress.Maximum = JobsList.Sum(Function(j) CLng(j.Job.Progress.Maximum))
If MainProgress.Value > 0 Then MainProgress.Perform() MainProgress.Value = Math.Max(JobsList.Sum(Function(j) CLng(j.Job.Progress.Value)) - 1, 0)
If MainProgress.Value > 0 Then MainProgress.Perform()
Else
MainProgress.Maximum0 = JobsList.Sum(Function(j) CLng(DirectCast(j.Job.Progress, MyProgressExt).Maximum0))
MainProgress.Value0 = Math.Max(JobsList.Sum(Function(j) CLng(DirectCast(j.Job.Progress, MyProgressExt).Value0)) - 1, 0)
If MainProgress.Value0 > 0 Then MainProgress.Perform0()
End If
End If End If
End Sub End Sub
Private Sub Jobs_ProgressMaximum0Changed()
If JobsList.Count > 0 And Not DisableProgressChange Then _
MainProgress.Maximum0 = JobsList.Sum(Function(j) CLng(DirectCast(j.Job.Progress, MyProgressExt).Maximum0))
End Sub
End Class End Class
End Namespace End Namespace

25
SCrawler/Download/DownloadProgress.vb
View File

@@ -13,8 +13,7 @@ Namespace DownloadObjects
Friend Class DownloadProgress : Implements IDisposable Friend Class DownloadProgress : Implements IDisposable
#Region "Events" #Region "Events"
Friend Event DownloadDone As NotificationEventHandler Friend Event DownloadDone As NotificationEventHandler
Friend Event ProgressMaximumChanged() Friend Event ProgressChanged(ByVal Main As Boolean, ByVal IsMaxValue As Boolean, ByVal IsDone As Boolean)
Friend Event ProgressMaximum0Changed()
#End Region #End Region
#Region "Declarations" #Region "Declarations"
#Region "Controls" #Region "Controls"
@@ -127,6 +126,8 @@ Namespace DownloadObjects
AddHandler .MaximumChanged, AddressOf JobProgress_MaximumChanged AddHandler .MaximumChanged, AddressOf JobProgress_MaximumChanged
AddHandler .Maximum0Changed, AddressOf JobProgress_Maximum0Changed AddHandler .Maximum0Changed, AddressOf JobProgress_Maximum0Changed
AddHandler .Progress0Changed, AddressOf JobProgress_Progress0Changed AddHandler .Progress0Changed, AddressOf JobProgress_Progress0Changed
AddHandler .ProgressCompleted, AddressOf JobProgress_Done
AddHandler .Progress0Completed, AddressOf JobProgress_Done0
End With End With
End With End With
@@ -190,22 +191,22 @@ Namespace DownloadObjects
#End Region #End Region
#Region "Progress, Jobs count" #Region "Progress, Jobs count"
Private Sub JobProgress_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Private Sub JobProgress_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
RaiseEvent ProgressMaximumChanged() If Not Job.Type = Download.SavedPosts Then RaiseEvent ProgressChanged(True, True, False)
End Sub End Sub
Private Sub JobProgress_Maximum0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs) Private Sub JobProgress_Maximum0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs)
RaiseEvent ProgressMaximum0Changed() If Not Job.Type = Download.SavedPosts Then RaiseEvent ProgressChanged(False, True, False)
End Sub End Sub
Private Sub JobProgress_ProgressChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Private Sub JobProgress_ProgressChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If Not Job.Type = Download.SavedPosts Then If Not Job.Type = Download.SavedPosts Then MainProgress.Perform()
MainProgress.Value = DirectCast(Sender, MyProgressExt).Value
MainProgress.Perform(0)
End If
End Sub End Sub
Private Sub JobProgress_Progress0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs) Private Sub JobProgress_Progress0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If Not Job.Type = Download.SavedPosts Then If Not Job.Type = Download.SavedPosts Then MainProgress.Perform0()
MainProgress.Value0 = DirectCast(Job.Progress, MyProgressExt).Value0 End Sub
MainProgress.Perform0(0) Private Sub JobProgress_Done(ByVal Sender As Object, ByVal e As ProgressEventArgs)
End If If Not Job.Type = Download.SavedPosts Then RaiseEvent ProgressChanged(True, False, True)
End Sub
Private Sub JobProgress_Done0(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If Not Job.Type = Download.SavedPosts Then RaiseEvent ProgressChanged(False, False, True)
End Sub End Sub
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"

4
SCrawler/My Project/AssemblyInfo.vb
View File

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

71
SCrawler/MyProgressExt.vb
View File

@@ -21,41 +21,23 @@ Friend Class PreProgress : Implements IDisposable
ProgressExists = True ProgressExists = True
End If End If
End Sub End Sub
Private _Maximum As Integer = 0
Friend Sub ChangeMax(ByVal Value As Integer, Optional ByVal Add As Boolean = True) Friend Sub ChangeMax(ByVal Value As Integer, Optional ByVal Add As Boolean = True)
If Ready Then If Ready Then
If Add Then If Add Then
_Maximum += Value
If Value > 0 Then Progress.Maximum0 += Value If Value > 0 Then Progress.Maximum0 += Value
Else Else
_Maximum = Value
Progress.Maximum0 = Value Progress.Maximum0 = Value
End If End If
End If End If
End Sub End Sub
Private CumulVal As Integer = 0
Friend Sub Perform(Optional ByVal Value As Integer = 1) Friend Sub Perform(Optional ByVal Value As Integer = 1)
If Ready Then If Ready Then Progress.Perform0(Value)
CumulVal += Value
Progress.Perform0(Value)
End If
End Sub End Sub
Friend Sub Reset() Friend Sub Reset()
_Maximum = 0 If Ready Then Progress.Reset0()
CumulVal = 0
End Sub End Sub
Friend Sub Done() Friend Sub Done()
If Ready Then If Ready Then Progress.Done0()
Dim v# = _Maximum - CumulVal
If v > 0 Then
With Progress
If v + .Value0 > .Maximum0 Then v = .Maximum0 - .Value0
If v < 0 Then v = 0
.Perform0(v)
Reset()
End With
End If
End If
End Sub End Sub
#Region "IDisposable Support" #Region "IDisposable Support"
Private disposedValue As Boolean = False Private disposedValue As Boolean = False
@@ -85,14 +67,7 @@ Friend Class MyProgressExt : Inherits MyProgress
_Progress0ChangedEventHandlers.Remove(h) _Progress0ChangedEventHandlers.Remove(h)
End RemoveHandler End RemoveHandler
RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs) RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If _Progress0ChangedEventHandlers.Count > 0 Then InvokeHandlers(_Progress0ChangedEventHandlers, Sender, e)
Try
For i% = 0 To _Progress0ChangedEventHandlers.Count - 1
Try : _Progress0ChangedEventHandlers(i).Invoke(Sender, e) : Catch : End Try
Next
Catch
End Try
End If
End RaiseEvent End RaiseEvent
End Event End Event
Private ReadOnly _Maximum0ChangedEventHandlers As List(Of EventHandler(Of ProgressEventArgs)) Private ReadOnly _Maximum0ChangedEventHandlers As List(Of EventHandler(Of ProgressEventArgs))
@@ -104,14 +79,19 @@ Friend Class MyProgressExt : Inherits MyProgress
_Maximum0ChangedEventHandlers.Remove(h) _Maximum0ChangedEventHandlers.Remove(h)
End RemoveHandler End RemoveHandler
RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs) RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If _Maximum0ChangedEventHandlers.Count > 0 Then InvokeHandlers(_Maximum0ChangedEventHandlers, Sender, e)
Try End RaiseEvent
For i% = 0 To _Maximum0ChangedEventHandlers.Count - 1 End Event
Try : _Maximum0ChangedEventHandlers(i).Invoke(Sender, e) : Catch : End Try Private ReadOnly _Progress0CompletedEventHandlers As List(Of EventHandler(Of ProgressEventArgs))
Next Friend Custom Event Progress0Completed As EventHandler(Of ProgressEventArgs)
Catch AddHandler(ByVal h As EventHandler(Of ProgressEventArgs))
End Try If Not _Progress0CompletedEventHandlers.Contains(h) Then _Progress0CompletedEventHandlers.Add(h)
End If End AddHandler
RemoveHandler(ByVal h As EventHandler(Of ProgressEventArgs))
_Progress0CompletedEventHandlers.Remove(h)
End RemoveHandler
RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs)
InvokeHandlers(_Progress0CompletedEventHandlers, Sender, e)
End RaiseEvent End RaiseEvent
End Event End Event
Private WithEvents PR_PRE As MyProgress Private WithEvents PR_PRE As MyProgress
@@ -121,9 +101,13 @@ Friend Class MyProgressExt : Inherits MyProgress
Private Sub PR_PRE_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Handles PR_PRE.MaximumChanged Private Sub PR_PRE_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Handles PR_PRE.MaximumChanged
RaiseEvent Maximum0Changed(Sender, e) RaiseEvent Maximum0Changed(Sender, e)
End Sub End Sub
Private Sub PR_PRE_ProgressCompleted(ByVal Sender As Object, ByVal e As ProgressEventArgs) Handles PR_PRE.ProgressCompleted
RaiseEvent Progress0Completed(Sender, e)
End Sub
Friend Sub New() Friend Sub New()
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs)) _Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs)) _Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Progress0CompletedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub End Sub
Friend Sub New(ByRef StatusStrip As StatusStrip, ByRef ProgressBar As ToolStripProgressBar, ByRef ProgressBarPre As ToolStripProgressBar, ByRef Label As ToolStripStatusLabel, Friend Sub New(ByRef StatusStrip As StatusStrip, ByRef ProgressBar As ToolStripProgressBar, ByRef ProgressBarPre As ToolStripProgressBar, ByRef Label As ToolStripStatusLabel,
Optional ByVal Information As String = Nothing) Optional ByVal Information As String = Nothing)
@@ -131,12 +115,14 @@ Friend Class MyProgressExt : Inherits MyProgress
PR_PRE = New MyProgress(StatusStrip, ProgressBarPre, Nothing) With {.PerformMod = 10, .ResetProgressOnMaximumChanges = False} PR_PRE = New MyProgress(StatusStrip, ProgressBarPre, Nothing) With {.PerformMod = 10, .ResetProgressOnMaximumChanges = False}
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs)) _Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs)) _Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Progress0CompletedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub End Sub
Friend Sub New(ByRef ProgressBar As ProgressBar, ByRef ProgressBarPre As ProgressBar, ByRef Label As Label, Optional ByVal Information As String = Nothing) Friend Sub New(ByRef ProgressBar As ProgressBar, ByRef ProgressBarPre As ProgressBar, ByRef Label As Label, Optional ByVal Information As String = Nothing)
MyBase.New(ProgressBar, Label, Information) MyBase.New(ProgressBar, Label, Information)
PR_PRE = New MyProgress(ProgressBarPre, Nothing) With {.PerformMod = 10, .ResetProgressOnMaximumChanges = False} PR_PRE = New MyProgress(ProgressBarPre, Nothing) With {.PerformMod = 10, .ResetProgressOnMaximumChanges = False}
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs)) _Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs)) _Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Progress0CompletedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub End Sub
Friend Property Maximum0 As Double Friend Property Maximum0 As Double
Get Get
@@ -161,10 +147,16 @@ Friend Class MyProgressExt : Inherits MyProgress
PR_PRE.Done() PR_PRE.Done()
MyBase.Done() MyBase.Done()
End Sub End Sub
Public Overrides Sub Reset() Friend Sub Done0()
MyBase.Reset()
PR_PRE.Done() PR_PRE.Done()
End Sub End Sub
Public Overrides Sub Reset()
PR_PRE.Reset()
MyBase.Reset()
End Sub
Friend Sub Reset0()
PR_PRE.Reset()
End Sub
Public Overrides Property Visible(Optional ByVal ProgressBar As Boolean = True, Optional ByVal Label As Boolean = True) As Boolean Public Overrides Property Visible(Optional ByVal ProgressBar As Boolean = True, Optional ByVal Label As Boolean = True) As Boolean
Get Get
Return MyBase.Visible(ProgressBar, Label) Return MyBase.Visible(ProgressBar, Label)
@@ -178,6 +170,7 @@ Friend Class MyProgressExt : Inherits MyProgress
If Not disposedValue And disposing Then If Not disposedValue And disposing Then
_Progress0ChangedEventHandlers.Clear() _Progress0ChangedEventHandlers.Clear()
_Maximum0ChangedEventHandlers.Clear() _Maximum0ChangedEventHandlers.Clear()
_Progress0CompletedEventHandlers.Clear()
PR_PRE.Dispose() PR_PRE.Dispose()
End If End If
MyBase.Dispose(disposing) MyBase.Dispose(disposing)

3
SCrawler/PluginsEnvironment/Hosts/PluginHost.vb
View File

@@ -88,7 +88,8 @@ Namespace Plugin.Hosts
New PluginHost(New API.Xhamster.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(New API.Xhamster.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.XVIDEOS.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(New API.XVIDEOS.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.ThisVid.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(New API.ThisVid.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.PathPlugin.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)} New PluginHost(New API.PathPlugin.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.OnlyFans.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)}
End Function End Function
Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile, Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean), ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean),

9
SCrawler/SCrawler.vbproj
View File

@@ -188,6 +188,9 @@
</Compile> </Compile>
<Compile Include="API\Mastodon\SiteSettings.vb" /> <Compile Include="API\Mastodon\SiteSettings.vb" />
<Compile Include="API\Mastodon\UserData.vb" /> <Compile Include="API\Mastodon\UserData.vb" />
<Compile Include="API\OnlyFans\Declarations.vb" />
<Compile Include="API\OnlyFans\SiteSettings.vb" />
<Compile Include="API\OnlyFans\UserData.vb" />
<Compile Include="API\PathPlugin\Declarations.vb" /> <Compile Include="API\PathPlugin\Declarations.vb" />
<Compile Include="API\PathPlugin\SiteSettings.vb" /> <Compile Include="API\PathPlugin\SiteSettings.vb" />
<Compile Include="API\PathPlugin\UserData.vb" /> <Compile Include="API\PathPlugin\UserData.vb" />
@@ -661,6 +664,12 @@
<ItemGroup> <ItemGroup>
<None Include="Content\Icons\SiteIcons\MastodonIcon_48.ico" /> <None Include="Content\Icons\SiteIcons\MastodonIcon_48.ico" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<None Include="Content\Pictures\SitePictures\OnlyFansPic_32.png" />
</ItemGroup>
<ItemGroup>
<None Include="Content\Icons\SiteIcons\OnlyFansIcon_32.ico" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
<Import Project="..\packages\VideoLAN.LibVLC.Windows.3.0.17.4\build\VideoLAN.LibVLC.Windows.targets" Condition="Exists('..\packages\VideoLAN.LibVLC.Windows.3.0.17.4\build\VideoLAN.LibVLC.Windows.targets')" /> <Import Project="..\packages\VideoLAN.LibVLC.Windows.3.0.17.4\build\VideoLAN.LibVLC.Windows.targets" Condition="Exists('..\packages\VideoLAN.LibVLC.Windows.3.0.17.4\build\VideoLAN.LibVLC.Windows.targets')" />
<Target Name="EnsureNuGetPackageBuildImports" BeforeTargets="PrepareForBuild"> <Target Name="EnsureNuGetPackageBuildImports" BeforeTargets="PrepareForBuild">

20
SCrawler/SiteResources.Designer.vb generated
View File

@@ -124,6 +124,26 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
'''</summary>
Friend Shared ReadOnly Property OnlyFansIcon_32() As System.Drawing.Icon
Get
Dim obj As Object = ResourceManager.GetObject("OnlyFansIcon_32", resourceCulture)
Return CType(obj,System.Drawing.Icon)
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>
Friend Shared ReadOnly Property OnlyFansPic_32() As System.Drawing.Bitmap
Get
Dim obj As Object = ResourceManager.GetObject("OnlyFansPic_32", resourceCulture)
Return CType(obj,System.Drawing.Bitmap)
End Get
End Property
'''<summary> '''<summary>
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon). ''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
'''</summary> '''</summary>

6
SCrawler/SiteResources.resx
View File

@@ -136,6 +136,12 @@
<data name="MastodonPic_48" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="MastodonPic_48" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Pictures\SitePictures\MastodonPic_48.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value> <value>Content\Pictures\SitePictures\MastodonPic_48.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data> </data>
<data name="OnlyFansIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Icons\SiteIcons\OnlyFansIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="OnlyFansPic_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Pictures\SitePictures\OnlyFansPic_32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="PinterestIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="PinterestIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Icons\SiteIcons\PinterestIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value> <value>Content\Icons\SiteIcons\PinterestIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data> </data>