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.08.10.0

Browse Source 
Add JFF

Update groups
Add advanced filter
Add advanced download
Disable 'ShowInTaskbar' on several forms
API.Base.M3U8: add external cache support
API.Base.UserDataBase: update token names
Feed.FeedMedia: add clone icon
UserCreatorForm: fix bug collection labels not showing
MainFrame: update 'DownloadSiteFull' function
UserSearchForm: move focus to textbox on form is open
This commit is contained in:
Andy
2023-08-10 22:42:29 +03:00
parent 58927b3113
commit 1b1226025a
33 changed files with 1017 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
SCrawler/API/Base/M3U8Base.vb
View File

@@ -34,7 +34,7 @@ Namespace API.Base
End Function
Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing,
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing,
Optional ByVal UsePreProgress As Boolean = True) As SFile
Optional ByVal UsePreProgress As Boolean = True, Optional ByVal ExistingCache As CacheKeeper = Nothing) As SFile
Dim Cache As CacheKeeper = Nothing
Using tmpPr As New PreProgress(Progress)
Try
@@ -42,8 +42,12 @@ Namespace API.Base
Dim ConcatFile As SFile = DestinationFile
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
ConcatFile.Extension = "mp4"
If ExistingCache Is Nothing Then
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\")
Cache.CacheDeleteError = CacheDeletionError(Cache)
Else
Cache = ExistingCache
End If
Dim cache2 As CacheKeeper = Cache.NewInstance
If cache2.RootDirectory.Exists(SFO.Path) Then
Dim progressExists As Boolean = Not Progress Is Nothing

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

@@ -751,7 +751,6 @@ BlockNullPicture:
End Function
Friend Overridable Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet
End Sub
Private _ExternalCompatibilityToken As CancellationToken
#End Region
#Region "IIndexable Support"
Friend Property Index As Integer = 0 Implements IIndexable.Index
@@ -1082,7 +1081,8 @@ BlockNullPicture:
Return __DOWNLOAD_IN_PROGRESS
End Get
End Property
Friend PersonalToken As CancellationToken
Private TokenQueue As CancellationToken
Friend TokenPersonal As CancellationToken
Protected Responser As Responser
Protected UseResponserClient As Boolean = False
Protected UseClientTokens As Boolean = False
@@ -1096,7 +1096,7 @@ BlockNullPicture:
Private _PictureExists As Boolean
Private _EnvirInvokeUserUpdated As Boolean = False
Protected Sub EnvirDownloadSet()
PersonalToken = Nothing
TokenPersonal = Nothing
ProgressPre.Reset()
UpdateDataFiles()
_DownloadInProgress = True
@@ -1128,7 +1128,7 @@ BlockNullPicture:
__DOWNLOAD_IN_PROGRESS = True
OnUserDownloadStateChanged(True)
Dim Canceled As Boolean = False
_ExternalCompatibilityToken = Token
TokenQueue = Token
Try
EnvirDownloadSet()
If Not Responser Is Nothing Then Responser.Dispose()
@@ -1191,6 +1191,7 @@ BlockNullPicture:
End Function))
Else
DownloadContent(Token)
DownloadedPictures(False) += 1
ThrowIfDisposed()
End If
@@ -1221,7 +1222,7 @@ BlockNullPicture:
End If
ThrowIfDisposed()
If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or PersonalToken.IsCancellationRequested
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested
MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True
Catch exit_ex As ExitException
@@ -1288,6 +1289,7 @@ BlockNullPicture:
Try
Data.DownloadState = UserMediaStates.Tried
Progress = Data.Progress
If Not Progress Is Nothing Then Progress.ResetProgressOnMaximumChanges = False
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Responser
If Not HOST Is Nothing AndAlso HOST.Available(ISiteSettings.Download.SingleObject, True) AndAlso
@@ -1722,7 +1724,7 @@ BlockNullPicture:
Optional ByVal ThrowEx As Boolean = True) As Integer
If TypeOf ex Is ExitException Then
Throw ex
ElseIf Not ((TypeOf ex Is OperationCanceledException And (Token.IsCancellationRequested Or PersonalToken.IsCancellationRequested)) Or
ElseIf Not ((TypeOf ex Is OperationCanceledException And (Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested)) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE Then
Dim v% = DownloadingException(ex, Message, True, EObj)
@@ -2031,13 +2033,14 @@ BlockNullPicture:
End Sub
''' <inheritdoc cref="ThrowAny(CancellationToken)"/>
Private Overloads Sub ThrowAny() Implements IThrower.ThrowAny
ThrowAny(_ExternalCompatibilityToken)
ThrowAny(TokenQueue)
End Sub
''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception>
Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
PersonalToken.ThrowIfCancellationRequested()
TokenQueue.ThrowIfCancellationRequested()
TokenPersonal.ThrowIfCancellationRequested()
ThrowIfDisposed()
End Sub
#End Region

33
SCrawler/API/JustForFans/Declarations.vb Normal file
View File

@@ -0,0 +1,33 @@
' 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.Text.RegularExpressions
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.JustForFans
Friend Module Declarations
Friend Const NamePhotoLarge As String = "expandable"
Friend Const NamePhotoSmall As String = "galThumb"
Private Const PostDateUrlPattern As String = "\<div.class=.mbsc-card-subtitle[^\>]*?location.href='([^']+)[^\>]*?\>([^\<]+?)\<"
Friend ReadOnly RegexUser As RParams = RParams.DMS("GetStats2\(UserID\)\{\s*var Hash = '([^']+)'[;\s/]*(var Hash = '([^']+)'|)", 1)
Friend ReadOnly RegexVideoBlock As RParams =
RParams.DM("((\<div mbsc-card class=""mbsc-card[^\>]*?id=""([^""]+)[^\>]*?\>)\s*\<div class=""mbsc-card-header.+?\<a class=""gridAction[^\>]*?\>[^\<\>]*?\</a\>\s*\</div>)",
0, RegexReturn.List, RegexOptions.Singleline, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_Video As RParams = RParams.DMS("<script>.\s*/\*\s*\$\(document\).ready\(function\(\) \{\s*MakeMovieVideoJS\(.*?(\{.+?\})", 1,
RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue)
Friend ReadOnly Regex_Photo As RParams = RParams.DM("\<img.+?class=""(expandable|galThumb)"".*?(data-lazy|src)=""([^""]+)""", 0,
RegexReturn.List, RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue)
Friend ReadOnly Regex_Gallery As RParams = RParams.DM("\<div[^\>]+?class=.imageGallery", 0, EDP.ReturnValue)
Friend ReadOnly Regex_PostDate As RParams = RParams.DMS(PostDateUrlPattern, 2, RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue,
CType(Function(Input$) Input.StringTrim, Func(Of String, String)))
Friend ReadOnly Regex_PostURL As RParams = RParams.DMS(PostDateUrlPattern, 1, RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue,
CType(Function(Input$) Input.StringTrim, Func(Of String, String)))
Friend ReadOnly Regex_PostID As RParams = RParams.DMS("[&\?]{1}post=([^&\?]+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly DateProvider As New ADateTime("MMMM d, yyyy, h:mm tt")
Friend ReadOnly DateProviderVideoFileName As New ADateTime("yyyyMMdd_HHmmss")
End Module
End Namespace

227
SCrawler/API/JustForFans/M3U8.vb Normal file
View File

@@ -0,0 +1,227 @@
' 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 PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.JustForFans
Friend NotInheritable Class M3U8 : Implements IDisposable
#Region "Declarations"
Friend Const AllVid As UTypes = UTypes.m3u8 + UTypes.VideoPre
Private ReadOnly DataVideo As List(Of String)
Private ReadOnly DataAudio As List(Of String)
Private Media As UserMedia
Private DestinationFile As SFile
Private ReadOnly Thrower As Plugin.IThrower
Private ReadOnly Responser As Responser
Private Const R_VIDEO_REGEX_PATTERN As String = "(#EXT-X-STREAM-INF)(.+)(RESOLUTION=\d+x)(\d+)(.+""\s*)(\S+)(\s*)"
Private ReadOnly REGEX_AUDIO_URL As RParams = RParams.DMS("EXT-X-MEDIA.*?URI=.([^""]+)"".*?TYPE=""AUDIO""", 1, EDP.ReturnValue)
Private ReadOnly REGEX_PLS_FILES As RParams = RParams.DM("EXT-X-MAP:URI=""([^""]+)""|EXTINF.+?[\r\n]{1,2}(.+)", 0, RegexReturn.List, EDP.ReturnValue)
Private UrlVideo As String
Private UrlAudio As String
Private FileVideo As SFile
Private FileAudio As SFile
Private RootPlaylistUrl As String
Private ReadOnly Cache As CacheKeeper
Private ReadOnly Progress As MyProgress
Private ReadOnly ProgressPre As PreProgress
Private ReadOnly ProgressExists As Boolean
Private ReadOnly UsePreProgress As Boolean
#End Region
#Region "Initializer"
Private Sub New(ByVal m As UserMedia, ByVal Destination As SFile, ByVal Resp As Responser, ByVal _Thrower As Plugin.IThrower,
ByVal _Progress As MyProgress, ByVal _UsePreProgress As Boolean)
Media = m
DataVideo = New List(Of String)
DataAudio = New List(Of String)
DestinationFile = Destination
Thrower = _Thrower
Responser = Resp
Progress = _Progress
ProgressExists = Not Progress Is Nothing
If ProgressExists Then ProgressPre = New PreProgress(Progress)
UsePreProgress = _UsePreProgress
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{M3U8Base.TempCacheFolderName}\")
With Cache
.CacheDeleteError = CacheDeletionError(Cache)
.DisposeSuspended = True
.Validate()
End With
End Sub
#End Region
#Region "Download functions"
Private Sub DownloadPre()
If Media.Type = AllVid Then
Dim r$ = Responser.GetResponse(Media.URL)
If Not r.IsEmptyString Then
Dim s As List(Of Sizes) = RegexFields(Of Sizes)(r, {RParams.DM(R_VIDEO_REGEX_PATTERN, 0, RegexReturn.List, EDP.ReturnValue)}, {4, 6}, EDP.ReturnValue)
If s.ListExists Then
s.Sort()
RootPlaylistUrl = s(0).Data
s.Clear()
End If
End If
Else
RootPlaylistUrl = Media.URL
End If
End Sub
Private Sub Download()
DownloadPre()
If RootPlaylistUrl.IsEmptyString Then
DestinationFile = Nothing
Else
Thrower.ThrowAny()
Dim r$ = Responser.GetResponse(RootPlaylistUrl)
If Not r.IsEmptyString Then
UrlVideo = RegexReplace(r, RParams.DMS(R_VIDEO_REGEX_PATTERN, 6, EDP.ReturnValue))
UrlAudio = RegexReplace(r, REGEX_AUDIO_URL)
If UrlVideo.IsEmptyString Then Throw New ArgumentException("Unable to identify m3u8 video track", "M3U8 video track")
Thrower.ThrowAny()
GetFiles(UrlVideo, FileVideo, False)
Thrower.ThrowAny()
If Not UrlAudio.IsEmptyString Then GetFiles(UrlAudio, FileAudio, True)
Thrower.ThrowAny()
MergeFiles()
End If
End If
End Sub
Private Sub GetFiles(ByVal URL As String, ByRef File As SFile, ByVal IsAudio As Boolean)
Try
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
If data.ListExists Then
Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
With (From d As RegexMatchStruct In data
Where Not d.Arr(0).IfNullOrEmpty(d.Arr(1)).IsEmptyString
Select M3U8Base.CreateUrl(appender, d.Arr(0).IfNullOrEmpty(d.Arr(1)))).ToList
If .ListExists Then
File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
Dim tmpCache As CacheKeeper = Cache.NewInstance
Dim tmpFile As SFile = .Item(0)
If tmpFile.Extension.IsEmptyString Then tmpFile.Extension = "ts"
tmpFile.Path = tmpCache.RootDirectory.Path
tmpFile.Separator = "\"
Dim cFile As SFile = tmpFile
cFile.Name = "all"
tmpCache.Validate()
Using bat As New TextSaver
Using b As New BatchExecutor(True) With {.Encoding = Settings.CMDEncoding}
AddHandler b.OutputDataReceived, AddressOf Batch_OutputDataReceived
bat.AppendLine($"chcp {BatchExecutor.UnicodeEncoding}")
bat.AppendLine(BatchExecutor.GetDirectoryCommand(tmpCache))
ProgressChangeMax(.Count * 2 + 1)
For i = 0 To .Count - 1
tmpFile.Name = $"ConPart_{i}"
Thrower.ThrowAny()
Responser.DownloadFile(.Item(i), tmpFile)
ProgressPerform()
tmpCache.AddFile(tmpFile, True)
bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
Next
bat.AppendLine($"""{Settings.FfmpegFile}"" -i {cFile.File} -c copy ""{File}""")
Dim batFile As SFile = bat.SaveAs($"{tmpCache.RootDirectory.PathWithSeparator}command.bat")
b.Execute($"""{batFile}""")
If Not File.Exists Then File = Nothing
End Using
End Using
End If
End With
End If
End If
Catch oex As OperationCanceledException
Throw oex
Catch dex As ObjectDisposedException
Throw dex
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex,
$"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
End Try
End Sub
Private Async Sub Batch_OutputDataReceived(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() ProgressPerform())
End Sub
Private Sub MergeFiles()
Try
Dim p As SFileNumbers = SFileNumbers.Default(DestinationFile.Name)
Dim f As SFile = SFile.IndexReindex(DestinationFile,,, p, EDP.ReturnValue).IfNullOrEmpty(DestinationFile)
If Not FileVideo.IsEmptyString And Not FileAudio.IsEmptyString Then
DestinationFile = FFMPEG.MergeFiles({FileVideo, FileAudio}, Settings.FfmpegFile, f, Settings.CMDEncoding, p, EDP.ThrowException)
Else
If Not SFile.Move(FileVideo, f) Then DestinationFile = FileVideo
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex, $"[M3U8.MergeFiles]")
End Try
End Sub
#End Region
#Region "Progress support"
Private Sub ProgressChangeMax(ByVal Count As Integer)
If ProgressExists Then
If UsePreProgress Then
ProgressPre.ChangeMax(Count)
Else
Progress.Maximum += Count
End If
End If
End Sub
Private Sub ProgressPerform()
If ProgressExists Then
If UsePreProgress Then
ProgressPre.Perform()
Else
Progress.Perform()
End If
End If
End Sub
#End Region
#Region "Static Download"
Friend Shared Function Download(ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Resp As Responser, ByVal Thrower As Plugin.IThrower,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Using m As New M3U8(Media, DestinationFile, Resp, Thrower, Progress, UsePreProgress)
m.Download()
If m.DestinationFile.Exists Then Return m.DestinationFile Else Return Nothing
End Using
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Private Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
DataVideo.Clear()
DataAudio.Clear()
ProgressPre.DisposeIfReady
Cache.Dispose()
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

89
SCrawler/API/JustForFans/SiteSettings.vb Normal file
View File

@@ -0,0 +1,89 @@
' 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.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.JustForFans
<Manifest("AndyProgram_JustForFans"), SavedPosts, SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.JFFIcon_64
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.JFFPic_76
End Get
End Property
Friend Const UserHash4_CookieName As String = "userhash4"
<PropertyOption(ControlText:="User ID", AllowNull:=False), PXML>
Friend ReadOnly Property UserID As PropertyValue
<PropertyOption, PXML>
Friend ReadOnly Property UserHash4 As PropertyValue
<PropertyOption(ControlText:="Accept", ControlToolTip:="Header 'Accept'"), PXML>
Friend ReadOnly Property HeaderAccept As PropertyValue
<PropertyOption, PXML>
Friend ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal HeaderName As String, ByVal HeaderValue As String)
Select Case HeaderName
Case NameOf(HeaderAccept) : If HeaderValue.IsEmptyString Then Responser.Accept = Nothing Else Responser.Accept = HeaderValue
Case NameOf(UserAgent) : If Not HeaderValue.IsEmptyString Then Responser.UserAgent = HeaderValue
End Select
End Sub
Friend Sub New()
MyBase.New("JustForFans", "justfor.fans")
With Responser
.CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End With
UserID = New PropertyValue(String.Empty, GetType(String))
UserHash4 = New PropertyValue(String.Empty, GetType(String))
HeaderAccept = New PropertyValue(Responser.Accept.Value, GetType(String), Sub(v) UpdateHeader(NameOf(HeaderAccept), v))
UserAgent = New PropertyValue(Responser.UserAgent, GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
_AllowUserAgentUpdate = False
UserRegex = RParams.DMS("https://justfor.fans/([^/\?]+)", 1, EDP.ReturnValue)
UrlPatternUser = "https://justfor.fans/{0}"
ImageVideoContains = "justfor.fans"
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then UpdateUserHash4()
MyBase.Update()
End Sub
Private Sub UpdateUserHash4()
If Responser.CookiesExists Then
Dim hv_current$ = UserHash4.Value
Dim hv_cookie$ = If(Responser.Cookies.FirstOrDefault(Function(cc) cc.Name.ToLower = UserHash4_CookieName)?.Value, String.Empty)
If Not hv_cookie.IsEmptyString And Not hv_cookie = hv_current And Responser.Cookies.Changed Then UserHash4.Value = hv_cookie
End If
End Sub
Friend Sub UpdateResponser(ByVal Source As Responser)
If Source.Cookies.Changed Then
Responser.Cookies.Update(Source.Cookies)
UpdateUserHash4()
If Responser.Cookies.Changed Then Responser.SaveCookies() : Responser.Cookies.Changed = False
End If
End Sub
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value)
End Function
End Class
End Namespace

344
SCrawler/API/JustForFans/UserData.vb Normal file
View File

@@ -0,0 +1,344 @@
' 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.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.JustForFans
Friend Class UserData : Inherits UserDataBase
#Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private ResponserNoHandlers As Responser = Nothing
#End Region
#Region "Structures"
Private Class FileSerial
Private InitNumber As Integer
Private ReadOnly Provider As New ANumbers With {.FormatOptions = ANumbers.Options.FormatNumberGroup, .GroupSize = 9}
Friend Sub New(ByVal Root As String)
Try
Dim r$ = Root.CSFilePS
InitNumber = SFile.GetFiles(r,,, EDP.ReturnValue).Count +
SFile.GetFiles($"{r}Video\",,, EDP.ReturnValue).Count +
SFile.GetFiles($"{r}Videos\",,, EDP.ReturnValue).Count
Catch
InitNumber = 0
End Try
End Sub
Friend Function ApplyHash(ByVal f As SFile) As SFile
InitNumber += 1
f.Name &= $"_{InitNumber.NumToString(Provider)}_{$"{Now:O}_{Rnd()}".GetHashCode()}"
Return f
End Function
End Class
Private Structure PhotoData : Implements IRegExCreator
Friend IsLarge As Boolean
Friend URL As String
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists Then
IsLarge = Not ParamsArray(0).IsEmptyString AndAlso ParamsArray(0).StringToLower = NamePhotoLarge
URL = ParamsArray(1)
End If
Return Me
End Function
End Structure
Private Structure PostBlock : Implements IRegExCreator
Friend PostID As String
Friend PostDate As Date?
Friend PostUrl As String
Friend Pinned As Boolean
Private Data As String
Private File As SFile
Private FileNameDefault As String
Friend Type As UTypes
Friend Values As IEnumerable(Of String)
Friend ReadOnly Property Valid As Boolean
Get
Return Values.ListExists And Not Type = UTypes.Undefined And Not PostID.IsEmptyString And Not PostUrl.IsEmptyString
End Get
End Property
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(3) Then
Data = ParamsArray(0)
Pinned = Not ParamsArray(1).IsEmptyString AndAlso ParamsArray(1).ToLower.Contains("pinned")
PostDate = AConvert(Of Date)(RegexReplace(Data, Regex_PostDate), DateProvider, Nothing)
PostUrl = RegexReplace(Data, Regex_PostURL)
If Not PostUrl.IsEmptyString Then PostUrl = $"https://justfor.fans/{PostUrl.Trim.StringTrimStart("/")}"
PostID = RegexReplace(PostUrl, Regex_PostID)
If Not Data.IsEmptyString Then
FileNameDefault = AConvert(Of String)(If(PostDate, Now), DateProviderVideoFileName, String.Empty)
Dim found As Boolean = False
Dim tmpData$ = RegexReplace(Data, Regex_Video)
If Not tmpData.IsEmptyString Then
found = True
File.Name = FileNameDefault
File.Extension = "mp4"
Using j As EContainer = JsonDocument.Parse(tmpData, EDP.ReturnValue)
If j.ListExists Then
Dim vr As RParams = RParams.DM("(\d+)", 0, EDP.ReturnValue)
Dim l As New List(Of Sizes)
Dim s As Sizes
Dim all$ = String.Empty
Dim t As UTypes = UTypes.m3u8
For Each jj As EContainer In j
If jj.Name.StringToLower = "all" Then
all = jj.Value
Else
s = New Sizes(RegexReplace(jj.Name, vr), jj.Value)
If Not s.HasError Then l.Add(s)
End If
Next
If l.Count = 0 Then l.Add(New Sizes(0, all)) : t = M3U8.AllVid
If l.Count > 0 Then
l.Sort()
Values = {l(0).Data}
Type = t
If Not Values(0).Contains("m3u8") Then Type = UTypes.Video
End If
End If
End Using
End If
If Not found AndAlso Not CStr(RegexReplace(Data, Regex_Gallery)).IsEmptyString Then
found = True
File = Nothing
Dim pData As List(Of PhotoData) = RegexFields(Of PhotoData)(Data, {Regex_Photo}, {1, 3}, EDP.ReturnValue)
If pData.ListExists Then
Type = UTypes.Picture
If pData.Exists(Function(d) d.IsLarge) Then
Values = (From d As PhotoData In pData Where d.IsLarge Select d.URL).ToArray
Else
Values = pData.Select(Function(d) d.URL).Distinct
End If
End If
End If
If Not found Then
File = Nothing
Dim pp As RParams = Regex_Photo.Copy
pp.Match = Nothing
pp.MatchSub = 3
pp.WhatGet = RegexReturn.Value
Dim v$ = RegexReplace(Data, pp)
If Not v.IsEmptyString Then found = True : Type = UTypes.Picture : Values = {v}
End If
End If
End If
Return Me
End Function
Friend Function GetUserMedia(ByVal FS As FileSerial) As IEnumerable(Of UserMedia)
If Values.ListExists Then
Dim m As UserMedia
Dim f As SFile
Dim outList As New List(Of UserMedia)
For Each url$ In Values
m = New UserMedia(url, Type) With {.URL_BASE = PostUrl.IfNullOrEmpty(.URL_BASE), .Post = New UserPost(PostID, PostDate)}
f = New SFile With {.Name = FileNameDefault, .Extension = m.File.Extension}
If Not Type = UTypes.Picture And Not Type = UTypes.GIF Then f.Extension = "mp4"
f = FS.ApplyHash(f)
m.File = f
outList.Add(m)
Next
Return outList
Else
Return New UserMedia() {}
End If
End Function
End Structure
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
UseResponserClient = True
End Sub
#End Region
#Region "Download functions"
Private _DownloadedPostsCount As Integer = 0
Private _Limit As Integer = -1
Private FileSerialInstance As FileSerial
Private _UserHash4 As String = String.Empty
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
_UserHash4 = MySettings.UserHash4.Value
FileSerialInstance = New FileSerial(DownloadContentDefault_GetRootDir())
Responser.Cookies.Changed = False
If Not ResponserNoHandlers Is Nothing Then ResponserNoHandlers.Dispose() : ResponserNoHandlers = Nothing
ResponserNoHandlers = Responser.Copy
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
_DownloadedPostsCount = 0
_Limit = If(DownloadTopCount, -1)
DownloadData(0, Token)
Finally
If DownloadTopCount.HasValue Then DownloadTopCount = Nothing
Try : RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived : Catch : End Try
MySettings.UpdateResponser(Responser)
End Try
End Sub
Private Sub Responser_ResponseReceived(ByVal Source As Object, ByVal e As EventArguments.WebDataResponse)
If e.CookiesExists Then
Dim hv$ = If(e.Cookies.FirstOrDefault(Function(cc) cc.Name.StringToLower = SiteSettings.UserHash4_CookieName)?.Value, String.Empty)
If Not hv.IsEmptyString And Not _UserHash4 = hv Then _UserHash4 = hv
End If
End Sub
Private Overloads Sub DownloadData(ByVal Cursor As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim processed As Boolean = False
ThrowAny(Token)
If IsSavedPosts Then
URL = $"https://justfor.fans/home?Tab=Saved&Page={Cursor + 1}"
Else
If ID.IsEmptyString Then GetUserID() : ThrowAny(Token)
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "The user ID cannot be null")
If _UserHash4.IsEmptyString Then Throw New ArgumentNullException("UserHash4", "[UserHash4] cannot be null")
URL = $"https://justfor.fans/ajax/getPosts.php?Type=One&UserID={MySettings.UserID.Value}&PosterID={ID}&StartAt={Cursor}&Page=Profile&UserHash4={_UserHash4}&SplitTest=0"
End If
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim data As List(Of PostBlock) = RegexFields(Of PostBlock)(r, {RegexVideoBlock}, {0, 2, 3}, EDP.ReturnValue)
If data.ListExists Then
For Each post As PostBlock In data
If post.Valid Then
processed = True
If Not post.PostID.IsEmptyString Then
If _TempPostsList.Contains(post.PostID) Then
If post.Pinned Then Continue For Else Exit Sub
Else
_TempPostsList.Add(post.PostID)
End If
End If
Select Case CheckDatesLimit(post.PostDate, Nothing)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
_DownloadedPostsCount += 1
_TempMediaList.ListAddList(post.GetUserMedia(FileSerialInstance), LNC)
End If
Next
End If
End If
If processed And (_Limit = -1 Or _DownloadedPostsCount < _Limit) Then DownloadData(Cursor + IIf(IsSavedPosts, 1, 10), Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Sub GetUserID()
Try
Dim r$, hash$, new_id$
If ID.IsEmptyString Then
r = Responser.GetResponse($"https://justfor.fans/{Name}")
If Not r.IsEmptyString Then
hash = RegexReplace(r, RegexUser)
If Not hash.IsEmptyString Then
r = Responser.GetResponse($"https://justfor.fans/ajax/getAssetCount.php?User={Name}&Ver={hash}")
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
new_id = j.Value("UserID")
If Not new_id.IsEmptyString Then
new_id = RegexReplace(new_id, RParams.DM("\D", 0, RegexReturn.Replace, CType(Function(input$) String.Empty, Func(Of String, String))))
If Not new_id.IsEmptyString Then ID = new_id : _ForceSaveUserInfo = True
End If
End If
End Using
End If
End If
End If
End If
Catch ex As Exception
LogError(ex, "can't get user ID")
End Try
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If ContentMissingExists Then
Dim r$
Dim m As UserMedia
Dim p As PostBlock
Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UserMedia.States.Missing And Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse(m.URL_BASE,, rErr)
If Not r.IsEmptyString Then
With RegexFields(Of PostBlock)(r, {RegexVideoBlock}, {0, 2, 3}, rErr)
If .ListExists Then
rList.Add(i)
For Each p In .Self
If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance), LNC)
Next
End If
End With
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(Media, DestinationFile, ResponserNoHandlers, Me, Progress, Not IsSingleObjectDownload)
End Function
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
ResponserNoHandlers = Responser.Copy
_ContentList.Add(New UserMedia(Data.URL) With {.State = UserMedia.States.Missing})
ReparseMissing(Token)
End Sub
#End Region
#Region "DownloadingException"
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
Return 0
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then FileSerialInstance = Nothing
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 17 KiB

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

4
SCrawler/Download/Automation/AutoDownloader.vb
View File

@@ -541,9 +541,9 @@ Namespace DownloadObjects
Using g As New GroupParameters
g.LabelsExcluded.ListAddList(LabelsExcluded)
g.SitesExcluded.ListAddList(SitesExcluded)
users.ListAddList(DownloadGroup.GetUsers(g, True))
users.ListAddList(DownloadGroup.GetUsers(g))
End Using
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me, True))
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me))
Case Modes.Groups
If Groups.Count > 0 And Settings.Groups.Count > 0 Then
For Each GName In Groups

154
SCrawler/Download/Automation/AutoDownloaderEditorForm.Designer.vb generated
View File

@@ -24,28 +24,28 @@ Namespace DownloadObjects
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MODE 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(AutoDownloaderEditorForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_MODE As System.Windows.Forms.TableLayoutPanel
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
Me.TXT_GROUPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.OPT_ALL = New System.Windows.Forms.RadioButton()
Me.OPT_DEFAULT = New System.Windows.Forms.RadioButton()
Me.OPT_SPEC = New System.Windows.Forms.RadioButton()
Me.OPT_DISABLED = New System.Windows.Forms.RadioButton()
Me.OPT_GROUP = New System.Windows.Forms.RadioButton()
Me.TXT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.LBL_LAST_TIME_UP = New System.Windows.Forms.Label()
Me.NUM_DELAY = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_GROUPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_NOTIFY = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC_USER = New System.Windows.Forms.CheckBox()
Me.CH_NOTIFY_SIMPLE = New System.Windows.Forms.CheckBox()
Me.TXT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.NUM_DELAY = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.LBL_LAST_TIME_UP = New System.Windows.Forms.Label()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MODE = New System.Windows.Forms.TableLayoutPanel()
TP_NOTIFY = New System.Windows.Forms.TableLayoutPanel()
@@ -53,11 +53,11 @@ Namespace DownloadObjects
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
Me.DEF_GROUP.SuspendLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_MODE.SuspendLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
@@ -66,7 +66,7 @@ Namespace DownloadObjects
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 363)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 388)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -106,26 +106,9 @@ Namespace DownloadObjects
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 363)
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 388)
Me.DEF_GROUP.TabIndex = 0
'
'TXT_GROUPS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 195)
Me.TXT_GROUPS.Name = "TXT_GROUPS"
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
Me.TXT_GROUPS.TabIndex = 1
Me.TXT_GROUPS.TextBoxReadOnly = True
'
'TP_MODE
'
TP_MODE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
@@ -214,52 +197,23 @@ Namespace DownloadObjects
TT_MAIN.SetToolTip(Me.OPT_GROUP, "Download groups")
Me.OPT_GROUP.UseVisualStyleBackColor = True
'
'TXT_TIMER
'TXT_GROUPS
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3)
Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
Me.TXT_TIMER.CaptionWidth = 50.0R
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 282)
Me.TXT_TIMER.Name = "TXT_TIMER"
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22)
Me.TXT_TIMER.TabIndex = 3
'
'LBL_LAST_TIME_UP
'
Me.LBL_LAST_TIME_UP.AutoSize = True
Me.LBL_LAST_TIME_UP.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_LAST_TIME_UP.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Italic, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 337)
Me.LBL_LAST_TIME_UP.Name = "LBL_LAST_TIME_UP"
Me.LBL_LAST_TIME_UP.Size = New System.Drawing.Size(468, 25)
Me.LBL_LAST_TIME_UP.TabIndex = 5
Me.LBL_LAST_TIME_UP.Text = "Last download date: "
Me.LBL_LAST_TIME_UP.TextAlign = System.Drawing.ContentAlignment.TopCenter
'
'NUM_DELAY
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4)
Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay"
Me.NUM_DELAY.CaptionWidth = 50.0R
Me.NUM_DELAY.ClearTextByButtonClear = False
Me.NUM_DELAY.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.NUM_DELAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 311)
Me.NUM_DELAY.Name = "NUM_DELAY"
Me.NUM_DELAY.NumberMaximum = New Decimal(New Integer() {1440, 0, 0, 0})
Me.NUM_DELAY.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
Me.NUM_DELAY.Size = New System.Drawing.Size(468, 22)
Me.NUM_DELAY.TabIndex = 4
Me.NUM_DELAY.Text = "0"
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GROUPS.Lines = New String(-1) {}
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 224)
Me.TXT_GROUPS.Name = "TXT_GROUPS"
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
Me.TXT_GROUPS.TabIndex = 1
Me.TXT_GROUPS.TextBoxReadOnly = True
'
'TP_NOTIFY
'
@@ -329,6 +283,55 @@ Namespace DownloadObjects
TT_MAIN.SetToolTip(Me.CH_NOTIFY_SIMPLE, resources.GetString("CH_NOTIFY_SIMPLE.ToolTip"))
Me.CH_NOTIFY_SIMPLE.UseVisualStyleBackColor = True
'
'TXT_TIMER
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3)
Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
Me.TXT_TIMER.CaptionWidth = 50.0R
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TIMER.Lines = New String(-1) {}
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 282)
Me.TXT_TIMER.Name = "TXT_TIMER"
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22)
Me.TXT_TIMER.TabIndex = 3
'
'NUM_DELAY
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4)
Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay"
Me.NUM_DELAY.CaptionWidth = 50.0R
Me.NUM_DELAY.ClearTextByButtonClear = False
Me.NUM_DELAY.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.NUM_DELAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.NUM_DELAY.Lines = New String(-1) {}
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 311)
Me.NUM_DELAY.Name = "NUM_DELAY"
Me.NUM_DELAY.NumberMaximum = New Decimal(New Integer() {1440, 0, 0, 0})
Me.NUM_DELAY.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
Me.NUM_DELAY.Size = New System.Drawing.Size(468, 22)
Me.NUM_DELAY.TabIndex = 4
Me.NUM_DELAY.Text = "0"
'
'LBL_LAST_TIME_UP
'
Me.LBL_LAST_TIME_UP.AutoSize = True
Me.LBL_LAST_TIME_UP.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_LAST_TIME_UP.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Italic, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 337)
Me.LBL_LAST_TIME_UP.Name = "LBL_LAST_TIME_UP"
Me.LBL_LAST_TIME_UP.Size = New System.Drawing.Size(468, 25)
Me.LBL_LAST_TIME_UP.TabIndex = 5
Me.LBL_LAST_TIME_UP.Text = "Last download date: "
Me.LBL_LAST_TIME_UP.TextAlign = System.Drawing.ContentAlignment.TopCenter
'
'AutoDownloaderEditorForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -343,6 +346,7 @@ Namespace DownloadObjects
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(492, 427)
Me.Name = "AutoDownloaderEditorForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "AutoDownloader settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
@@ -350,13 +354,13 @@ Namespace DownloadObjects
CONTAINER_MAIN.PerformLayout()
Me.DEF_GROUP.ResumeLayout(False)
Me.DEF_GROUP.PerformLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).EndInit()
TP_MODE.ResumeLayout(False)
TP_MODE.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).EndInit()
TP_NOTIFY.ResumeLayout(False)
TP_NOTIFY.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub

30
SCrawler/Download/Automation/AutoDownloaderEditorForm.resx
View File

@@ -120,6 +120,15 @@
<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_MODE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</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>
@@ -187,15 +196,14 @@
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TP_MODE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<metadata name="TP_NOTIFY.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="CH_NOTIFY_SIMPLE.ToolTip" xml:space="preserve">
<value>Show a simple notification instead of a user notification.
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
@@ -228,12 +236,4 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<metadata name="TP_NOTIFY.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="CH_NOTIFY_SIMPLE.ToolTip" xml:space="preserve">
<value>Show a simple notification instead of a user notification.
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value>
</data>
</root>

1
SCrawler/Download/Automation/SchedulerEditorForm.Designer.vb generated
View File

@@ -64,6 +64,7 @@ Namespace DownloadObjects
Me.MinimumSize = New System.Drawing.Size(430, 380)
Me.Name = "SchedulerEditorForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.Text = "Scheduler"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)

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

@@ -279,9 +279,9 @@ Namespace DownloadObjects
If Not Media.User Is Nothing AndAlso Not Media.User.HOST Is Nothing Then
With Media.User.HOST.Source
If Not .Image Is Nothing Then
ICON_SITE.Image = .Image
ICON_SITE.Image = .Image.Clone
ElseIf Not .Icon Is Nothing Then
ICON_SITE.Image = .Icon.ToBitmap
ICON_SITE.Image = .Icon.Clone.ToBitmap
End If
End With
End If

51
SCrawler/Download/Groups/DownloadGroup.vb
View File

@@ -25,6 +25,7 @@ Namespace DownloadObjects.Groups
Private ReadOnly SEP_1 As ToolStripSeparator
Private WithEvents BTT_MENU As ToolStripMenuItem
#End Region
Private File As SFile = Nothing
Friend Property NameBefore As String = String.Empty
Private _Key As String = String.Empty
Friend ReadOnly Property Key As String
@@ -111,7 +112,7 @@ Namespace DownloadObjects.Groups
#End Region
#Region "Buttons"
Private Sub BTT_MENU_Click(sender As Object, e As EventArgs) Handles BTT_MENU.Click
DownloadUsers(True)
DownloadUsers()
End Sub
Private Sub BTT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_EDIT.Click
Using f As New GroupEditorForm(Me)
@@ -126,24 +127,39 @@ Namespace DownloadObjects.Groups
End If
End Sub
Private Sub BTT_DOWNLOAD_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD.Click
DownloadUsers(True)
DownloadUsers()
End Sub
Private Sub BTT_DOWNLOAD_FULL_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD_FULL.Click
DownloadUsers(False)
DownloadUsers(, False)
End Sub
#End Region
#Region "Get users"
Friend Overloads Function GetUsers() As IEnumerable(Of IUserData)
Return GetUsers(Me, True)
Return GetUsers(Me)
End Function
Friend Overloads Shared Function GetUsers(ByVal Instance As IGroup, ByVal UseReadyOption As Boolean) As IEnumerable(Of IUserData)
Friend Overloads Shared Function GetUsers(ByVal Instance As IGroup, Optional ByVal UseReadyOption As Boolean = True,
Optional ByVal IncludeNonExistentUsers As Boolean = False,
Optional ByVal OnlyNonExistentUsers As Boolean = False) As IEnumerable(Of IUserData)
Try
If Settings.Users.Count > 0 Then
With Instance
Dim CheckUserExists As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
If user.Exists Then
If IncludeNonExistentUsers And OnlyNonExistentUsers Then
Return False
Else
Return True
End If
ElseIf IncludeNonExistentUsers Then
Return True
Else
Return False
End If
End Function
Dim CheckParams As Predicate(Of IUserData) = Function(user) _
(.Temporary = CheckState.Indeterminate Or user.Temporary = CBool(.Temporary)) And
(.Favorite = CheckState.Indeterminate Or (user.Favorite = CBool(.Favorite))) And
(Not UseReadyOption Or .ReadyForDownloadIgnore Or user.ReadyForDownload = .ReadyForDownload) And user.Exists
(Not UseReadyOption Or .ReadyForDownloadIgnore Or user.ReadyForDownload = .ReadyForDownload) And CheckUserExists.Invoke(user)
Dim CheckSubscription As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
If .Subscriptions Then
If .SubscriptionsOnly Then
@@ -196,12 +212,14 @@ Namespace DownloadObjects.Groups
End Function
#End Region
#Region "Download users"
Friend Sub DownloadUsers(ByVal UseReadyOption As Boolean)
Friend Sub DownloadUsers(Optional ByVal IncludeInTheFeed As Boolean = True, Optional ByVal UseReadyOption As Boolean = True,
Optional ByVal IncludeNonExistentUsers As Boolean = False,
Optional ByVal OnlyNonExistentUsers As Boolean = False)
Try
If Settings.Users.Count > 0 Then
Dim u As IEnumerable(Of IUserData) = GetUsers(Me, UseReadyOption)
Dim u As IEnumerable(Of IUserData) = GetUsers(Me, UseReadyOption, IncludeNonExistentUsers, OnlyNonExistentUsers)
If u.ListExists Then
Downloader.AddRange(u, True)
Downloader.AddRange(u, IncludeInTheFeed)
Else
MsgBoxE({$"No users found for group [{Name}].", "No users found"}, vbExclamation)
End If
@@ -211,6 +229,21 @@ Namespace DownloadObjects.Groups
End Try
End Sub
#End Region
#Region "Advanced filter support"
Friend Sub LoadFromFile(ByVal f As SFile)
File = f
If f.Exists Then
Using x As New XmlFile(f) With {.XmlReadOnly = True} : Import(x) : End Using
End If
End Sub
Friend Sub UpdateFile()
Using x As New XmlFile
Export(x)
x.Name = "AdvancedFilter"
x.Save(File)
End Using
End Sub
#End Region
#Region "IEContainerProvider Support"
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return Export(New EContainer("Group"))

2
SCrawler/Download/Groups/DownloadGroupCollection.vb
View File

@@ -83,7 +83,7 @@ Namespace DownloadObjects.Groups
End Using
End Sub
Friend Function DownloadGroupIfExists(ByVal Index As Integer) As Boolean
If Index.ValueBetween(0, Count - 1) Then Item(Index).DownloadUsers(True) : Return True Else Return False
If Index.ValueBetween(0, Count - 1) Then Item(Index).DownloadUsers() : Return True Else Return False
End Function
Friend Function IndexOf(ByVal Name As String) As Integer
If Count > 0 Then

4
SCrawler/Download/Groups/GroupDefaults.vb
View File

@@ -156,6 +156,10 @@ Namespace DownloadObjects.Groups
Controls.Add(TXT_LABELS, 0, 6)
Controls.Add(TXT_SITES, 0, 7)
End Sub
Friend Sub HideName()
Controls.Remove(TXT_NAME)
RowStyles(1).Height = 0
End Sub
Private Sub NUM_USERS_COUNT_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles NUM_USERS_COUNT.ActionOnButtonClick
If Sender.DefaultButton = ADB.Clear Then NUM_USERS_COUNT.Value = 0
End Sub

17
SCrawler/Download/Groups/GroupEditorForm.vb
View File

@@ -11,6 +11,8 @@ Namespace DownloadObjects.Groups
Friend Class GroupEditorForm
Private WithEvents MyDefs As DefaultFormOptions
Friend Property MyGroup As DownloadGroup
Friend Property DownloadMode As Boolean = False
Friend Property FilterMode As Boolean = False
Friend Sub New(ByRef g As DownloadGroup)
InitializeComponent()
MyGroup = g
@@ -50,12 +52,27 @@ Namespace DownloadObjects.Groups
DEFS_GROUP.Set(MyGroup)
Text &= $" { .Name}"
End With
ElseIf DownloadMode Then
Text = "Download options"
ElseIf FilterMode Then
Text = "Filter options"
Else
Text = "New Group"
End If
.MyFieldsChecker = New FieldsChecker
If DownloadMode Or FilterMode Then
DEFS_GROUP.HideName()
Dim s As Size = Size
s.Height -= 31
MaximumSize = Nothing
MinimumSize = Nothing
Size = s
MinimumSize = s
MaximumSize = s
Else
.MyFieldsCheckerE.AddControl(Of String)(DEFS_GROUP.TXT_NAME, DEFS_GROUP.TXT_NAME.CaptionText,,
New NameChecker(If(MyGroup?.Name, String.Empty), Settings.Groups, "Group"))
End If
.MyFieldsChecker.EndLoaderOperations()
.EndLoaderOperations()
End With

2
SCrawler/Download/UserDownloadQueueForm.vb
View File

@@ -154,7 +154,7 @@ Namespace DownloadObjects
If Not lu.User Is Nothing AndAlso
MsgBoxE({$"Are you sure you want to stop downloading the following user?{vbCr}{lu}", msgTitle}, vbExclamation + vbYesNo) = vbYes Then
Dim token As New CancellationTokenSource
lu.User.PersonalToken = token.Token
lu.User.TokenPersonal = token.Token
token.Cancel()
Tokens.Add(token)
MsgBoxE({"Cancel user download processed.", msgTitle})

1
SCrawler/Editors/GlobalLocationsChooserForm.Designer.vb generated
View File

@@ -203,6 +203,7 @@ Namespace Editors
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(600, 290)
Me.Name = "GlobalLocationsChooserForm"
Me.ShowInTaskbar = False
Me.Text = "Choose a new location"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)

1
SCrawler/Editors/LabelsForm.Designer.vb generated
View File

@@ -64,6 +64,7 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
Me.CMB_LABELS.Buttons.Add(ActionButton2)
Me.CMB_LABELS.Buttons.Add(ActionButton3)
Me.CMB_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_LABELS.Lines = New String(-1) {}
Me.CMB_LABELS.ListCheckBoxes = True
Me.CMB_LABELS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_LABELS.ListGridVisible = True

5
SCrawler/Editors/SiteSelectionForm.Designer.vb generated
View File

@@ -39,7 +39,7 @@ Namespace Editors
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.CMB_SITES)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(284, 251)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(284, 276)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -62,13 +62,14 @@ Namespace Editors
ListColumn1.Width = -1
Me.CMB_SITES.Columns.Add(ListColumn1)
Me.CMB_SITES.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_SITES.Lines = New String(-1) {}
Me.CMB_SITES.ListCheckBoxes = True
Me.CMB_SITES.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_SITES.ListGridVisible = True
Me.CMB_SITES.ListMultiSelect = True
Me.CMB_SITES.Location = New System.Drawing.Point(0, 0)
Me.CMB_SITES.Name = "CMB_SITES"
Me.CMB_SITES.Size = New System.Drawing.Size(286, 252)
Me.CMB_SITES.Size = New System.Drawing.Size(286, 277)
Me.CMB_SITES.TabIndex = 0
'
'SiteSelectionForm

8
SCrawler/Editors/UserCreatorForm.vb
View File

@@ -246,7 +246,7 @@ Namespace Editors
COLOR_USER.ColorsSetUser(.BackColor, .ForeColor)
TXT_DESCR.Text = .GetUserInformation.StringFormatLines
UpdateSpecificLabels(True)
TXT_LABELS.Buttons.Insert(0, New ActionButton(ADB.Refresh) With {.ToolTipText = "Show/hide site-specific labels"})
If .SpecialLabels.ListExists Then TXT_LABELS.Buttons.Insert(0, New ActionButton(ADB.Refresh) With {.ToolTipText = "Show/hide site-specific labels"})
End With
NameFieldProvider = New CollectionNameFieldProvider
@@ -601,16 +601,16 @@ CloseForm:
End Select
End Sub
Private Sub UpdateSpecificLabels(ByVal IsInit As Boolean)
UserLabels.ListAddList(UserInstance.Labels, LAP.NotContainsOnly)
If DirectCast(UserInstance, UserDataBase).SpecialLabels.ListExists Then
If Not IsInit Then LabelsIncludeSpecial = Not LabelsIncludeSpecial
UserLabelName.Clone()
UserLabels.ListAddList(UserInstance.Labels, LAP.NotContainsOnly)
If Not LabelsIncludeSpecial Then UserLabels.ListWithRemove(DirectCast(UserInstance, UserDataBase).SpecialLabels)
If UserLabels.Count > 0 Then UserLabels.Sort()
TXT_LABELS.Text = UserLabels.ListToString
Else
If Not IsInit Then MsgBoxE({"Users in this collection do not have site-specific labels", "Change labels view"}, vbExclamation)
End If
TXT_LABELS.Clear()
TXT_LABELS.Text = UserLabels.ListToString
End Sub
Private Sub TXT_SCRIPT_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_SCRIPT.ActionOnButtonClick
SettingsCLS.ScriptTextBoxButtonClick(TXT_SCRIPT, Sender)

29
SCrawler/ListImagesLoader.vb
View File

@@ -105,12 +105,17 @@ Friend Class ListImagesLoader
Dim v As View = Settings.ViewMode.Value
With MyList
MyList.BeginUpdate()
.BeginUpdate()
If Settings.FastProfilesLoading Then
Settings.Users.ListReindex
If Settings.ShowingMode.Value = ShowingModes.AdvancedFilter Then
UserDataList = GetAdvancedFilteredUsers(Of UserOption)()
Else
UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing
End If
If UserDataList.ListExists Then UserDataList.Sort()
If UserDataList.ListExists Then
@@ -127,7 +132,14 @@ Friend Class ListImagesLoader
End If
Else
Dim t As New List(Of Task)
For Each User As IUserData In Settings.Users
Dim advUsers As List(Of IUserData) = Nothing
Dim isAdv As Boolean = False
If Settings.ShowingMode.Value = ShowingModes.AdvancedFilter Then
isAdv = True
advUsers = GetAdvancedFilteredUsers(Of IUserData)()
If Not advUsers.ListExists Then UpdateInProgress = False : MyList.EndUpdate() : Exit Sub
End If
For Each User As IUserData In If(isAdv, advUsers, Settings.Users)
If User.FitToAddParams Then
If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True)))
@@ -139,8 +151,9 @@ Friend Class ListImagesLoader
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
UpdateInProgress = False
End If
.EndUpdate()
End With
MyList.EndUpdate()
Else
UpdateInProgress = False
End If
@@ -151,6 +164,16 @@ Friend Class ListImagesLoader
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[ListImagesLoader.Update]")
End Try
End Sub
Private Function GetAdvancedFilteredUsers(Of T)() As List(Of T)
With Settings.AdvancedFilter.GetUsers
If .ListExists Then
With ListAddList(Nothing, .Select(Function(u) Settings.GetUser(u, True)), LAP.NotContainsOnly, LAP.IgnoreICopier)
If .ListExists Then Return If(GetType(T) Is GetType(UserOption), .Select(Function(u) New UserOption(u, MyList)).ToList, .Self)
End With
End If
End With
Return Nothing
End Function
Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
Try
Dim a As Action

25
SCrawler/MainFrame.Designer.vb generated
View File

@@ -70,6 +70,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_DOWN_ALL_FULL_SUBSCR = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SITE_FULL = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SITE_FULL_SUBSCR = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SPEC = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_VIDEO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_ADD_NEW_GROUP = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SILENT_MODE = New System.Windows.Forms.ToolStripMenuItem()
@@ -96,6 +97,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_EXCLUDED_LABELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_SHOW_GROUPS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_FILTER_ADV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_NOT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
@@ -406,7 +408,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'MENU_DOWN_ALL
'
Me.MENU_DOWN_ALL.AutoToolTip = False
Me.MENU_DOWN_ALL.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DOWN_SELECTED, Me.MENU_D_DOWN_ALL, Me.MENU_D_DOWN_ALL_SITE, MENU_DOWN_ALL_SEP_1, Me.BTT_DOWN_VIDEO, MENU_DOWN_ALL_SEP_2, Me.BTT_ADD_NEW_GROUP, MENU_DOWN_ALL_SEP_3, Me.BTT_SILENT_MODE, MENU_DOWN_ALL_SEP_4, Me.BTT_DOWN_AUTOMATION, Me.BTT_DOWN_AUTOMATION_PAUSE})
Me.MENU_DOWN_ALL.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DOWN_SELECTED, Me.MENU_D_DOWN_ALL, Me.MENU_D_DOWN_ALL_SITE, Me.BTT_DOWN_SPEC, MENU_DOWN_ALL_SEP_1, Me.BTT_DOWN_VIDEO, MENU_DOWN_ALL_SEP_2, Me.BTT_ADD_NEW_GROUP, MENU_DOWN_ALL_SEP_3, Me.BTT_SILENT_MODE, MENU_DOWN_ALL_SEP_4, Me.BTT_DOWN_AUTOMATION, Me.BTT_DOWN_AUTOMATION_PAUSE})
Me.MENU_DOWN_ALL.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.MENU_DOWN_ALL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_DOWN_ALL.Name = "MENU_DOWN_ALL"
@@ -513,6 +515,17 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_DOWN_SITE_FULL_SUBSCR.Size = New System.Drawing.Size(274, 22)
Me.BTT_DOWN_SITE_FULL_SUBSCR.Text = "Download all site subscriptions [FULL]"
Me.BTT_DOWN_SITE_FULL_SUBSCR.ToolTipText = resources.GetString("BTT_DOWN_SITE_FULL_SUBSCR.ToolTipText")
'
'BTT_DOWN_SPEC
'
Me.BTT_DOWN_SPEC.AutoToolTip = True
Me.BTT_DOWN_SPEC.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN_SPEC.Name = "BTT_DOWN_SPEC"
Me.BTT_DOWN_SPEC.Size = New System.Drawing.Size(221, 22)
Me.BTT_DOWN_SPEC.Text = "Download (special)"
Me.BTT_DOWN_SPEC.ToolTipText = "Filter the users you want to download and download them." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Shift+Click to download" &
", including non-existent users." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+Shift+Click to download, excluding from th" &
"e feed, including non-existent users."
'
'BTT_DOWN_VIDEO
'
@@ -568,7 +581,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'MENU_VIEW
'
Me.MENU_VIEW.AutoToolTip = False
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_VIEW_LARGE, Me.BTT_VIEW_SMALL, Me.BTT_VIEW_LIST, Me.BTT_VIEW_DETAILS, MENU_VIEW_SEP_1, Me.BTT_MODE_SHOW_USERS, Me.BTT_MODE_SHOW_SUBSCRIPTIONS, MENU_VIEW_SEP_2, Me.BTT_SITE_ALL, Me.BTT_SITE_SPECIFIC, MENU_VIEW_SEP_3, Me.BTT_SHOW_ALL, Me.BTT_SHOW_REGULAR, Me.BTT_SHOW_TEMP, Me.BTT_SHOW_FAV, Me.BTT_SHOW_DELETED, Me.BTT_SHOW_SUSPENDED, Me.BTT_SHOW_LABELS, Me.BTT_SHOW_NO_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE, Me.BTT_SHOW_SHOW_GROUPS, MENU_VIEW_SEP_4, Me.BTT_SHOW_LIMIT_DATES_NOT, Me.BTT_SHOW_LIMIT_DATES_IN})
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_VIEW_LARGE, Me.BTT_VIEW_SMALL, Me.BTT_VIEW_LIST, Me.BTT_VIEW_DETAILS, MENU_VIEW_SEP_1, Me.BTT_MODE_SHOW_USERS, Me.BTT_MODE_SHOW_SUBSCRIPTIONS, MENU_VIEW_SEP_2, Me.BTT_SITE_ALL, Me.BTT_SITE_SPECIFIC, MENU_VIEW_SEP_3, Me.BTT_SHOW_ALL, Me.BTT_SHOW_REGULAR, Me.BTT_SHOW_TEMP, Me.BTT_SHOW_FAV, Me.BTT_SHOW_DELETED, Me.BTT_SHOW_SUSPENDED, Me.BTT_SHOW_LABELS, Me.BTT_SHOW_NO_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE, Me.BTT_SHOW_SHOW_GROUPS, Me.BTT_SHOW_FILTER_ADV, MENU_VIEW_SEP_4, Me.BTT_SHOW_LIMIT_DATES_NOT, Me.BTT_SHOW_LIMIT_DATES_IN})
Me.MENU_VIEW.Image = CType(resources.GetObject("MENU_VIEW.Image"), System.Drawing.Image)
Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_VIEW.Name = "MENU_VIEW"
@@ -695,6 +708,12 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_SHOW_GROUPS.Size = New System.Drawing.Size(231, 22)
Me.BTT_SHOW_SHOW_GROUPS.Text = "Show groups instead of labels"
'
'BTT_SHOW_FILTER_ADV
'
Me.BTT_SHOW_FILTER_ADV.Name = "BTT_SHOW_FILTER_ADV"
Me.BTT_SHOW_FILTER_ADV.Size = New System.Drawing.Size(231, 22)
Me.BTT_SHOW_FILTER_ADV.Text = "Advanced filter"
'
'BTT_SHOW_LIMIT_DATES_NOT
'
Me.BTT_SHOW_LIMIT_DATES_NOT.AutoToolTip = True
@@ -1158,4 +1177,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents BTT_DOWN_SITE_FULL_SUBSCR As ToolStripKeyMenuItem
Private WithEvents BTT_BUG_REPORT As ToolStripButton
Private WithEvents MENU_INFO_SHOW_QUEUE As ToolStripMenuItem
Private WithEvents BTT_DOWN_SPEC As ToolStripKeyMenuItem
Private WithEvents BTT_SHOW_FILTER_ADV As ToolStripMenuItem
End Class

37
SCrawler/MainFrame.vb
View File

@@ -483,19 +483,32 @@ CloseResume:
DownloadSiteFull(False, e.IncludeInTheFeed, True, e.Shift)
End Sub
#End Region
Private Sub BTT_DOWN_SPEC_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SPEC.KeyClick
Dim group As Groups.DownloadGroup = Nothing
Using f As New Groups.GroupEditorForm(Nothing) With {.DownloadMode = True}
f.ShowDialog()
If f.DialogResult = DialogResult.OK AndAlso Not f.MyGroup Is Nothing Then group = f.MyGroup
End Using
If Not group Is Nothing Then group.DownloadUsers(e.IncludeInTheFeed,, e.Shift) : group.Dispose()
End Sub
Private Sub DownloadSiteFull(ByVal ReadyForDownloadOnly As Boolean, ByVal IncludeInTheFeed As Boolean,
ByVal Subscription As Boolean, Optional ByVal IgnoreExists As Boolean = False)
Using f As New SiteSelectionForm(Settings.LatestDownloadedSites.ValuesList)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
If f.DialogResult = DialogResult.OK AndAlso f.SelectedSites.Count > 0 Then
Settings.LatestDownloadedSites.Clear()
Settings.LatestDownloadedSites.AddRange(f.SelectedSites)
Settings.LatestDownloadedSites.Update()
If f.SelectedSites.Count > 0 Then
Downloader.AddRange(Settings.GetUsers(Function(u) f.SelectedSites.Contains(u.Site) And (u.Exists Or IgnoreExists) And
u.IsSubscription = Subscription And
(Not ReadyForDownloadOnly Or u.ReadyForDownload)), IncludeInTheFeed)
Using g As New Groups.DownloadGroup
g.Sites.AddRange(f.SelectedSites)
g.ReadyForDownload = True
g.ReadyForDownloadIgnore = Not ReadyForDownloadOnly
If Subscription Then
g.Subscriptions = True
g.SubscriptionsOnly = True
End If
g.DownloadUsers(IncludeInTheFeed, ReadyForDownloadOnly, IgnoreExists)
End Using
End If
End Using
End Sub
@@ -679,6 +692,7 @@ CloseResume:
BTT_SHOW_LABELS.Checked = m = ShowingModes.Labels
BTT_SHOW_NO_LABELS.Checked = m = ShowingModes.NoLabels
BTT_SHOW_SHOW_GROUPS.Checked = Settings.ShowGroupsInsteadLabels
BTT_SHOW_FILTER_ADV.Checked = m = ShowingModes.AdvancedFilter
SetExcludedButtonChecker()
With Settings
If Not m = ShowingModes.Labels Then .Labels.Current.Clear() : .Labels.Current.Update()
@@ -705,6 +719,19 @@ CloseResume:
End If
End Using
End Function
Private Sub BTT_SHOW_FILTER_ADV_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_FILTER_ADV.Click
Try
Using g As New Groups.GroupEditorForm(Settings.AdvancedFilter) With {.FilterMode = True}
g.ShowDialog()
If g.DialogResult = DialogResult.OK Then
Settings.AdvancedFilter.UpdateFile()
SetShowButtonsCheckers(ShowingModes.AdvancedFilter, True)
End If
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Changing advanced filter options")
End Try
End Sub
#End Region
#Region "5 - view dates"
Private Sub BTT_SHOW_LIMIT_DATES_NOT_IN_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles BTT_SHOW_LIMIT_DATES_NOT.Click,

1
SCrawler/MainMod.vb
View File

@@ -53,6 +53,7 @@ Friend Module MainMod
NoLabels = 1000
Deleted = 10000
Suspended = 12000
AdvancedFilter = 100000
End Enum
Friend Enum ShowingDates As Integer
[Off] = 0

4
SCrawler/My Project/AssemblyInfo.vb
View File

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

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

@@ -89,7 +89,8 @@ Namespace Plugin.Hosts
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.PathPlugin.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.OnlyFans.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)}
New PluginHost(New API.OnlyFans.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.JustForFans.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)}
End Function
Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean),

10
SCrawler/SCrawler.vbproj
View File

@@ -176,6 +176,10 @@
<Compile Include="API\Base\Structures.vb" />
<Compile Include="API\Base\TokenBatch.vb" />
<Compile Include="API\Instagram\EditorExchangeOptions.vb" />
<Compile Include="API\JustForFans\Declarations.vb" />
<Compile Include="API\JustForFans\M3U8.vb" />
<Compile Include="API\JustForFans\SiteSettings.vb" />
<Compile Include="API\JustForFans\UserData.vb" />
<Compile Include="API\LPSG\Declarations.vb" />
<Compile Include="API\LPSG\SiteSettings.vb" />
<Compile Include="API\LPSG\UserData.vb" />
@@ -698,6 +702,12 @@
<ItemGroup>
<None Include="Content\Pictures\BrushToolPic_16.png" />
</ItemGroup>
<ItemGroup>
<None Include="Content\Pictures\SitePictures\JFFPic_76.png" />
</ItemGroup>
<ItemGroup>
<None Include="Content\Icons\SiteIcons\JFFIcon_64.ico" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
<Target Name="EnsureNuGetPackageBuildImports" BeforeTargets="PrepareForBuild">
<PropertyGroup>

4
SCrawler/SettingsCLS.vb
View File

@@ -125,6 +125,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend Property Channels As Reddit.ChannelsCollection
Friend ReadOnly Property Labels As LabelsKeeper
Friend ReadOnly Property Groups As Groups.DownloadGroupCollection
Friend ReadOnly Property AdvancedFilter As Groups.DownloadGroup
Friend ReadOnly Property LastCollections As List(Of String)
Friend ReadOnly Property DownloadLocations As STDownloader.DownloadLocationsCollection
Friend ReadOnly Property GlobalLocations As STDownloader.DownloadLocationsCollection
@@ -327,6 +328,9 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Labels = New LabelsKeeper(MyXML)
Groups = New Groups.DownloadGroupCollection
Labels.AddRange(Groups.GetGroupsLabels, False)
AdvancedFilter = New Groups.DownloadGroup
AdvancedFilter.LoadFromFile($"{SettingsFolderName}\AdvancedFilter.xml")
Labels.AddRange({AdvancedFilter}.GetGroupsLabels, False)
MyXML.EndUpdate()
If MyXML.ChangesDetected Then MyXML.Sort() : MyXML.UpdateData()

20
SCrawler/SiteResources.Designer.vb generated
View File

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

6
SCrawler/SiteResources.resx
View File

@@ -124,6 +124,12 @@
<data name="InstagramPic_76" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Pictures\SitePictures\InstagramPic_76.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="JFFIcon_64" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Icons\SiteIcons\JFFIcon_64.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="JFFPic_76" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Pictures\SitePictures\JFFPic_76.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="LPSGIcon_48" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Icons\SiteIcons\LPSGIcon_48.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>

3
SCrawler/UserSearchForm.vb
View File

@@ -63,6 +63,9 @@ Friend Class UserSearchForm
e.Cancel = True
Hide()
End Sub
Private Sub UserSearchForm_VisibleChanged(sender As Object, e As EventArgs) Handles Me.VisibleChanged
If Not _UFInit And Visible Then TXT_SEARCH.Select() : TXT_SEARCH.SelectAll()
End Sub
Private Sub UserSearchForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.Escape Then Hide() : e.Handled = True
End Sub