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

2023.5.12.0

Browse Source 
IPluginContentProvider: add 'ProgressPreChanged' and 'ProgressPreMaximumChanged' events
YT.MediaItem: change folder opening on double click
YT.VideoListForm: change the icon for the 'Download' button

Add advanced progress
Add user metrics calculation
UserDataBase: fix GIF hash bug
Instagram: heic to jpg
Mastodon.SiteSettings: add the main domain to the list of domains with saving the settings
Mastodon.UserData: handle 'Forbidden' error; fix bug in parsing non-user posts
Pinterest: remove cookies requirement for saved posts
PornHub: fix resolutions issue; add 'DownloadUHD' option
Reddit: fix missing images bug; fix broken images bug; update container parsing function
MainFrame: fix collection pointing bug
This commit is contained in:
Andy
2023-05-12 20:00:32 +03:00
parent b2a9b22478
commit e868c2e694
55 changed files with 1980 additions and 402 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -33,40 +33,55 @@ Namespace API.Base
End If
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) As SFile
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing,
Optional ByVal UsePreProgress As Boolean = True) As SFile
Dim Cache As CacheKeeper = Nothing
Try
If URLs.ListExists Then
Dim ConcatFile As SFile = DestinationFile
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
ConcatFile.Extension = "mp4"
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\")
Dim cache2 As CacheKeeper = Cache.NewInstance
If cache2.RootDirectory.Exists(SFO.Path) Then
Dim progressExists As Boolean = Not Progress Is Nothing
If progressExists Then Progress.Maximum += URLs.Count
Dim p As SFileNumbers = SFileNumbers.Default(ConcatFile.Name)
ConcatFile = SFile.IndexReindex(ConcatFile,,, p, EDP.ReturnValue)
Dim i%
Dim dFile As SFile = cache2.RootDirectory
dFile.Extension = "ts"
Using w As New DownloadObjects.WebClient2(Responser)
For i = 0 To URLs.Count - 1
If progressExists Then Progress.Perform()
Token.ThrowIfCancellationRequested()
dFile.Name = $"ConPart_{i}"
w.DownloadFile(URLs(i), dFile)
cache2.AddFile(dFile, True)
Next
End Using
DestinationFile = FFMPEG.ConcatenateFiles(cache2, Settings.FfmpegFile.File, ConcatFile, Settings.CMDEncoding, p, EDP.ThrowException)
Return DestinationFile
Using tmpPr As New PreProgress(Progress)
Try
If URLs.ListExists Then
Dim ConcatFile As SFile = DestinationFile
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
ConcatFile.Extension = "mp4"
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\")
Dim cache2 As CacheKeeper = Cache.NewInstance
If cache2.RootDirectory.Exists(SFO.Path) Then
Dim progressExists As Boolean = Not Progress Is Nothing
If progressExists Then
If UsePreProgress Then
tmpPr.ChangeMax(URLs.Count)
Else
Progress.Maximum += URLs.Count
End If
End If
Dim p As SFileNumbers = SFileNumbers.Default(ConcatFile.Name)
ConcatFile = SFile.IndexReindex(ConcatFile,,, p, EDP.ReturnValue)
Dim i%
Dim dFile As SFile = cache2.RootDirectory
dFile.Extension = "ts"
Using w As New DownloadObjects.WebClient2(Responser)
For i = 0 To URLs.Count - 1
If progressExists Then
If UsePreProgress Then
tmpPr.Perform()
Else
Progress.Perform()
End If
End If
Token.ThrowIfCancellationRequested()
dFile.Name = $"ConPart_{i}"
w.DownloadFile(URLs(i), dFile)
cache2.AddFile(dFile, True)
Next
End Using
DestinationFile = FFMPEG.ConcatenateFiles(cache2, Settings.FfmpegFile.File, ConcatFile, Settings.CMDEncoding, p, EDP.ThrowException)
Return DestinationFile
End If
End If
End If
Return Nothing
Finally
Cache.DisposeIfReady
End Try
Return Nothing
Finally
Cache.DisposeIfReady
End Try
End Using
End Function
End Class
End Namespace

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

@@ -146,7 +146,18 @@ Namespace API.Base
Return HOST.Name
End Get
End Property
Private _Progress As MyProgress
Friend Property Progress As MyProgress
Get
Return _Progress
End Get
Set(ByVal p As MyProgress)
_Progress = p
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
ProgressPre = New PreProgress(_Progress)
End Set
End Property
Protected Property ProgressPre As PreProgress = Nothing
#End Region
#Region "User name, ID, exist, suspend"
Friend User As UserInfo
@@ -566,6 +577,8 @@ BlockNullPicture:
#Region "Plugins Support"
Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged
Protected Event ProgressMaximumChanged As IPluginContentProvider.ProgressMaximumChangedEventHandler Implements IPluginContentProvider.ProgressMaximumChanged
Protected Event ProgressPreChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressPreChanged
Protected Event ProgressPreMaximumChanged As IPluginContentProvider.ProgressMaximumChangedEventHandler Implements IPluginContentProvider.ProgressPreMaximumChanged
Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings
Get
Return HOST.Source
@@ -911,6 +924,7 @@ BlockNullPicture:
Private _PictureExists As Boolean
Private _EnvirInvokeUserUpdated As Boolean = False
Protected Sub EnvirDownloadSet()
ProgressPre.Reset()
UpdateDataFiles()
_DownloadInProgress = True
_DescriptionChecked = False
@@ -962,10 +976,12 @@ BlockNullPicture:
If Not DownloadMissingOnly Then
ThrowAny(Token)
DownloadDataF(Token)
ProgressPre.Done()
ThrowAny(Token)
If Settings.ReparseMissingInTheRoutine Then ReparseMissing(Token) : ThrowAny(Token)
If Settings.ReparseMissingInTheRoutine Then ReparseMissing(Token) : ProgressPre.Done() : ThrowAny(Token)
Else
ReparseMissing(Token)
ProgressPre.Done()
End If
If _TempMediaList.Count > 0 Then
@@ -976,9 +992,10 @@ BlockNullPicture:
End If
ReparseVideo(Token)
ProgressPre.Done()
ThrowAny(Token)
If UseMD5Comparison Then ValidateMD5(Token) : ThrowAny(Token)
If UseMD5Comparison Then ValidateMD5(Token) : ProgressPre.Done() : ThrowAny(Token)
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then _
TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None)
@@ -1031,6 +1048,7 @@ BlockNullPicture:
DownloadMissingOnly = False
_ForceSaveUserData = False
_ForceSaveUserInfo = False
ProgressPre.Done()
End Try
End Sub
Protected Sub UpdateDataFiles()
@@ -1064,8 +1082,6 @@ BlockNullPicture:
If Not HOST Is Nothing AndAlso Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
SeparateVideoFolder = False
IsSingleObjectDownload = True
UseInternalDownloadFileFunction_UseProgress = True
UseInternalM3U8Function_UseProgress = True
DownloadSingleObject_GetPosts(Data, Token)
DownloadSingleObject_CreateMedia(Data, Token)
DownloadSingleObject_Download(Data, Token)
@@ -1157,15 +1173,17 @@ BlockNullPicture:
ImgFormat = GetImageFormat(__data.File)
End If
If ImgFormat Is Nothing Then ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL_BASE.IfNullOrEmpty(__data.URL), ErrMD5), ImgFormat, ErrMD5))
If IsUrl And Not __isGif Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
ElseIf IsUrl And __isGif Then
hash = ByteArrayToString(GetMD5FromBytes(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
If hash.IsEmptyString And Not __isGif Then
If ImgFormat Is Imaging.ImageFormat.Jpeg Then ImgFormat = Imaging.ImageFormat.Png Else ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL_BASE.IfNullOrEmpty(__data.URL), ErrMD5), ImgFormat, ErrMD5))
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
@@ -1186,7 +1204,9 @@ BlockNullPicture:
_ForceSaveUserInfo = True
If existingFiles.Count > 0 Then
Dim h$
ProgressPre.ChangeMax(existingFiles.Count)
For i = existingFiles.Count - 1 To 0 Step -1
ProgressPre.Perform()
h = __getMD5(New UserMedia With {.File = existingFiles(i)}, False)
If Not h.IsEmptyString Then
If hashList.ContainsKey(h) Then
@@ -1200,8 +1220,10 @@ BlockNullPicture:
Next
End If
End If
ProgressPre.ChangeMax(_ContentList.Count)
For i = 0 To _ContentList.Count - 1
data = _ContentList(i)
ProgressPre.Perform()
If (data.Type = UTypes.GIF Or data.Type = UTypes.Picture) Then
If data.MD5.IsEmptyString Then
ThrowAny(Token)
@@ -1215,8 +1237,10 @@ BlockNullPicture:
End If
Next
If existingFiles.Count > 0 Then
ProgressPre.ChangeMax(existingFiles.Count)
For i = 0 To existingFiles.Count - 1
f = existingFiles(i)
ProgressPre.Perform()
data = New UserMedia(f.File) With {
.State = UStates.Downloaded,
.Type = IIf(f.Extension = "gif", UTypes.GIF, UTypes.Picture),
@@ -1238,7 +1262,9 @@ BlockNullPicture:
End With
End If
ProgressPre.ChangeMax(_TempMediaList.Count)
For i = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If limit > 0 And itemsCount >= limit Then
_TempMediaList.RemoveAt(i)
Else
@@ -1262,6 +1288,8 @@ BlockNullPicture:
Catch iex As ArgumentOutOfRangeException When Disposed
Catch ex As Exception
ProcessException(ex, Token, "ValidateMD5",, VALIDATE_MD5_ERROR)
Finally
ProgressPre.Done()
End Try
End Sub
#End Region
@@ -1434,13 +1462,11 @@ BlockNullPicture:
End Try
End Sub
Protected UseInternalM3U8Function As Boolean = False
Protected UseInternalM3U8Function_UseProgress As Boolean = False
Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile
Return Nothing
End Function
Protected UseInternalDownloadFileFunction As Boolean = False
Protected UseInternalDownloadFileFunction_UseProgress As Boolean = False
Protected Overridable Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile
Return Nothing
@@ -1798,6 +1824,7 @@ BlockNullPicture:
LatestData.Clear()
_TempMediaList.Clear()
_TempPostsList.Clear()
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()
If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose()

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

@@ -207,19 +207,21 @@ Namespace API.Instagram
If dt.Invoke And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token)
ProgressPre.Done()
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If dt.Invoke And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token)
ProgressPre.Done()
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If FirstLoadingDone Then LastCursor = String.Empty
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException
@@ -229,9 +231,24 @@ Namespace API.Instagram
Finally
E560Thrown = False
UpdateResponser()
ValidateExtension()
If Not errorFound Then LoadSavePostsKV(False)
End Try
End Sub
Private Sub ValidateExtension()
Try
Const heic$ = "heic"
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then
Dim m As UserMedia
For i% = 0 To _TempMediaList.Count - 1
m = _TempMediaList(i)
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _
m.File.Extension = "jpg" : _TempMediaList(i) = m
Next
End If
Catch ex As Exception
End Try
End Sub
Private Sub UpdateResponser()
Try
If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
@@ -470,7 +487,9 @@ Namespace API.Instagram
HasNextPage = False
End If
If If(.Item("edges")?.Count, 0) > 0 Then
ProgressPre.ChangeMax(.Item("edges").Count)
For Each nn In .Item("edges")
ProgressPre.Perform()
PostIDKV = New PostKV(Section)
If nn.Count > 0 AndAlso nn(0).Count > 0 Then
With nn(0)
@@ -527,6 +546,7 @@ Namespace API.Instagram
Dim URL$ = String.Empty
Dim dValue% = 1
Dim _Index% = 0
If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
Try
Do While dValue = 1
ThrowAny(Token)
@@ -538,7 +558,9 @@ Namespace API.Instagram
Dim j As EContainer, jj As EContainer
If PostsToReparse.Count > 0 And _Index <= PostsToReparse.Count - 1 Then
Dim e As New ErrorsDescriber(EDP.ThrowException)
If Index > 0 Then ProgressPre.ChangeMax(1)
For i% = _Index To PostsToReparse.Count - 1
ProgressPre.Perform()
_Index = i
URL = $"https://www.instagram.com/api/v1/media/{PostsToReparse(i).ID}/info/"
ThrowAny(Token)
@@ -611,7 +633,9 @@ Namespace API.Instagram
Case Else : SpecFolder = String.Empty
End Select
End If
ProgressPre.ChangeMax(Items.Count)
For Each nn In Items
ProgressPre.Perform()
With nn
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
Pinned = .Contains("timeline_pinned_user_ids")
@@ -799,7 +823,9 @@ Namespace API.Instagram
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("reels") Then
ProgressPre.ChangeMax(j("reels").Count)
For Each jj In j("reels")
ProgressPre.Perform()
i += 1
sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols
storyID = jj.Value("id").Replace("highlight:", String.Empty)

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

@@ -73,7 +73,9 @@ Namespace API.LPSG
Dim r As Func(Of String, Integer, String)
Dim indx% = 0
Dim ude As New ErrorsDescriber(EDP.ReturnValue)
ProgressPre.ChangeMax(l.Count)
For Each url$ In l
ProgressPre.Perform()
If Not url.IsEmptyString Then u = SymbolsConverter.Decode(url, {Converters.HTML, Converters.ASCII}, ude) Else u = String.Empty
If Not u.IsEmptyString Then
exists = Not IsEmptyString(RegexReplace(u, FileExistsRegEx))

9
SCrawler/API/Mastodon/SiteSettings.vb
View File

@@ -124,6 +124,15 @@ Namespace API.Mastodon
If _SiteEditorFormOpened Then
Dim tf$ = GifsSpecialFolder.Value
If Not tf.IsEmptyString Then tf = tf.StringTrim("\") : GifsSpecialFolder.Value = tf
Dim md$ = AConvert(Of String)(MyDomain.Value, String.Empty)
If Not md.IsEmptyString AndAlso Not Domains.Domains.Contains(md) AndAlso Not Domains.DomainsTemp.Contains(md) Then
If Domains.Changed Then
Domains.DomainsTemp.Add(md)
Else
Domains.Domains.Add(md)
Domains.Save()
End If
End If
End If
MyBase.Update()
End Sub

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

@@ -120,7 +120,9 @@ Namespace API.Mastodon
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If If(j?.Count, 0) > 0 Then
ProgressPre.ChangeMax(j.Count)
For Each jj As EContainer In j
ProgressPre.Perform()
With jj
If Not IsSavedPosts And POST.IsEmptyString And Not .Item("account") Is Nothing Then
With .Item("account")
@@ -166,7 +168,7 @@ Namespace API.Mastodon
If If(.Item("media_attachments")?.Count, 0) > 0 Then
s = .Item("media_attachments")
Else
s = .Item({"reblog", "account"}, "media_attachments")
s = .Item({"reblog"}, "media_attachments")
End If
If s.ListExists Then
For Each ss In s : ObtainMedia(ss, PostID, PostDate) : Next
@@ -268,7 +270,7 @@ Namespace API.Mastodon
If Responser.Status = Net.WebExceptionStatus.NameResolutionFailure Then
MyMainLOG = $"User domain ({UserDomain}) not found: {ToStringForLog()}"
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Or Responser.StatusCode = Net.HttpStatusCode.Forbidden Then
UserExists = False
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.Unauthorized Then

3
SCrawler/API/Pinterest/SiteSettings.vb
View File

@@ -62,8 +62,7 @@ Namespace API.Pinterest
Return New UserData
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Settings.GalleryDLFile.Exists And (Not What = ISiteSettings.Download.SavedPosts OrElse
(Responser.CookiesExists And ACheck(SavedPostsUserName.Value)))
Return Settings.GalleryDLFile.Exists And (Not What = ISiteSettings.Download.SavedPosts OrElse ACheck(SavedPostsUserName.Value))
End Function
#End Region
#Region "IsMyUser, IsMyImageVideo, GetUserUrl, GetUserPostUrl"

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

@@ -113,6 +113,8 @@ Namespace API.Pinterest
End If
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
Finally
ProgressPre.Done()
End Try
End Sub
#End Region
@@ -129,7 +131,9 @@ Namespace API.Pinterest
Dim urls As List(Of String) = GetDataFromGalleryDL(URL, True)
If urls.ListExists Then urls.RemoveAll(Function(__url) Not __url.Contains("BoardsResource/get/"))
If urls.ListExists Then
ProgressPre.ChangeMax(urls.Count)
For Each URL In urls
ProgressPre.Perform()
ThrowAny(Token)
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
@@ -176,14 +180,18 @@ Namespace API.Pinterest
Dim l As List(Of String) = GetDataFromGalleryDL(Board.URL, False)
If l.ListExists Then l.RemoveAll(Function(ll) Not ll.Contains("BoardFeedResource/get/"))
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
For Each bUrl In l
ProgressPre.Perform()
ThrowAny(Token)
r = Responser.GetResponse(bUrl,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, jErr)
If Not j Is Nothing Then
If If(j(rootNode)?.Count, 0) > 0 Then
ProgressPre.ChangeMax(j(rootNode).Count)
For Each jj In j(rootNode)
ProgressPre.Perform()
With jj
If .Contains("images") Then
images = .Item("images").Select(imgSelector).ToList

7
SCrawler/API/PornHub/Declarations.vb
View File

@@ -13,9 +13,13 @@ Namespace API.PornHub
Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue)
#End Region
#Region "Declarations video"
Friend ReadOnly RegexVideo_FlashVarsBlock As RParams = RParams.DM("(?<=flashvars_\['[nN]ext[vV]ideo'\];[\r\n]*?)(.+?)(?=;flashvars_\d+?)", 0, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVarsBlocks As RParams = RParams.DM("(?<=(flashvars_\['[nN]ext[vV]ideo'\]|flashvars_\d+[^ ]+? = media_\d+?);[\r\n]*?)(.+?)(?=;flashvars_\d+?)",
0, RegexReturn.List, EDP.ReturnValue)
'TODELETE: PornHub old 'RegexVideo_FlashVarsBlock' declaration
'Friend ReadOnly RegexVideo_FlashVarsBlock As RParams = RParams.DM("(?<=flashvars_\['[nN]ext[vV]ideo'\];[\r\n]*?)(.+?)(?=;flashvars_\d+?)", 0, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_Compiler As RParams = RParams.DM("(?<=\*/)([\w\d\S]{10,})", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_UrlResolution As RParams = RParams.DMS("/(\d+)[^/]+\.mp4", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideo_Video_All As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""",
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Friend ReadOnly RegexVideo_Video_Wrong As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?(?=\<div class=""videoUploaderBlock)",
@@ -26,6 +30,7 @@ Namespace API.PornHub
Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue)
#End Region
#Region "Declarations M3U8"
Friend ReadOnly Regex_M3U8_FilesList As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]*?(.+?m3u8.*)", 0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly Regex_M3U8_FirstFileRegEx As RParams = RParams.DM(".+?m3u8.*", 0)
Friend ReadOnly Regex_M3U8_FileUrl As RParams = RParams.DMS("((https://([^/]+)/.+?)([^/]+?m3u8))(.*)", 2, EDP.ReturnValue)
#End Region

18
SCrawler/API/PornHub/M3U8.vb
View File

@@ -16,11 +16,19 @@ Namespace API.PornHub
Friend NotInheritable Class M3U8
Private Sub New()
End Sub
Private Shared Function GetUrlsList(ByVal URL As String, ByVal Responser As Responser) As List(Of String)
Private Shared Function GetUrlsList(ByVal URL As String, ByVal Responser As Responser, ByVal DownloadUHD As Boolean) As List(Of String)
Dim appender$ = RegexReplace(URL, Regex_M3U8_FileUrl)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim file$ = RegexReplace(r, Regex_M3U8_FirstFileRegEx)
Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_FilesList}, {1, 2}, EDP.ReturnValue)
Dim file$
If files.ListExists Then files.RemoveAll(Function(f) f.Value = 0 Or (Not DownloadUHD And f.Value > 1080))
If files.ListExists Then
files.Sort()
file = files(0).Data
Else
file = RegexReplace(r, Regex_M3U8_FirstFileRegEx)
End If
If Not file.IsEmptyString Then
Dim NewUrl$ = M3U8Base.CreateUrl(appender, file)
If Not NewUrl.IsEmptyString Then
@@ -37,9 +45,9 @@ Namespace API.PornHub
End If
Return Nothing
End Function
Friend Shared Function Download(ByVal URL As String, ByVal Responser As Responser, ByVal Destination As SFile,
ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile
Return M3U8Base.Download(GetUrlsList(URL, Responser), Destination, Responser, Token, Progress)
Friend Shared Function Download(ByVal URL As String, ByVal Responser As Responser, ByVal Destination As SFile, ByVal DownloadUHD As Boolean,
ByVal Token As CancellationToken, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Return M3U8Base.Download(GetUrlsList(URL, Responser, DownloadUHD), Destination, Responser, Token, Progress, UsePreProgress)
End Function
End Class
End Namespace

3
SCrawler/API/PornHub/SiteSettings.vb
View File

@@ -25,6 +25,8 @@ Namespace API.PornHub
Return My.Resources.SiteResources.PornHubPic_16
End Get
End Property
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
Friend Property DownloadUHD As PropertyValue
<PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML>
Friend ReadOnly Property DownloadGifs As PropertyValue
<PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML>
@@ -41,6 +43,7 @@ Namespace API.PornHub
MyBase.New("PornHub", "pornhub.com")
With Responser : .CurlSslNoRevoke = True : .CurlInsecure = True : End With
DownloadUHD = New PropertyValue(False)
DownloadGifsAsMp4 = New PropertyValue(True)
DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer))
DownloadPhotoOnlyFromModelHub = New PropertyValue(True)

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

@@ -23,6 +23,7 @@ Namespace API.PornHub
Private Const Name_NameTrue As String = "NameTrue"
Private Const Name_VideoPageModel As String = "VideoPageModel"
Private Const Name_PhotoPageModel As String = "PhotoPageModel"
Private Const Name_DownloadUHD As String = "DownloadUHD"
Private Const Name_DownloadGifs As String = "DownloadGifs"
Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub"
#End Region
@@ -112,6 +113,7 @@ Namespace API.PornHub
#Region "Advanced fields"
Friend Property VideoPageModel As VideoPageModels = VideoPageModels.Undefined
Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined
Friend Property DownloadUHD As Boolean = False
Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
#End Region
@@ -122,6 +124,7 @@ Namespace API.PornHub
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
DownloadUHD = .DownloadUHD
DownloadGifs = .DownloadGifs
DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub
End With
@@ -157,6 +160,7 @@ Namespace API.PornHub
NameTrue = .Value(Name_NameTrue)
VideoPageModel = .Value(Name_VideoPageModel).FromXML(Of Integer)(VideoPageModels.Undefined)
PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined)
DownloadUHD = .Value(Name_DownloadUHD).FromXML(Of Boolean)(False)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
SetNames.Invoke()
@@ -166,6 +170,7 @@ Namespace API.PornHub
.Add(Name_NameTrue, NameTrue)
.Add(Name_VideoPageModel, CInt(VideoPageModel))
.Add(Name_PhotoPageModel, CInt(PhotoPageModel))
.Add(Name_DownloadUHD, DownloadUHD.BoolToInteger)
.Add(Name_DownloadGifs, DownloadGifs.BoolToInteger)
.Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger)
End If
@@ -224,6 +229,7 @@ Namespace API.PornHub
Finally
Responser.Mode = Responser.Modes.Default
Responser.Method = "GET"
ProgressPre.Done()
End Try
End Sub
#End Region
@@ -246,6 +252,7 @@ Namespace API.PornHub
Const VideoUrlPattern$ = "https://www.pornhub.com/{0}/{1}{2}{3}"
Const HtmlPageNotFoundVideo$ = "<span>Error Page Not Found</span>"
Dim URL$ = String.Empty
ProgressPre.ChangeMax(1)
Try
Dim p$
If PersonType = PersonTypeUser Then
@@ -289,6 +296,8 @@ Namespace API.PornHub
End If
Catch ex As Exception
Return ProcessException(ex, Token, $"videos downloading error [{URL}]")
Finally
ProgressPre.Perform()
End Try
End Function
#End Region
@@ -306,11 +315,13 @@ Namespace API.PornHub
Dim l3 As List(Of String) = Nothing
If l.ListExists Then l2 = l.Select(Function(ll) $"gif/{ll.Arr(0).Replace("gif", String.Empty)}").ToList
If l2.ListExists Then
ProgressPre.ChangeMax(l2.Count)
For Each gif$ In l2
If Not _TempPostsList.Contains(gif) Then
_TempPostsList.Add(gif)
URL = $"https://www.pornhub.com/{gif}"
m = New UserMedia(URL, UTypes.Video) With {.Post = gif, .SpecialFolder = "GIFs\"}
ProgressPre.Perform()
ThrowAny(Token)
Try
r = Responser.GetResponse(URL)
@@ -385,8 +396,10 @@ Namespace API.PornHub
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2})
If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString)
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
Dim albumRegex As RParams = RParams.DMS("", 1, EDP.ReturnValue)
For Each block As PhotoBlock In l
ProgressPre.Perform()
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
albumRegex.Pattern = "<li id=""" & block.AlbumID & """ class=""modelBox"">[\r\n\s]*?<div class=""modelPhoto"">[\r\n\s]*?\<[^\>]*?alt=""([^""]*)"""
albumName = StringTrim(RegexReplace(r, albumRegex))
@@ -421,7 +434,9 @@ Namespace API.PornHub
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1})
If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString)
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
For Each block As PhotoBlock In l
ProgressPre.Perform()
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
albumName = block.Data
If albumName.IsEmptyString Then
@@ -449,7 +464,9 @@ Namespace API.PornHub
Dim l As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
If l.ListExists Then l.RemoveAll(Function(_url) _url.IsEmptyString)
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
For Each url$ In l
ProgressPre.Perform()
ThrowAny(Token)
Try
r = Responser.GetResponse(url)
@@ -492,7 +509,9 @@ Namespace API.PornHub
Dim lBefore% = l2.Count
If _TempPostsList.Count > 0 Then l2.RemoveAll(Function(media) _TempPostsList.Contains(media.Post.ID))
If l2.Count > 0 Then
ProgressPre.ChangeMax(l2.Count)
For i% = 0 To l2.Count - 1
ProgressPre.Perform()
m = l2(i)
ThrowAny(Token)
Try
@@ -537,7 +556,9 @@ Namespace API.PornHub
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia
Dim r$, NewUrl$, tmpName$
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i)
ThrowAny(Token)
@@ -588,7 +609,9 @@ Namespace API.PornHub
Dim m As UserMedia
Dim r$
Dim eCurl As New ErrorsDescriber(EDP.ReturnValue)
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
@@ -619,31 +642,91 @@ Namespace API.PornHub
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(URL, Responser, DestinationFile, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing))
Return M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload)
End Function
#End Region
#Region "CreateVideoURL"
'TODELETE: PornHub old 'CreateVideoURL' function
'Private Function CreateVideoURL(ByVal r As String) As String
' Try
' Dim OutStr$ = String.Empty
' If Not r.IsEmptyString Then
' Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock)
' If Not _VarBlock.IsEmptyString Then
' Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
' Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
' If vars.ListExists And compiler.ListExists Then
' Dim v$
' Dim i%
' For Each var$ In compiler
' i = vars.IndexOf(var)
' If i >= 0 Then
' v = vars(i).Value
' If Not v.IsEmptyString Then OutStr &= v
' End If
' Next
' End If
' End If
' End If
' Return OutStr
' Catch ex As Exception
' Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
' End Try
'End Function
Private Function CreateVideoURL(ByVal r As String) As String
Try
Dim OutStr$ = String.Empty
Dim OutList As New List(Of String)
Dim tmpUrl$
Dim i%
If Not r.IsEmptyString Then
Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock)
If Not _VarBlock.IsEmptyString Then
Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
If vars.ListExists And compiler.ListExists Then
Dim v$
Dim i%
For Each var$ In compiler
i = vars.IndexOf(var)
If i >= 0 Then
v = vars(i).Value
If Not v.IsEmptyString Then OutStr &= v
End If
Next
Dim _VarBlock$, var$, v$
Dim vars As List(Of FlashVar)
Dim compiler As List(Of String)
Dim _VarBlocks As List(Of String) = RegexReplace(r, RegexVideo_FlashVarsBlocks)
If _VarBlocks.ListExists Then
For Each _VarBlock In _VarBlocks
tmpUrl = String.Empty
vars = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
compiler = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
If vars.ListExists And compiler.ListExists Then
For Each var In compiler
i = vars.IndexOf(var)
If i >= 0 Then
v = vars(i).Value
If Not v.IsEmptyString Then tmpUrl &= v
End If
Next
vars.Clear()
compiler.Clear()
End If
If Not tmpUrl.IsEmptyString Then OutList.Add(tmpUrl)
Next
End If
End If
If outList.Count > 0 Then outList.RemoveAll(Function(u) u.IsEmptyString)
If outList.Count > 0 Then
i = OutList.FindIndex(Function(u) u.Contains("urlset"))
If i >= 0 Then
OutStr = OutList(i)
Else
Dim newUrls As New List(Of Sizes)
Dim tmpSize%?
For Each tmpUrl In OutList
tmpSize = AConvert(Of Integer)(RegexReplace(tmpUrl, RegexVideo_FlashVars_UrlResolution), AModes.Var, Nothing)
If tmpSize.HasValue Then newUrls.Add(New Sizes(tmpSize.Value, tmpUrl))
Next
If newUrls.Count > 0 Then
newUrls.Sort()
OutStr = newUrls(0).Data
newUrls.Clear()
Else
OutStr = OutList(0)
End If
End If
End If
OutList.Clear()
Return OutStr
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)

4
SCrawler/API/PornHub/UserExchangeOptions.vb
View File

@@ -9,18 +9,22 @@
Imports SCrawler.Plugin.Attributes
Namespace API.PornHub
Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.DownloadUHD), NameOf(MySettings))>
Friend Property DownloadUHD As Boolean
<PSetting(Caption:="Download gifs")>
Friend Property DownloadGifs As Boolean
<PSetting(NameOf(SiteSettings.DownloadPhotoOnlyFromModelHub), NameOf(MySettings), Caption:="Download photo only from ModelHub")>
Friend Property DownloadPhotoOnlyFromModelHub As Boolean
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
DownloadUHD = u.DownloadUHD
DownloadGifs = u.DownloadGifs
DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
MySettings = u.HOST.Source
End Sub
Friend Sub New(ByVal s As SiteSettings)
Dim v As CheckState = CInt(s.DownloadGifs.Value)
DownloadUHD = s.DownloadUHD.Value
DownloadGifs = Not v = CheckState.Unchecked
DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value
MySettings = s

28
SCrawler/API/Reddit/M3U8.vb
View File

@@ -59,8 +59,10 @@ Namespace API.Reddit
Private ReadOnly CacheFiles As CacheKeeper
Private ReadOnly Property Progress As MyProgress
Private ReadOnly ProgressExists As Boolean
Private ReadOnly Property ProgressPre As PreProgress
Private ReadOnly UsePreProgress As Boolean
#End Region
Private Sub New(ByVal URL As String, ByVal OutFile As SFile, ByVal Progress As MyProgress)
Private Sub New(ByVal URL As String, ByVal OutFile As SFile, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean)
PlayListURL = URL
BaseURL = RegexReplace(URL, BaseUrlPattern)
Video = New List(Of String)
@@ -70,6 +72,8 @@ Namespace API.Reddit
Me.OutFile.Extension = "mp4"
Me.Progress = Progress
ProgressExists = Not Me.Progress Is Nothing
ProgressPre = New PreProgress(Progress)
Me.UsePreProgress = UsePreProgress
Cache = New CacheKeeper($"{OutFile.PathWithSeparator}_{Base.M3U8Base.TempCacheFolderName}\")
CacheFiles = Cache.NewInstance
End Sub
@@ -142,12 +146,24 @@ Namespace API.Reddit
If tmpCache.Validate Then
Dim i%
Dim dFile As SFile = tmpCache.RootDirectory
If ProgressExists Then Progress.Maximum += Urls.Count
If ProgressExists Then
If UsePreProgress Then
ProgressPre.ChangeMax(Urls.Count)
Else
Progress.Maximum += Urls.Count
End If
End If
dFile.Extension = New SFile(Urls(0)).Extension
If dFile.Extension.IsEmptyString Then dFile.Extension = "ts"
Using w As New WebClient
For i = 0 To Urls.Count - 1
If ProgressExists Then Progress.Perform()
If ProgressExists Then
If UsePreProgress Then
ProgressPre.Perform()
Else
Progress.Perform()
End If
End If
Token.ThrowIfCancellationRequested()
dFile.Name = $"ConPart_{i}"
w.DownloadFile(Urls(i), dFile)
@@ -185,8 +201,9 @@ Namespace API.Reddit
End Function
#End Region
#Region "Statics"
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile, ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile
Using m As New M3U8(URL, f, Progress) : Return m.Download(Token) : End Using
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile, ByVal Token As CancellationToken,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Using m As New M3U8(URL, f, Progress, UsePreProgress) : Return m.Download(Token) : End Using
End Function
#End Region
#Region "IDisposable Support"
@@ -197,6 +214,7 @@ Namespace API.Reddit
Video.Clear()
Audio.Clear()
Cache.Dispose()
ProgressPre.Dispose()
End If
disposedValue = True
End If

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

@@ -14,6 +14,7 @@ Imports SCrawler.API.YouTube.Objects
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States
@@ -222,6 +223,7 @@ Namespace API.Reddit
GetUserInfo()
DownloadDataUser(String.Empty, Token)
End If
ProgressPre.Done()
End Sub
#End Region
#Region "Download Functions (User, Channel)"
@@ -247,7 +249,6 @@ Namespace API.Reddit
Dim ExistsDetected As Boolean = False
Dim IsCrossPost As Predicate(Of EContainer) = Function(e) Not e.Value(Node_CrosspostRootId).IsEmptyString Or Not e.Value(Node_CrosspostParentId).IsEmptyString Or Not e.Value(Node_CrosspostParent).IsEmptyString
Dim CheckNode As Predicate(Of EContainer) = Function(e) Not ParseUserMediaOnly OrElse If(e("author")?.Value, "/").ToLower.Equals(TrueName.StringToLower)
Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
Dim _PostID As Func(Of String) = Function() PostTmp.IfNullOrEmpty(PostID)
URL = $"https://gateway.reddit.com/desktopapi/v1/user/{TrueName}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
@@ -258,7 +259,9 @@ Namespace API.Reddit
If w.Count > 0 Then
n = w.GetNode(JsonNodesJson)
If Not n Is Nothing AndAlso n.Count > 0 Then
ProgressPre.ChangeMax(n.Count)
For Each nn In n
ProgressPre.Perform()
ThrowAny(Token)
If nn.Count > 0 Then
If CheckNode(nn) Then
@@ -340,7 +343,9 @@ Namespace API.Reddit
If w.Count > 0 Then
n = w.GetNode(ChannelJsonNodes)
If Not n Is Nothing AndAlso n.Count > 0 Then
ProgressPre.ChangeMax(n.Count)
For Each nn In n
ProgressPre.Perform()
ThrowAny(Token)
s = nn.ItemF({eCount})
If If(s?.Count, 0) > 0 Then
@@ -467,8 +472,40 @@ Namespace API.Reddit
Select Case t
Case "gallery" : If DownloadGallery(.Self, PostID, PostDate) Then _TotalPostsDownloaded += 1 Else added = False
Case "image", "gifvideo"
Dim resolution As Sizes = Nothing
Dim content As Sizes = Nothing
Dim chosenVal$ = String.Empty
ParseResolutions(e("media"), e("preview"), resolution)
If .Contains("content") Then
_TempMediaList.ListAddValue(MediaFromData(UPicType(t), .Value("content"), PostID, PostDate, UserID), LNC)
content = CreateSize(.Self, "content")
If content.HasError Or content.Data.IsEmptyString Then content = Nothing
End If
If UPicType(t) = UTypes.Picture Then
If Not content.Data.IsEmptyString Then
If Not resolution.Data.IsEmptyString Then
If content.Value >= resolution.Value AndAlso TryImage(content.Data) Then
chosenVal = content.Data
Else
chosenVal = resolution.Data
End If
Else
chosenVal = content.Data
End If
Else
chosenVal = resolution.Data
End If
Else
If Not resolution.Data.IsEmptyString Then
chosenVal = resolution.Data
ElseIf Not content.Data.IsEmptyString Then
chosenVal = content.Data
End If
End If
If Not chosenVal.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UPicType(t), chosenVal, PostID, PostDate, UserID), LNC)
_TotalPostsDownloaded += 1
Else
added = False
@@ -512,15 +549,17 @@ Namespace API.Reddit
added = ParseContainer(e.ItemF({"crosspost_parent_list", 0}), PostID, PostDate, UserID, True)
Else
Dim tPostId$ = e.Value(Node_CrosspostParent).IfNullOrEmpty(e.Value(Node_CrosspostParentId)).IfNullOrEmpty(e.Value(Node_CrosspostRootId))
Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
With j.ItemF({0, "data", "children", 0, "data"})
If .ListExists Then added = ParseContainer(.Self, PostID, PostDate, UserID, False)
End With
End If
End Using
If Not PostID.IsEmptyString Then
Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
With j.ItemF({0, "data", "children", 0, "data"})
If .ListExists Then added = ParseContainer(.Self, PostID, PostDate, UserID, False)
End With
End If
End Using
End If
End If
End If
End If
@@ -557,6 +596,19 @@ Namespace API.Reddit
Return False
End If
End Function
Private Function TryImage(ByVal URL As String) As Boolean
Try
Dim img As Image = GetImage(SFile.GetBytesFromNet(URL, EDP.ThrowException), EDP.ThrowException)
If Not img Is Nothing Then
img.Dispose()
Return True
Else
Return False
End If
Catch
Return False
End Try
End Function
#End Region
#Region "Download Base Functions"
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
@@ -640,26 +692,7 @@ Namespace API.Reddit
If Not Node Is Nothing Then
Dim n As EContainer = Node.ItemF({"preview", "images", 0})
Dim DestNode$() = Nothing
If If(n?.Count, 0) > 0 Then
If If(n("resolutions")?.Count, 0) > 0 Then
DestNode = {"resolutions"}
ElseIf If(n({"variants", "nsfw", "resolutions"})?.Count, 0) > 0 Then
DestNode = {"variants", "nsfw", "resolutions"}
End If
If Not DestNode Is Nothing Then
With n(DestNode)
Dim sl As List(Of Sizes) = .Select(Function(e) New Sizes(e.Value("width"), e.Value("url"))).
ListWithRemove(Function(ss) ss.HasError Or ss.Data.IsEmptyString)
If sl.ListExists Then
Dim s As Sizes
sl.Sort()
s = sl.First
sl.Clear()
Return s.Data
End If
End With
End If
End If
If If(n?.Count, 0) > 0 Then Return ParseResolutions(n)
End If
Return String.Empty
Catch ex As Exception
@@ -667,6 +700,46 @@ Namespace API.Reddit
Return String.Empty
End Try
End Function
Private Function ParseResolutions(ByVal Node As EContainer, Optional ByVal PreviewNode As EContainer = Nothing,
Optional ByRef SResult As Sizes = Nothing) As String
Try
If If(Node?.Count, 0) > 0 Then
Dim DestNode$() = Nothing
If If(Node("resolutions")?.Count, 0) > 0 Then
DestNode = {"resolutions"}
ElseIf If(Node({"variants", "nsfw", "resolutions"})?.Count, 0) > 0 Then
DestNode = {"variants", "nsfw", "resolutions"}
End If
If Not DestNode Is Nothing Then
With Node(DestNode)
Dim sl As List(Of Sizes) = .Select(Function(e) CreateSize(e)).
ListWithRemove(Function(ss) ss.HasError Or ss.Data.IsEmptyString)
If If(PreviewNode?.Count, 0) > 0 Then
Dim sp As Sizes = CreateSize(PreviewNode)
If Not sp.HasError And Not sp.Data.IsEmptyString Then
If sl Is Nothing Then sl = New List(Of Sizes)
sl.Add(sp)
End If
End If
If sl.ListExists Then
Dim s As Sizes
sl.Sort()
s = sl.First
sl.Clear()
SResult = s
Return s.Data
End If
End With
End If
End If
Return String.Empty
Catch ex As Exception
Return String.Empty
End Try
End Function
Private Function CreateSize(ByVal Node As EContainer, Optional ByVal UrlNodeName As String = "url") As Sizes
Return New Sizes(Node.Value("width"), Node.Value(UrlNodeName))
End Function
#End Region
#Region "ReparseVideo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
@@ -681,8 +754,10 @@ Namespace API.Reddit
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
Dim _repeatForRedgifs As Boolean
RedGifsResponser = RedGifsHost.Responser.Copy
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1
ThrowAny(Token)
ProgressPre.Perform()
If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then
m = _TempMediaList(i)
If _TempMediaList(i).Type = UTypes.VideoPre Then
@@ -728,6 +803,7 @@ Namespace API.Reddit
ProcessException(ex, Token, "video reparsing error", False)
Finally
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
ProgressPre.Done()
End Try
End Sub
#End Region
@@ -744,8 +820,10 @@ Namespace API.Reddit
Dim r$
Dim j As EContainer
Dim lastCount%, li%
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
ProgressPre.Perform()
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
@@ -781,6 +859,7 @@ Namespace API.Reddit
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
ProgressPre.Done()
End Try
End Sub
#End Region
@@ -804,17 +883,13 @@ Namespace API.Reddit
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}}
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CreateFileFromUrl(m.URL) Else m.File = Nothing
If ReplacePreview And m.URL.Contains("preview") Then m.URL = $"https://i.redd.it/{m.File.File}"
If ReplacePreview And m.URL.Contains("preview") And Not t = UTypes.Picture Then m.URL = $"https://i.redd.it/{m.File.File}"
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel), Nothing) Else m.Post.Date = Nothing
Return m
End Function
Private Function TryFile(ByVal URL As String) As Boolean
Try
If Not URL.IsEmptyString AndAlso URL.StringContains({".jpg", ".png", ".jpeg"}) Then
Return Not CreateFileFromUrl(URL).IsEmptyString
Else
Return False
End If
Return Not URL.IsEmptyString AndAlso Not CreateFileFromUrl(URL).IsEmptyString
Catch ex As Exception
Return False
End Try
@@ -861,7 +936,7 @@ Namespace API.Reddit
Return URL.Contains(SiteRedGifsKey)
End Function
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(URL, DestinationFile, Token, IIf(IsSingleObjectDownload, Progress, Nothing))
Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function
Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
If Not IsChannel Or Not SaveToCache Then

6
SCrawler/API/Redgifs/UserData.vb
View File

@@ -50,7 +50,9 @@ Namespace API.RedGifs
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("gifs") Then
pTotal = j.Value("pages").FromXML(Of Integer)(0)
ProgressPre.ChangeMax(j("gifs").Count)
For Each g As EContainer In j("gifs")
ProgressPre.Perform()
postDate = g.Value("createDate")
Select Case CheckDatesLimit(postDate, UnixDate32Provider)
Case DateResult.Skip : Continue For
@@ -102,11 +104,13 @@ Namespace API.RedGifs
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If _ContentList.Exists(MissingFinder) Then
If ContentMissingExists Then
Dim url$, r$
Dim u As UserMedia
Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
If _ContentList(i).State = UStates.Missing Then
ThrowAny(Token)
u = _ContentList(i)

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

@@ -129,6 +129,7 @@ Namespace API.ThisVid
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsPublic As Boolean, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
ProgressPre.ChangeMax(1)
Dim p$ = IIf(Page = 1, String.Empty, $"{Page}/")
If IsSavedPosts Then
URL = $"https://thisvid.com/my_favourite_videos/{p}"
@@ -136,6 +137,7 @@ Namespace API.ThisVid
URL = $"https://thisvid.com/members/{ID}/{IIf(IsPublic, "public", "private")}_videos/{p}"
End If
ThrowAny(Token)
ProgressPre.Perform()
Dim r$ = Responser.GetResponse(URL)
Dim cBefore% = _TempMediaList.Count
If Not r.IsEmptyString Then
@@ -182,7 +184,9 @@ Namespace API.ThisVid
__continue = True
If albums.ListExists Then
If albums.Count < 20 Then __continue = False
ProgressPre.ChangeMax(albums.Count)
For Each a As Album In albums
ProgressPre.Perform()
If Not a.URL.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse(a.URL,, rErr)
@@ -191,7 +195,9 @@ Namespace API.ThisVid
If a.Title.IsEmptyString Then a.Title = albumId
images = RegexReplace(r, RegExAlbumImagesList)
If images.ListExists Then
ProgressPre.ChangeMax(images.Count)
For Each img In images
ProgressPre.Perform()
ThrowAny(Token)
r = Responser.GetResponse(img,, rErr)
If Not r.IsEmptyString Then
@@ -242,7 +248,9 @@ Namespace API.ThisVid
Dim cookieFile As SFile = DirectCast(HOST.Source, SiteSettings).CookiesNetscapeFile
Dim command$
Dim e As EContainer
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
u = _TempMediaList(i)
If u.Type = UserMedia.Types.VideoPre Then
ThrowAny(Token)

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

@@ -125,36 +125,40 @@ Namespace API.Twitter
End With
End If
For Each nn In If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, w)
ThrowAny(Token)
If nn.Count > 0 Then
PostID = nn.Value("id")
If ID.IsEmptyString Then
ID = UID(nn)
If Not ID.IsEmptyString Then UpdateUserInformation()
With If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, w)
ProgressPre.ChangeMax(.Count)
For Each nn In .Self
ProgressPre.Perform()
ThrowAny(Token)
If nn.Count > 0 Then
PostID = nn.Value("id")
If ID.IsEmptyString Then
ID = UID(nn)
If Not ID.IsEmptyString Then UpdateUserInformation()
End If
'Date Pattern:
'Sat Jan 01 01:10:15 +0000 2000
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
Select Case CheckDatesLimit(PostDate, Declarations.DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
Else
ExistsDetected = True
Continue For
End If
If Not ParseUserMediaOnly OrElse
(Not nn.Contains("retweeted_status") OrElse (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then _
ObtainMedia(nn, PostID, PostDate)
End If
'Date Pattern:
'Sat Jan 01 01:10:15 +0000 2000
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
Select Case CheckDatesLimit(PostDate, Declarations.DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
Else
ExistsDetected = True
Continue For
End If
If Not ParseUserMediaOnly OrElse
(Not nn.Contains("retweeted_status") OrElse (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then _
ObtainMedia(nn, PostID, PostDate)
End If
Next
Next
End With
End If
End Using
@@ -174,7 +178,9 @@ Namespace API.Twitter
Dim j As EContainer, jj As EContainer
Dim jErr As New ErrorsDescriber(EDP.ReturnValue)
Dim rPattern As RParams = RParams.DM("(?<=tweet-)(\d+)\Z", 0, EDP.ReturnValue)
ProgressPre.ChangeMax(urls.Count)
For Each url$ In urls
ProgressPre.Perform()
r = Responser.GetResponse(url)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, jErr)
@@ -187,7 +193,9 @@ Namespace API.Twitter
Next
If postIds.Count > 0 Then postIds.RemoveAll(Function(pid) pid.IsEmptyString OrElse (_TempPostsList.Contains(pid) Or _DataNames.Contains(pid)))
If postIds.Count > 0 Then
ProgressPre.ChangeMax(postIds.Count)
For Each __id$ In postIds
ProgressPre.Perform()
_TempPostsList.Add(__id)
r = Responser.GetResponse(String.Format(SinglePostUrl, __id),, EDP.ReturnValue)
If Not r.IsEmptyString Then
@@ -329,7 +337,9 @@ Namespace API.Twitter
Dim m As UserMedia
Dim r$, 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

4
SCrawler/API/XVIDEOS/M3U8.vb
View File

@@ -14,7 +14,7 @@ Namespace API.XVIDEOS
Private Sub New()
End Sub
Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal f As SFile,
ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile
ByVal Token As CancellationToken, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Try
If Not URL.IsEmptyString Then
Using w As New WebClient
@@ -22,7 +22,7 @@ Namespace API.XVIDEOS
If Not r.IsEmptyString Then
Dim l As List(Of String) = ListAddList(Nothing, r.StringFormatLines.StringToList(Of String)(vbNewLine).ListWithRemove(Function(v) v.Trim.StartsWith("#")),
New ListAddParams With {.Converter = Function(Input) $"{Appender}/{Input.ToString.Trim}"})
If l.ListExists Then Return Base.M3U8Base.Download(l, f,, Token, Progress)
If l.ListExists Then Return Base.M3U8Base.Download(l, f,, Token, Progress, UsePreProgress)
End If
End Using
End If

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

@@ -91,8 +91,10 @@ Namespace API.XVIDEOS
If .Contains("videos") Then
With .Item("videos")
If .Count > 0 Then
ProgressPre.ChangeMax(.Count)
NextPage += 1
For Each jj In .Self
ProgressPre.Perform()
p = New UserMedia With {
.Post = jj.Value("id"),
.URL = $"https://www.xvideos.com/{jj.Value(n).StringTrimStart("/")}"
@@ -123,7 +125,9 @@ Namespace API.XVIDEOS
If Not j Is Nothing Then j.Dispose()
If _TempMediaList.Count > 0 Then
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = 0 To _TempMediaList.Count - 1
ProgressPre.Perform()
ThrowAny(Token)
_TempMediaList(i) = GetVideoData(_TempMediaList(i))
Next
@@ -180,7 +184,9 @@ Namespace API.XVIDEOS
Loop While NextPage < 100 And __continue
If _TempMediaList.Count > 0 Then
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = 0 To _TempMediaList.Count - 1
ProgressPre.Perform()
ThrowAny(Token)
_TempMediaList(i) = GetVideoData(_TempMediaList(i))
Next
@@ -244,7 +250,7 @@ Namespace API.XVIDEOS
If Not m.URL.IsEmptyString Then _TempMediaList.Add(m)
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.URL, Media.PictureOption, DestinationFile, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing))
Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function
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

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

@@ -75,8 +75,8 @@ Namespace API.Xhamster
End Try
End Function
Friend Shared Function Download(ByVal Media As UserMedia, ByVal Responser As Responser, ByVal UHD As Boolean,
ByVal Token As CancellationToken, ByVal Progress As MyProgress) As SFile
Return M3U8Base.Download(ObtainUrls(Media.URL, Responser, UHD), Media.File, Responser, Token, Progress)
ByVal Token As CancellationToken, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Return M3U8Base.Download(ObtainUrls(Media.URL, Responser, UHD), Media.File, Responser, Token, Progress, UsePreProgress)
End Function
End Class
End Namespace

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

@@ -112,7 +112,9 @@ Namespace API.Xhamster
With j(listNode)
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each e As EContainer In .Self
ProgressPre.Perform()
m = ExtractMedia(e, Type)
If Not m.URL.IsEmptyString Then
If m.File.IsEmptyString Then Continue For
@@ -160,7 +162,9 @@ Namespace API.Xhamster
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia, m2 As UserMedia
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then
@@ -182,7 +186,8 @@ Namespace API.Xhamster
End Sub
Private Overloads Sub ReparsePhoto(ByVal Token As CancellationToken)
If _TempPhotoData.Count > 0 Then
For i% = 0 To _TempPhotoData.Count - 1 : ReparsePhoto(i, 1, Token) : Next
ProgressPre.ChangeMax(_TempPhotoData.Count)
For i% = 0 To _TempPhotoData.Count - 1 : ProgressPre.Perform() : ReparsePhoto(i, 1, Token) : Next
_TempPhotoData.Clear()
End If
End Sub
@@ -235,7 +240,9 @@ Namespace API.Xhamster
Try
If ContentMissingExists Then
Dim m As UserMedia, m2 As UserMedia
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
@@ -297,7 +304,7 @@ Namespace API.Xhamster
End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Media.File = DestinationFile
Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value, Token, If(UseInternalM3U8Function_UseProgress, Progress, Nothing))
Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value, Token, Progress, Not IsSingleObjectDownload)
End Function
#End Region
#Region "Create media"

11
SCrawler/API/YouTube/UserData.vb
View File

@@ -111,6 +111,7 @@ Namespace API.YouTube
#Region "Download"
'Playlist reconfiguration implemented only for channels + music
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim pr As New YTPreProgress(ProgressPre)
Try
Dim container As IYouTubeMediaContainer = Nothing
Dim list As New List(Of IYouTubeMediaContainer)
@@ -154,7 +155,7 @@ Namespace API.YouTube
maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDatePlaylist)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDatePlaylist)
applySpecFolder.Invoke(String.Empty, False)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
ElseIf YTMediaType = YouTubeMediaType.Channel Then
@@ -162,7 +163,7 @@ Namespace API.YouTube
maxDate = Nothing
LastDownloadDateVideos = nDate(LastDownloadDateVideos)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/{IIf(IsMusic Or IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDateVideos)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDateVideos)
applySpecFolder.Invoke(IIf(IsMusic, String.Empty, "Videos"), False)
If fillList.Invoke(LastDownloadDateVideos) Then LastDownloadDateVideos = If(maxDate, Now)
End If
@@ -170,7 +171,7 @@ Namespace API.YouTube
maxDate = Nothing
LastDownloadDateShorts = nDate(LastDownloadDateShorts)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/shorts"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDateShorts)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDateShorts)
applySpecFolder.Invoke("Shorts", False)
If fillList.Invoke(LastDownloadDateShorts) Then LastDownloadDateShorts = If(maxDate, Now)
End If
@@ -178,7 +179,7 @@ Namespace API.YouTube
maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/playlists"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token,, True, False,, LastDownloadDatePlaylist)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, True, False,, LastDownloadDatePlaylist)
applySpecFolder.Invoke("Playlists", True)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
End If
@@ -196,6 +197,8 @@ Namespace API.YouTube
End If
Catch ex As Exception
ProcessException(ex, Token, "data downloading error")
Finally
pr.Dispose()
End Try
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)

38
SCrawler/API/YouTube/YTPreProgress.vb Normal file
View File

@@ -0,0 +1,38 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms.Toolbars
Namespace API.YouTube
Friend Class YTPreProgress : Inherits MyProgress
Private ReadOnly AssocProgress As PreProgress
Friend Sub New(ByRef ExtProgress As PreProgress)
AssocProgress = ExtProgress
End Sub
Public Overrides Property Maximum As Double
Get
Return _Maximum
End Get
Set(ByVal Max As Double)
_Maximum = Max
AssocProgress.ChangeMax(Max, False)
End Set
End Property
Public Overrides Sub Perform(Optional ByVal Value As Double = 1)
AssocProgress.Perform(Value)
End Sub
Public Overrides Sub Done()
AssocProgress.Done()
End Sub
Public Overrides Property Visible(Optional ByVal ProgressBar As Boolean = True, Optional ByVal Label As Boolean = True) As Boolean
Get
Return True
End Get
Set : End Set
End Property
End Class
End Namespace

5
SCrawler/Download/ActiveDownloadingProgress.vb
View File

@@ -63,6 +63,7 @@ Namespace DownloadObjects
.RowCount += 1
JobsList.Add(New DownloadProgress(j))
AddHandler JobsList.Last.ProgressMaximumChanged, AddressOf Jobs_ProgressMaximumChanged
AddHandler JobsList.Last.ProgressMaximum0Changed, AddressOf Jobs_ProgressMaximum0Changed
.Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1)
End With
Next
@@ -90,5 +91,9 @@ Namespace DownloadObjects
If MainProgress.Value > 0 Then MainProgress.Perform()
End If
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 Namespace

19
SCrawler/Download/DownloadProgress.vb
View File

@@ -14,6 +14,7 @@ Namespace DownloadObjects
#Region "Events"
Friend Event DownloadDone As NotificationEventHandler
Friend Event ProgressMaximumChanged()
Friend Event ProgressMaximum0Changed()
#End Region
#Region "Declarations"
#Region "Controls"
@@ -114,10 +115,12 @@ Namespace DownloadObjects
End If
With Job
.Progress = New MyProgress(PR_MAIN, LBL_INFO) With {.ResetProgressOnMaximumChanges = False}
With .Progress
.Progress = New MyProgressExt(PR_MAIN, LBL_INFO) With {.ResetProgressOnMaximumChanges = False}
With DirectCast(.Progress, MyProgressExt)
AddHandler .ProgressChanged, AddressOf JobProgress_ProgressChanged
AddHandler .MaximumChanged, AddressOf JobProgress_MaximumChanged
AddHandler .Maximum0Changed, AddressOf JobProgress_Maximum0Changed
AddHandler .Progress0Changed, AddressOf JobProgress_Progress0Changed
End With
End With
@@ -183,8 +186,18 @@ Namespace DownloadObjects
Private Sub JobProgress_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
RaiseEvent ProgressMaximumChanged()
End Sub
Private Sub JobProgress_Maximum0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs)
RaiseEvent ProgressMaximum0Changed()
End Sub
Private Sub JobProgress_ProgressChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If Not Job.Type = Download.SavedPosts Then MainProgress.Perform()
If Not Job.Type = Download.SavedPosts Then
MainProgress.Value = DirectCast(Sender, MyProgressExt).Value
MainProgress.Perform(0)
End If
End Sub
Private Sub JobProgress_Progress0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs)
MainProgress.Value0 = DirectCast(Sender, MyProgressExt).Value0
MainProgress.Perform0(0)
End Sub
#End Region
#Region "IDisposable Support"

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

@@ -105,10 +105,10 @@ Namespace Editors
'BTT_OTHER_SETTINGS
'
Me.BTT_OTHER_SETTINGS.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(2, 2)
Me.BTT_OTHER_SETTINGS.Location = New System.Drawing.Point(1, 1)
Me.BTT_OTHER_SETTINGS.Margin = New System.Windows.Forms.Padding(1)
Me.BTT_OTHER_SETTINGS.Name = "BTT_OTHER_SETTINGS"
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(101, 24)
Me.BTT_OTHER_SETTINGS.Size = New System.Drawing.Size(101, 26)
Me.BTT_OTHER_SETTINGS.TabIndex = 1
Me.BTT_OTHER_SETTINGS.Text = "Options (F2)"
TT_MAIN.SetToolTip(Me.BTT_OTHER_SETTINGS, "Other settings")
@@ -177,7 +177,6 @@ Namespace Editors
'
'TP_SITE
'
Me.TP_SITE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
Me.TP_SITE.ColumnCount = 2
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 103.0!))
Me.TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
@@ -209,10 +208,10 @@ Namespace Editors
Me.CMB_SITE.Columns.Add(ListColumn1)
Me.CMB_SITE.Columns.Add(ListColumn2)
Me.CMB_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_SITE.Location = New System.Drawing.Point(108, 3)
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3)
Me.CMB_SITE.Location = New System.Drawing.Point(103, 3)
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(0, 3, 3, 3)
Me.CMB_SITE.Name = "CMB_SITE"
Me.CMB_SITE.Size = New System.Drawing.Size(340, 21)
Me.CMB_SITE.Size = New System.Drawing.Size(346, 22)
Me.CMB_SITE.TabIndex = 0
Me.CMB_SITE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
'

287
SCrawler/Editors/UsersInfoForm.Designer.vb generated Normal file
View File

@@ -0,0 +1,287 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace Editors
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class UsersInfoForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(UsersInfoForm))
Me.Toolbar_TOP = New System.Windows.Forms.ToolStrip()
Me.BTT_START = New System.Windows.Forms.ToolStripButton()
Me.BTT_CANCEL = New System.Windows.Forms.ToolStripButton()
Me.MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
Me.OPT_DATE = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SIZE = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_AMOUNT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_ASC = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_DESC = New System.Windows.Forms.ToolStripMenuItem()
Me.CH_GROUP_DRIVE = New System.Windows.Forms.ToolStripMenuItem()
Me.CH_GROUP_COL = New System.Windows.Forms.ToolStripMenuItem()
Me.Toolbar_BOTTOM = New System.Windows.Forms.StatusStrip()
Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_STATUS = New System.Windows.Forms.ToolStripStatusLabel()
Me.LIST_DATA = New System.Windows.Forms.ListView()
Me.COL_DEFAULT = CType(New System.Windows.Forms.ColumnHeader(), System.Windows.Forms.ColumnHeader)
Me.CONTEXT_LIST = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.CONTEXT_BTT_FIND = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_BTT_INFO = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_BTT_OPEN_FOLDER = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_BTT_OPEN_SITE = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.Toolbar_TOP.SuspendLayout()
Me.Toolbar_BOTTOM.SuspendLayout()
Me.CONTEXT_LIST.SuspendLayout()
Me.SuspendLayout()
'
'SEP_1
'
SEP_1.Name = "SEP_1"
SEP_1.Size = New System.Drawing.Size(6, 25)
'
'CONTEXT_SEP_1
'
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(166, 6)
'
'MENU_SEP_1
'
MENU_SEP_1.Name = "MENU_SEP_1"
MENU_SEP_1.Size = New System.Drawing.Size(175, 6)
'
'MENU_SEP_2
'
MENU_SEP_2.Name = "MENU_SEP_2"
MENU_SEP_2.Size = New System.Drawing.Size(175, 6)
'
'Toolbar_TOP
'
Me.Toolbar_TOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.Toolbar_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_START, Me.BTT_CANCEL, SEP_1, Me.MENU_VIEW})
Me.Toolbar_TOP.Location = New System.Drawing.Point(0, 0)
Me.Toolbar_TOP.Name = "Toolbar_TOP"
Me.Toolbar_TOP.ShowItemToolTips = False
Me.Toolbar_TOP.Size = New System.Drawing.Size(284, 25)
Me.Toolbar_TOP.TabIndex = 0
'
'BTT_START
'
Me.BTT_START.AutoToolTip = False
Me.BTT_START.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_START.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_START.Name = "BTT_START"
Me.BTT_START.Size = New System.Drawing.Size(76, 22)
Me.BTT_START.Text = "Calculate"
'
'BTT_CANCEL
'
Me.BTT_CANCEL.AutoToolTip = False
Me.BTT_CANCEL.Enabled = False
Me.BTT_CANCEL.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_CANCEL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CANCEL.Name = "BTT_CANCEL"
Me.BTT_CANCEL.Size = New System.Drawing.Size(63, 22)
Me.BTT_CANCEL.Text = "Cancel"
'
'MENU_VIEW
'
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.OPT_DATE, Me.OPT_SIZE, Me.OPT_AMOUNT, MENU_SEP_1, Me.OPT_ASC, Me.OPT_DESC, MENU_SEP_2, Me.CH_GROUP_DRIVE, Me.CH_GROUP_COL})
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"
Me.MENU_VIEW.Size = New System.Drawing.Size(61, 22)
Me.MENU_VIEW.Text = "View"
'
'OPT_DATE
'
Me.OPT_DATE.CheckOnClick = True
Me.OPT_DATE.Name = "OPT_DATE"
Me.OPT_DATE.Size = New System.Drawing.Size(178, 22)
Me.OPT_DATE.Text = "Sort by date"
'
'OPT_SIZE
'
Me.OPT_SIZE.CheckOnClick = True
Me.OPT_SIZE.Name = "OPT_SIZE"
Me.OPT_SIZE.Size = New System.Drawing.Size(178, 22)
Me.OPT_SIZE.Text = "Sort by size"
'
'OPT_AMOUNT
'
Me.OPT_AMOUNT.CheckOnClick = True
Me.OPT_AMOUNT.Name = "OPT_AMOUNT"
Me.OPT_AMOUNT.Size = New System.Drawing.Size(178, 22)
Me.OPT_AMOUNT.Text = "Sort by amount"
'
'OPT_ASC
'
Me.OPT_ASC.CheckOnClick = True
Me.OPT_ASC.Name = "OPT_ASC"
Me.OPT_ASC.Size = New System.Drawing.Size(178, 22)
Me.OPT_ASC.Text = "Ascending"
'
'OPT_DESC
'
Me.OPT_DESC.CheckOnClick = True
Me.OPT_DESC.Name = "OPT_DESC"
Me.OPT_DESC.Size = New System.Drawing.Size(178, 22)
Me.OPT_DESC.Text = "Descending"
'
'CH_GROUP_DRIVE
'
Me.CH_GROUP_DRIVE.CheckOnClick = True
Me.CH_GROUP_DRIVE.Name = "CH_GROUP_DRIVE"
Me.CH_GROUP_DRIVE.Size = New System.Drawing.Size(178, 22)
Me.CH_GROUP_DRIVE.Text = "Group by drive"
'
'CH_GROUP_COL
'
Me.CH_GROUP_COL.CheckOnClick = True
Me.CH_GROUP_COL.Name = "CH_GROUP_COL"
Me.CH_GROUP_COL.Size = New System.Drawing.Size(178, 22)
Me.CH_GROUP_COL.Text = "Group by collection"
'
'Toolbar_BOTTOM
'
Me.Toolbar_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.PR_MAIN, Me.LBL_STATUS})
Me.Toolbar_BOTTOM.Location = New System.Drawing.Point(0, 239)
Me.Toolbar_BOTTOM.Name = "Toolbar_BOTTOM"
Me.Toolbar_BOTTOM.Size = New System.Drawing.Size(284, 22)
Me.Toolbar_BOTTOM.TabIndex = 1
'
'PR_MAIN
'
Me.PR_MAIN.Name = "PR_MAIN"
Me.PR_MAIN.Size = New System.Drawing.Size(200, 16)
Me.PR_MAIN.Visible = False
'
'LBL_STATUS
'
Me.LBL_STATUS.Name = "LBL_STATUS"
Me.LBL_STATUS.Size = New System.Drawing.Size(0, 17)
'
'LIST_DATA
'
Me.LIST_DATA.Columns.AddRange(New System.Windows.Forms.ColumnHeader() {Me.COL_DEFAULT})
Me.LIST_DATA.ContextMenuStrip = Me.CONTEXT_LIST
Me.LIST_DATA.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_DATA.FullRowSelect = True
Me.LIST_DATA.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
Me.LIST_DATA.HideSelection = False
Me.LIST_DATA.Location = New System.Drawing.Point(0, 25)
Me.LIST_DATA.MultiSelect = False
Me.LIST_DATA.Name = "LIST_DATA"
Me.LIST_DATA.Size = New System.Drawing.Size(284, 214)
Me.LIST_DATA.TabIndex = 2
Me.LIST_DATA.UseCompatibleStateImageBehavior = False
Me.LIST_DATA.View = System.Windows.Forms.View.Details
'
'COL_DEFAULT
'
Me.COL_DEFAULT.Text = "User"
Me.COL_DEFAULT.Width = 280
'
'CONTEXT_LIST
'
Me.CONTEXT_LIST.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.CONTEXT_BTT_FIND, Me.CONTEXT_BTT_INFO, CONTEXT_SEP_1, Me.CONTEXT_BTT_OPEN_FOLDER, Me.CONTEXT_BTT_OPEN_SITE})
Me.CONTEXT_LIST.Name = "CONTEXT_LIST"
Me.CONTEXT_LIST.Size = New System.Drawing.Size(170, 98)
'
'CONTEXT_BTT_FIND
'
Me.CONTEXT_BTT_FIND.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.CONTEXT_BTT_FIND.Name = "CONTEXT_BTT_FIND"
Me.CONTEXT_BTT_FIND.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_FIND.Text = "Find user"
'
'CONTEXT_BTT_INFO
'
Me.CONTEXT_BTT_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.CONTEXT_BTT_INFO.Name = "CONTEXT_BTT_INFO"
Me.CONTEXT_BTT_INFO.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_INFO.Text = "Show information"
'
'CONTEXT_BTT_OPEN_FOLDER
'
Me.CONTEXT_BTT_OPEN_FOLDER.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32
Me.CONTEXT_BTT_OPEN_FOLDER.Name = "CONTEXT_BTT_OPEN_FOLDER"
Me.CONTEXT_BTT_OPEN_FOLDER.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_OPEN_FOLDER.Text = "Open folder"
'
'CONTEXT_BTT_OPEN_SITE
'
Me.CONTEXT_BTT_OPEN_SITE.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
Me.CONTEXT_BTT_OPEN_SITE.Name = "CONTEXT_BTT_OPEN_SITE"
Me.CONTEXT_BTT_OPEN_SITE.Size = New System.Drawing.Size(169, 22)
Me.CONTEXT_BTT_OPEN_SITE.Text = "Open site"
'
'UsersInfoForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(284, 261)
Me.Controls.Add(Me.LIST_DATA)
Me.Controls.Add(Me.Toolbar_BOTTOM)
Me.Controls.Add(Me.Toolbar_TOP)
Me.Icon = Global.SCrawler.My.Resources.Resources.UsersIcon_32
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(300, 300)
Me.Name = "UsersInfoForm"
Me.Text = "Users info"
Me.Toolbar_TOP.ResumeLayout(False)
Me.Toolbar_TOP.PerformLayout()
Me.Toolbar_BOTTOM.ResumeLayout(False)
Me.Toolbar_BOTTOM.PerformLayout()
Me.CONTEXT_LIST.ResumeLayout(False)
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Private WithEvents Toolbar_TOP As ToolStrip
Private WithEvents Toolbar_BOTTOM As StatusStrip
Private WithEvents PR_MAIN As ToolStripProgressBar
Private WithEvents LBL_STATUS As ToolStripStatusLabel
Private WithEvents LIST_DATA As ListView
Private WithEvents BTT_START As ToolStripButton
Private WithEvents BTT_CANCEL As ToolStripButton
Private WithEvents COL_DEFAULT As ColumnHeader
Private WithEvents CONTEXT_LIST As ContextMenuStrip
Private WithEvents CONTEXT_BTT_FIND As ToolStripMenuItem
Private WithEvents CONTEXT_BTT_INFO As ToolStripMenuItem
Private WithEvents CONTEXT_BTT_OPEN_FOLDER As ToolStripMenuItem
Private WithEvents CONTEXT_BTT_OPEN_SITE As ToolStripMenuItem
Private WithEvents MENU_VIEW As ToolStripDropDownButton
Private WithEvents OPT_DATE As ToolStripMenuItem
Private WithEvents OPT_SIZE As ToolStripMenuItem
Private WithEvents OPT_AMOUNT As ToolStripMenuItem
Private WithEvents OPT_ASC As ToolStripMenuItem
Private WithEvents OPT_DESC As ToolStripMenuItem
Private WithEvents CH_GROUP_DRIVE As ToolStripMenuItem
Private WithEvents CH_GROUP_COL As ToolStripMenuItem
End Class
End Namespace

150
SCrawler/Editors/UsersInfoForm.resx Normal file
View File

@@ -0,0 +1,150 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="CONTEXT_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="Toolbar_TOP.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="MENU_VIEW.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAABkSURBVDhPY6AKyO86WFDQfeg/iIYKkQZAmkNbnvyXta76
DxViYGFi+Y8PQ5VBAMhmkGYgJs8FAw9GA5EKILFiWUFixfL/IBoqRBoAafYsOvpf0jiTvEAE2QzSLGmU
MeQCkYEBAD3tUdo+/cEPAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="Toolbar_BOTTOM.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>138, 17</value>
</metadata>
<metadata name="CONTEXT_LIST.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>286, 17</value>
</metadata>
</root>

504
SCrawler/Editors/UsersInfoForm.vb Normal file
View File

@@ -0,0 +1,504 @@
' 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 System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace Editors
Friend Class UsersInfoForm
#Region "Declarations"
Private ReadOnly MyView As FormView
Private ReadOnly MyProgress As MyProgress
Private MyThread As Thread = Nothing
Private TokenSource As CancellationTokenSource = Nothing
Private Token As CancellationToken = Nothing
Private ReadOnly MyUsers As List(Of UserOpt)
Private ReadOnly LetterGroups As Dictionary(Of String, ListViewGroup)
Private ReadOnly MyNumberProvider As ANumbers
Private ReadOnly SizeNumberProvider As ANumbers
Private Enum EComparers As Integer
Size = 0
[Date] = 1
Amount = 2
End Enum
#Region "Comparers declarations"
Private ReadOnly MyComparerDate As New ComparerDate
Private ReadOnly MyComparerSize As New ComparerSize
Private ReadOnly MyComparerAmount As New ComparerAmount
#End Region
#Region "Comparers classes"
Private Class ComparerDate : Implements IComparer(Of UserOpt)
Protected _Order As Integer = -1
Friend Property Order As SortOrder
Get
Return IIf(_Order = -1, SortOrder.Descending, SortOrder.Ascending)
End Get
Set(ByVal _Order As SortOrder)
If _Order = SortOrder.Descending Then Me._Order = -1 Else Me._Order = 1
End Set
End Property
Friend Overridable Function Compare(ByVal x As UserOpt, ByVal y As UserOpt) As Integer Implements IComparer(Of UserOpt).Compare
Dim xd& = If(x.User.LastUpdated, New Date).Ticks
Dim yd& = If(y.User.LastUpdated, New Date).Ticks
Return xd.CompareTo(yd) * _Order
End Function
End Class
Private Class ComparerSize : Inherits ComparerDate
Friend Overrides Function Compare(ByVal x As UserOpt, ByVal y As UserOpt) As Integer
Return x.TotalSize.CompareTo(y.TotalSize) * _Order
End Function
End Class
Private Class ComparerAmount : Inherits ComparerDate
Friend Overrides Function Compare(ByVal x As UserOpt, ByVal y As UserOpt) As Integer
Return x.Files.Count.CompareTo(y.Files.Count) * _Order
End Function
End Class
#End Region
#Region "Classes"
Private Structure FileOpt
Friend File As SFile
Friend Size As Double
Friend Type As UTypes
Friend Sub New(ByVal f As SFile, Optional ByVal CalculateSize As Boolean = False)
File = f
If CalculateSize Then Size = File.Size
Type = UTypes.Undefined
If Not f.Extension.IsEmptyString Then
Select Case f.Extension
Case "jpg", "jped", "png", "webp" : Type = UTypes.Picture
Case "gif" : Type = UTypes.GIF
Case "mp4", "mkv" : Type = UTypes.Video
End Select
End If
End Sub
Public Shared Widening Operator CType(ByVal f As SFile) As FileOpt
Return New FileOpt(f)
End Operator
Public Shared Widening Operator CType(ByVal f As FileOpt) As SFile
Return f.File
End Operator
Public Shared Narrowing Operator CType(ByVal f As FileOpt) As Double
Return f.Size
End Operator
End Structure
Private NotInheritable Class UserOpt : Implements IComparable(Of UserOpt), IDisposable
Friend Property User As UserDataBase
Friend Property UserPath As SFile
Friend Property Letter As String
Friend ReadOnly Property Files As List(Of FileOpt)
Friend Property TotalSize As Double = 0
Friend Property CollectionName As String
Friend Property Name As String
Friend Property Site As String
Friend Property Key As String
Private ReadOnly NumberProvider As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral, .DecimalDigits = 2, .TrimDecimalDigits = True}
Friend Sub New(ByVal User As UserDataBase)
Me.User = User
Files = New List(Of FileOpt)
CollectionName = User.CollectionName
Site = User.Site
Name = User.FriendlyName.IfNullOrEmpty(User.Name)
Key = User.LVIKey
UserPath = User.User.File.CutPath
Letter = UserPath.Segments.FirstOrDefault.StringToUpper.StringTrimEnd(":")
End Sub
Friend Sub GetFiles()
If UserPath.Exists(SFO.Path, False) Then
Dim files As List(Of SFile) = SFile.GetFiles(UserPath,, IO.SearchOption.AllDirectories, EDP.ReturnValue)
If files.ListExists Then
For Each f As SFile In files : Me.Files.Add(New FileOpt(f, True)) : Next
TotalSize = Me.Files.Sum(Function(ff) ff.Size)
End If
End If
End Sub
Friend Function GetLVI(ByVal LetterGroup As ListViewGroup, ByVal CollectionGroup As Boolean) As ListViewItem
Dim lvi As New ListViewItem
Dim s$ = String.Empty
If Not CollectionName.IsEmptyString Then s = $"{IIf(CollectionGroup, " ", String.Empty)}{CollectionName}"
s.StringAppend(Site, ".")
s.StringAppend(Name, ".")
s &= $" [{GetSizeStr(TotalSize)}]"
If Not User.UserExists Then
s &= " DELETED"
ElseIf User.UserSuspended Then
s &= " SUSPENDED"
End If
s &= ": "
Dim infoStr$ = String.Empty
infoStr.StringAppend(GetInfoStr(UTypes.Picture), "; ")
infoStr.StringAppend(GetInfoStr(UTypes.GIF), "; ")
infoStr.StringAppend(GetInfoStr(UTypes.Video), "; ")
infoStr.StringAppend(GetInfoStr(UTypes.Undefined), "; ")
If Not infoStr.IsEmptyString Then infoStr &= "; "
If User.LastUpdated.HasValue Then
infoStr &= $"({User.LastUpdated.Value.ToStringDate(ADateTime.Formats.BaseDate)})"
Else
infoStr &= "(not downloaded yet)"
End If
s &= infoStr
lvi.Text = s
lvi.Name = Key
lvi.Tag = Me
lvi.Group = LetterGroup
Return lvi
End Function
Private Function GetSizeStr(ByVal Value As Double) As String
If Value > 0 Then
Dim sizeText$ = "Mb"
Dim sizeValue# = Value / 1024 / 1024
If sizeValue > 1000 Then sizeValue /= 1024 : sizeText = "Gb"
Return $"{sizeValue.RoundVal(2).NumToString(NumberProvider)}{sizeText}"
Else
Return "0Kb"
End If
End Function
Private Function GetInfoStr(ByVal t As UTypes, Optional ByVal Separator As String = " ") As String
Dim OutStr$ = String.Empty
Dim d As IEnumerable(Of FileOpt) = Files.Where(Function(f) f.Type = t)
If d.ListExists Then
Return $"{t} ({d.Count.NumToString(NumberProvider)}){Separator}[{GetSizeStr(d.Sum(Function(dd) dd.Size))}]"
Else
Return String.Empty
End If
End Function
Friend Function GetInfornation() As String
Dim s$ = String.Empty
If Not CollectionName.IsEmptyString Then s &= $"Collection: {CollectionName}"
s.StringAppendLine(Site)
s.StringAppendLine(Name)
s.StringAppendLine($"Total size: {GetSizeStr(TotalSize)}")
s &= vbNewLine
s.StringAppendLine(GetInfoStr(UTypes.Picture, ": "))
s.StringAppendLine(GetInfoStr(UTypes.GIF, ": "))
s.StringAppendLine(GetInfoStr(UTypes.Video, ": "))
s.StringAppendLine(GetInfoStr(UTypes.Undefined, ": "))
If Not User.UserExists Then
s.StringAppendLine("User DELETED")
ElseIf User.UserSuspended Then
s.StringAppendLine("User SUSPENDED")
End If
s.StringAppendLine("Last download date: ")
If User.LastUpdated.HasValue Then
s &= User.LastUpdated.Value.ToStringDate(ADateTime.Formats.BaseDate)
Else
s &= "not downloaded yet"
End If
Return s
End Function
#Region "IComparable Support"
Private Function CompareTo(ByVal Other As UserOpt) As Integer Implements IComparable(Of UserOpt).CompareTo
Return TotalSize.CompareTo(Other.TotalSize) * -1
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Files.Clear()
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 Region
#End Region
#Region "Initializer"
Friend Sub New()
InitializeComponent()
MyView = New FormView(Me, Settings.Design)
MyProgress = New MyProgress(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS)
MyUsers = New List(Of UserOpt)
LetterGroups = New Dictionary(Of String, ListViewGroup)
MyNumberProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
SizeNumberProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral, .DecimalDigits = 2, .TrimDecimalDigits = True}
End Sub
#End Region
#Region "Form handlers"
Private Sub UsersInfoForm_Load(sender As Object, e As EventArgs) Handles Me.Load
MyView.Import()
MyView.SetFormSize()
OPT_DATE.Tag = CInt(EComparers.Date)
OPT_SIZE.Tag = CInt(EComparers.Size)
OPT_AMOUNT.Tag = CInt(EComparers.Amount)
Select Case Settings.UMetrics_What.Value
Case EComparers.Date : OPT_DATE.Checked = True
Case EComparers.Amount : OPT_AMOUNT.Checked = True
Case Else : OPT_SIZE.Checked = True
End Select
OPT_ASC.Tag = CInt(SortOrder.Ascending)
OPT_DESC.Tag = CInt(SortOrder.Descending)
If Settings.UMetrics_Order.Value = SortOrder.Ascending Then
OPT_ASC.Checked = True
Else
OPT_DESC.Checked = True
End If
CH_GROUP_DRIVE.Checked = Settings.UMetrics_ShowDrives
CH_GROUP_COL.Checked = Settings.UMetrics_ShowCollections
LIST_DATA.ShowGroups = CH_GROUP_DRIVE.Checked
COL_DEFAULT.Width = -2
End Sub
Private Sub UsersInfoForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True
Hide()
End Sub
Private Sub UsersInfoForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
Abort()
MyProgress.Dispose()
MyView.Dispose()
End Sub
Private Sub UsersInfoForm_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd
Try : ControlInvokeFast(LIST_DATA, Sub() COL_DEFAULT.Width = -2, EDP.None) : Catch : End Try
End Sub
#End Region
#Region "Calculating"
Private Sub Abort()
Try
If If(MyThread?.IsAlive, False) Then TokenSource.Cancel() : MyThread.Abort()
Catch ex As Exception
End Try
End Sub
Private _CalculationInProgress As Boolean = False
Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click
If Not If(MyThread?.IsAlive, False) Then
_CalculationInProgress = True
MyUsers.ListClearDispose
LetterGroups.Clear()
LIST_DATA.Groups.Clear()
LIST_DATA.Items.Clear()
If Not TokenSource Is Nothing Then TokenSource.Dispose()
TokenSource = New CancellationTokenSource
Token = TokenSource.Token
ChangeControlsEnabled(True)
MyThread = New Thread(New ThreadStart(AddressOf Calculate))
MyThread.SetApartmentState(ApartmentState.MTA)
MyThread.IsBackground = True
MyThread.Start()
Else
MsgBoxE({"The calculating is already underway", "Calculating"}, vbCritical)
End If
End Sub
Private Sub BTT_CANCEL_Click(sender As Object, e As EventArgs) Handles BTT_CANCEL.Click
TokenSource.Cancel()
ControlInvokeFast(Toolbar_TOP, BTT_CANCEL, Sub() BTT_CANCEL.Enabled = False, EDP.None)
End Sub
Private Sub ChangeControlsEnabled(ByVal Working As Boolean)
Try
ControlInvokeFast(Toolbar_TOP, BTT_START, Sub()
BTT_START.Enabled = Not Working
BTT_CANCEL.Enabled = Working
End Sub, EDP.None)
If Not Working Then MainFrameObj.UpdateLogButton()
Catch
End Try
End Sub
Private Sub Calculate()
Try
MyProgress.Visible = True
MyProgress.Reset()
If Settings.Users.Count > 0 Then
With Settings.Users.SelectMany(Function(ByVal u As IUserData) As IEnumerable(Of IUserData)
If u.IsCollection Then
With DirectCast(u, API.UserDataBind)
If .Count > 0 Then Return .Collections Else Return New UserDataBase() {}
End With
Else
Return {u}
End If
End Function)
If .ListExists Then .ToList.ForEach(Sub(u As UserDataBase) MyUsers.Add(New UserOpt(u)))
End With
End If
If MyUsers.Count > 0 Then
MyProgress.Maximum += MyUsers.Count
Dim i% = 0
Dim letters As IEnumerable(Of String) = MyUsers.Select(Function(u) u.Letter).Distinct
LetterGroups.Clear()
If letters.ListExists(2) Then
ControlInvokeFast(LIST_DATA, Sub()
For Each l$ In letters
LetterGroups.Add(l, New ListViewGroup(l, $"Drive {l}"))
LIST_DATA.Groups.Add(LetterGroups.Last.Value)
Next
End Sub, EDP.None)
End If
MyProgress.Information = "Calculating of user metrics"
For Each user As UserOpt In MyUsers
Token.ThrowIfCancellationRequested()
i += 1
MyProgress.Perform()
user.GetFiles()
Next
_CalculationInProgress = False
RefillList()
End If
MyProgress.Done()
MyProgress.InformationTemporary = "All user metrics have been calculated."
Catch oex As OperationCanceledException
MyProgress.Done()
MyProgress.InformationTemporary = "Operation canceled"
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[UsersInfoForm.Calculate]")
MyProgress.Done()
MyProgress.InformationTemporary = "An error occurred while calculating user metrics."
Finally
MyProgress.Visible(, False) = False
ChangeControlsEnabled(False)
_CalculationInProgress = False
End Try
End Sub
Private _RefillInProgress As Boolean = False
Private Sub RefillList()
If Not _CalculationInProgress AndAlso Not _RefillInProgress AndAlso MyUsers.Count > 0 Then
_RefillInProgress = True
ControlInvokeFast(LIST_DATA, Sub() LIST_DATA.Items.Clear(), EDP.None)
If MyUsers.Count > 0 Then
Dim i% = 0
Dim g As Func(Of UserOpt, ListViewGroup) = Function(u) If(LetterGroups.Count > 1, LetterGroups(u.Letter), Nothing)
Dim comparer As IComparer(Of UserOpt)
Select Case True
Case OPT_DATE.Checked : comparer = MyComparerDate
Case OPT_AMOUNT.Checked : comparer = MyComparerAmount
Case Else : comparer = MyComparerSize
End Select
DirectCast(comparer, ComparerDate).Order = IIf(OPT_ASC.Checked, SortOrder.Ascending, SortOrder.Descending)
MyUsers.Sort(comparer)
ControlInvokeFast(LIST_DATA, Sub()
Dim user As UserOpt
Dim gg As Boolean = CH_GROUP_COL.Checked
Dim colUsers As New Dictionary(Of String, List(Of UserOpt))
Dim colUsersNo As New List(Of UserOpt)
Dim lvi As ListViewItem
Dim s#
Dim sn$
For Each user In MyUsers
If gg And Not user.CollectionName.IsEmptyString Then
If colUsers.ContainsKey(user.CollectionName) Then
colUsers(user.CollectionName).Add(user)
Else
colUsers.Add(user.CollectionName, New List(Of UserOpt) From {user})
End If
Else
colUsersNo.Add(user)
End If
Next
If colUsers.Count > 0 Then
For Each kv As KeyValuePair(Of String, List(Of UserOpt)) In colUsers
sn = "Mb"
s = kv.Value.Sum(Function(v) v.TotalSize) / 1024 / 1024
If s > 1000 Then s /= 1024 : sn = "Gb"
lvi = New ListViewItem($"Collection: {kv.Key}: {s.RoundVal(2).NumToString(SizeNumberProvider)}{sn}") With {
.Tag = kv.Value(0),
.Name = Settings.GetUser(kv.Value(0).User, True).Key,
.Group = g(kv.Value(0))
}
LIST_DATA.Items.Add(lvi)
For Each user In kv.Value : LIST_DATA.Items.Add(user.GetLVI(g(user), gg)) : Next
Next
End If
If colUsersNo.Count > 0 Then
For Each user In colUsersNo : LIST_DATA.Items.Add(user.GetLVI(g(user), gg)) : Next
End If
COL_DEFAULT.Width = -2
End Sub, EDP.None)
End If
_RefillInProgress = False
End If
End Sub
#End Region
#Region "View"
Private Sub OPT_SORT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DATE.Click, OPT_SIZE.Click, OPT_AMOUNT.Click
If Not Sender.Checked Then
Sender.Checked = True
Else
Settings.UMetrics_What.Value = Sender.Tag
For Each obj As ToolStripMenuItem In {OPT_DATE, OPT_SIZE, OPT_AMOUNT}
If Not obj Is Sender Then obj.Checked = False
Next
RefillList()
End If
End Sub
Private Sub OPT_ASC_DESC_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_ASC.Click, OPT_DESC.Click
If Not Sender.Checked Then
Sender.Checked = True
Else
Settings.UMetrics_Order.Value = Sender.Tag
For Each obj As ToolStripMenuItem In {OPT_ASC, OPT_DESC}
If Not obj Is Sender Then obj.Checked = False
Next
RefillList()
End If
End Sub
Private Sub CH_GROUP_DRIVE_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles CH_GROUP_DRIVE.Click
LIST_DATA.ShowGroups = Sender.Checked
Settings.UMetrics_ShowDrives.Value = Sender.Checked
End Sub
Private Sub CH_GROUP_COL_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles CH_GROUP_COL.Click
Settings.UMetrics_ShowCollections.Value = Sender.Checked
RefillList()
End Sub
#End Region
#Region "Context handlers"
Private Function GetUserFromList() As UserOpt
Try
If LIST_DATA.SelectedItems.Count > 0 Then
Dim i As ListViewItem = LIST_DATA.SelectedItems(0)
If Not i Is Nothing Then Return i.Tag
End If
Catch ex As Exception
End Try
Return Nothing
End Function
Private Sub CONTEXT_BTT_FIND_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_FIND.Click
MainFrameObj.FocusUser(If(GetUserFromList()?.Key, String.Empty), True)
End Sub
Private Sub CONTEXT_BTT_INFO_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_INFO.Click
Dim info$ = If(GetUserFromList()?.GetInfornation(), String.Empty)
If Not info.IsEmptyString Then MsgBoxE({info, "User information"})
End Sub
Private Sub CONTEXT_BTT_OPEN_FOLDER_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_OPEN_FOLDER.Click
Dim u As UserOpt = GetUserFromList()
If Not u Is Nothing Then u.User.OpenFolder()
End Sub
Private Sub CONTEXT_BTT_OPEN_SITE_Click(sender As Object, e As EventArgs) Handles CONTEXT_BTT_OPEN_SITE.Click
Dim u As UserOpt = GetUserFromList()
If Not u Is Nothing Then u.User.OpenSite()
End Sub
#End Region
End Class
End Namespace

7
SCrawler/MainFrame.Designer.vb generated
View File

@@ -51,7 +51,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_EDIT_USER = New System.Windows.Forms.ToolStripButton()
Me.BTT_DELETE_USER = New System.Windows.Forms.ToolStripButton()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_SHOW_INFO = New System.Windows.Forms.ToolStripButton()
Me.BTT_SHOW_INFO = New PersonalUtilities.Forms.Controls.KeyClick.ToolStripButtonKeyClick()
Me.BTT_FEED = New System.Windows.Forms.ToolStripButton()
Me.BTT_CHANNELS = New System.Windows.Forms.ToolStripButton()
Me.BTT_DOWN_SAVED = New System.Windows.Forms.ToolStripButton()
@@ -327,8 +327,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_INFO.Name = "BTT_SHOW_INFO"
Me.BTT_SHOW_INFO.Size = New System.Drawing.Size(48, 22)
Me.BTT_SHOW_INFO.Text = "Info"
Me.BTT_SHOW_INFO.ToolTipText = "Left-click: open the 'Info' form (show download summary)." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Right click: open the " &
"'Missing' form (show information about missing posts)."
Me.BTT_SHOW_INFO.ToolTipText = resources.GetString("BTT_SHOW_INFO.ToolTipText")
'
'BTT_FEED
'
@@ -940,7 +939,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents BTT_CONTEXT_COL_MERGE As ToolStripMenuItem
Private WithEvents LBL_JOBS_COUNT As ToolStripStatusLabel
Private WithEvents BTT_DOWN_VIDEO As ToolStripMenuItem
Private WithEvents BTT_SHOW_INFO As ToolStripButton
Private WithEvents BTT_SHOW_INFO As PersonalUtilities.Forms.Controls.KeyClick.ToolStripButtonKeyClick
Private WithEvents BTT_CHANNELS As ToolStripButton
Private WithEvents LIST_PROFILES As ListView
Private WithEvents MENU_VIEW As ToolStripDropDownButton

5
SCrawler/MainFrame.resx
View File

@@ -183,6 +183,11 @@
<metadata name="Toolbar_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>132, 17</value>
</metadata>
<data name="BTT_SHOW_INFO.ToolTipText" xml:space="preserve">
<value>Left-click: open the 'Info' form (show download summary).
Right click: open the 'Missing' form (show information about missing posts).
Ctrl+Shift+Click: open the "User metrics' form (show information about the user's metrics (such as size, number of files, etc.)).</value>
</data>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="MENU_VIEW.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>

58
SCrawler/MainFrame.vb
View File

@@ -27,6 +27,7 @@ Public Class MainFrame
Private MyMissingPosts As MissingPostsForm
Private MyFeed As DownloadFeedForm
Private MySearch As UserSearchForm
Private MyUserMetrics As UsersInfoForm = Nothing
Private _UFinit As Boolean = True
#End Region
#Region "Initializer"
@@ -57,7 +58,7 @@ Public Class MainFrame
YouTube.MyCache = Settings.Cache
YouTube.MyYouTubeSettings = New YouTube.YTSettings_Internal
UpdateYouTubeSettings()
MainProgress = New Toolbars.MyProgress(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS, "Downloading profiles' data") With {
MainProgress = New MyProgressExt(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS, "Downloading profiles' data") With {
.ResetProgressOnMaximumChanges = False, .Visible = False}
Downloader = New TDownloader
InfoForm = New DownloadedInfoForm
@@ -158,6 +159,7 @@ Public Class MainFrame
VideoDownloader.DisposeIfReady()
MySavedPosts.DisposeIfReady()
MySearch.DisposeIfReady()
MyUserMetrics.DisposeIfReady()
MyView.Dispose(Settings.Design)
Settings.Dispose()
Else
@@ -401,12 +403,17 @@ CloseResume:
End Sub
#End Region
#Region "Info, Feed, Channels, Saved posts"
Private Sub BTT_SHOW_INFO_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_SHOW_INFO.MouseDown
If e.Button = MouseButtons.Right Then
Private Sub BTT_SHOW_INFO_KeyClick(ByVal Sender As Object, ByVal e As Controls.KeyClick.KeyClickEventArgs) Handles BTT_SHOW_INFO.KeyClick
If e.MouseButton = MouseButtons.Right Then
If MyMissingPosts Is Nothing Then MyMissingPosts = New MissingPostsForm
If MyMissingPosts.Visible Then MyMissingPosts.BringToFront() Else MyMissingPosts.Show()
ElseIf e.Button = MouseButtons.Left Then
InfoForm.FormShow()
ElseIf e.MouseButton = MouseButtons.Left Then
If e.Control And e.Shift Then
If MyUserMetrics Is Nothing Then MyUserMetrics = New UsersInfoForm
MyUserMetrics.FormShowS
Else
InfoForm.FormShow()
End If
End If
End Sub
Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click
@@ -1206,26 +1213,31 @@ CloseResume:
FocusUser(Key, True)
End Sub
Friend Overloads Sub FocusUser(ByVal Key As String, Optional ByVal ActivateMe As Boolean = False)
Dim a As Action = Sub()
Dim i% = LIST_PROFILES.Items.IndexOfKey(Key)
If i < 0 Then
Dim u As IUserData = Settings.GetUser(Key, True)
If Not u Is Nothing Then
UserListUpdate(u, True)
i = LIST_PROFILES.Items.IndexOfKey(u.Key)
If Not Key.IsEmptyString Then
Dim a As Action = Sub()
Dim i% = LIST_PROFILES.Items.IndexOfKey(Key)
If i < 0 Then
Dim u As IUserData = Settings.GetUser(Key, True)
If Not u Is Nothing Then
i = LIST_PROFILES.Items.IndexOfKey(u.Key)
If i < 0 Then
UserListUpdate(u, True)
i = LIST_PROFILES.Items.IndexOfKey(u.Key)
End If
End If
End If
End If
If i >= 0 Then
LIST_PROFILES.Select()
LIST_PROFILES.SelectedIndices.Clear()
With LIST_PROFILES.Items(i) : .Selected = True : .Focused = True : End With
LIST_PROFILES.EnsureVisible(i)
If ActivateMe Then
If Visible Then BringToFront() Else Visible = True
If i >= 0 Then
LIST_PROFILES.Select()
LIST_PROFILES.SelectedIndices.Clear()
With LIST_PROFILES.Items(i) : .Selected = True : .Focused = True : End With
LIST_PROFILES.EnsureVisible(i)
If ActivateMe Then
If Visible Then BringToFront() Else Visible = True
End If
End If
End If
End Sub
If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke
End Sub
If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke
End If
End Sub
#End Region
#Region "Toolbar bottom"

2
SCrawler/MainMod.vb
View File

@@ -90,7 +90,7 @@ Friend Module MainMod
End Sub
End Class
#End Region
Friend Property MainProgress As MyProgress
Friend Property MainProgress As MyProgressExt
Friend Function GetLviGroupName(ByVal Host As SettingsHost, ByVal IsCollection As Boolean) As ListViewGroup()
Dim l As New List(Of ListViewGroup)
Dim t$

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.4.28.0")>
<Assembly: AssemblyFileVersion("2023.4.28.0")>
<Assembly: AssemblyVersion("2023.5.12.0")>
<Assembly: AssemblyFileVersion("2023.5.12.0")>
<Assembly: NeutralResourcesLanguage("en")>

176
SCrawler/MyProgressExt.vb Normal file
View File

@@ -0,0 +1,176 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms.Toolbars
Friend Class PreProgress : Implements IDisposable
Private ReadOnly Progress As MyProgressExt = Nothing
Private ReadOnly ProgressExists As Boolean = False
Private ReadOnly Property Ready As Boolean
Get
Return ProgressExists And Not disposedValue
End Get
End Property
Friend Sub New(ByVal PR As MyProgress)
If Not PR Is Nothing AndAlso TypeOf PR Is MyProgressExt Then
Progress = PR
ProgressExists = True
End If
End Sub
Private _Maximum As Integer = 0
Friend Sub ChangeMax(ByVal Value As Integer, Optional ByVal Add As Boolean = True)
If Ready Then
If Add Then
_Maximum += Value
If Value > 0 Then Progress.Maximum0 += Value
Else
_Maximum = Value
Progress.Maximum0 = Value
End If
End If
End Sub
Private CumulVal As Integer = 0
Friend Sub Perform(Optional ByVal Value As Integer = 1)
If Ready Then
CumulVal += Value
Progress.Perform0(Value)
End If
End Sub
Friend Sub Reset()
_Maximum = 0
CumulVal = 0
End Sub
Friend Sub Done()
If Ready Then
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
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Done()
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
Friend Class MyProgressExt : Inherits MyProgress
Private ReadOnly _Progress0ChangedEventHandlers As List(Of EventHandler(Of ProgressEventArgs))
Friend Custom Event Progress0Changed As EventHandler(Of ProgressEventArgs)
AddHandler(ByVal h As EventHandler(Of ProgressEventArgs))
If Not _Progress0ChangedEventHandlers.Contains(h) Then _Progress0ChangedEventHandlers.Add(h)
End AddHandler
RemoveHandler(ByVal h As EventHandler(Of ProgressEventArgs))
_Progress0ChangedEventHandlers.Remove(h)
End RemoveHandler
RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If _Progress0ChangedEventHandlers.Count > 0 Then
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 Event
Private ReadOnly _Maximum0ChangedEventHandlers As List(Of EventHandler(Of ProgressEventArgs))
Friend Custom Event Maximum0Changed As EventHandler(Of ProgressEventArgs)
AddHandler(ByVal h As EventHandler(Of ProgressEventArgs))
If Not _Maximum0ChangedEventHandlers.Contains(h) Then _Maximum0ChangedEventHandlers.Add(h)
End AddHandler
RemoveHandler(ByVal h As EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers.Remove(h)
End RemoveHandler
RaiseEvent(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If _Maximum0ChangedEventHandlers.Count > 0 Then
Try
For i% = 0 To _Maximum0ChangedEventHandlers.Count - 1
Try : _Maximum0ChangedEventHandlers(i).Invoke(Sender, e) : Catch : End Try
Next
Catch
End Try
End If
End RaiseEvent
End Event
Friend Sub New()
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Friend Sub New(ByRef StatusStrip As StatusStrip, ByRef ProgressBar As ToolStripProgressBar, ByRef Label As ToolStripStatusLabel,
Optional ByVal Information As String = Nothing)
MyBase.New(StatusStrip, ProgressBar, Label, Information)
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Friend Sub New(ByRef ProgressBar As ProgressBar, ByRef Label As Label, Optional ByVal Information As String = Nothing)
MyBase.New(ProgressBar, Label, Information)
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Private _Maximum0 As Double = 0
Friend Property Maximum0 As Double
Get
Return _Maximum0
End Get
Set(ByVal v As Double)
Dim b As Boolean = Not _Maximum0 = v
_Maximum0 = v
If ResetProgressOnMaximumChanges Then Value0 = 0
If b Then RaiseEvent Maximum0Changed(Me, Nothing)
End Set
End Property
Friend Property Value0 As Double = 0
Friend Sub Perform0(Optional ByVal Value As Double = 1)
Value0 += Value
If Perform(0, 10, False, False) Then RaiseEvent Progress0Changed(Me, Nothing)
End Sub
Public Overloads Overrides Sub Perform(Optional ByVal Value As Double = 1)
If Perform(Value, PerformMod, True, True) Then OnProgressChanged()
End Sub
Public Overloads Function Perform(ByVal Value As Double, ByVal pm As Integer, ByVal SetText As Boolean, ByVal InvokeProgressChangeHandler As Boolean) As Boolean
Me.Value += Value
If Me.Value < 0 Then Me.Value = 0
Dim v# = Me.Value + Value0
Dim m# = Maximum + Maximum0
If pm = 0 OrElse (v Mod pm) = 0 OrElse v = m Then PerformImpl(GetPercentage(v, m), SetText, InvokeProgressChangeHandler) : Return True
Return False
End Function
Public Overrides Sub Done()
Value0 = Maximum0
MyBase.Done()
End Sub
Public Overrides Sub Reset()
MyBase.Reset()
Value0 = 0
Maximum0 = 0
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then
_Progress0ChangedEventHandlers.Clear()
_Maximum0ChangedEventHandlers.Clear()
End If
MyBase.Dispose(disposing)
End Sub
End Class

8
SCrawler/PluginsEnvironment/Hosts/UserDataHost.vb
View File

@@ -27,6 +27,8 @@ Namespace Plugin.Hosts
UseInternalDownloader = Not ExternalPlugin.GetType.GetCustomAttribute(Of Attributes.UseInternalDownloader)() Is Nothing
AddHandler ExternalPlugin.ProgressChanged, AddressOf ExternalPlugin_ProgressChanged
AddHandler ExternalPlugin.ProgressMaximumChanged, AddressOf ExternalPlugin_ProgressMaximumChanged
AddHandler ExternalPlugin.ProgressPreChanged, AddressOf ExternalPlugin_Progress0Changed
AddHandler ExternalPlugin.ProgressPreMaximumChanged, AddressOf ExternalPlugin_Progress0MaximumChanged
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
@@ -111,6 +113,12 @@ Namespace Plugin.Hosts
Private Sub ExternalPlugin_ProgressMaximumChanged(ByVal Value As Integer, ByVal Add As Boolean)
Progress.Maximum = Value + If(Add, Progress.Maximum, 0)
End Sub
Private Sub ExternalPlugin_Progress0Changed(ByVal Value As Integer)
ProgressPre.Perform(Value)
End Sub
Private Sub ExternalPlugin_Progress0MaximumChanged(ByVal Value As Integer, ByVal Add As Boolean)
ProgressPre.ChangeMax(Value, Add)
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing And Not disposedValue Then
With ExternalPlugin

11
SCrawler/SCrawler.vbproj
View File

@@ -224,6 +224,7 @@
<Compile Include="API\YouTube\SiteSettings.vb" />
<Compile Include="API\YouTube\UserData.vb" />
<Compile Include="API\YouTube\UserExchangeOptions.vb" />
<Compile Include="API\YouTube\YTPreProgress.vb" />
<Compile Include="API\YouTube\YTSettings_Internal.vb" />
<Compile Include="Download\ActiveDownloadingProgress.Designer.vb">
<DependentUpon>ActiveDownloadingProgress.vb</DependentUpon>
@@ -309,6 +310,12 @@
<Compile Include="Editors\ColorPicker.vb">
<SubType>UserControl</SubType>
</Compile>
<Compile Include="Editors\UsersInfoForm.Designer.vb">
<DependentUpon>UsersInfoForm.vb</DependentUpon>
</Compile>
<Compile Include="Editors\UsersInfoForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="GlobalSuppressions.vb" />
<Compile Include="MainFrameObjects.vb" />
<Compile Include="My Project\Resources.Designer.vb">
@@ -316,6 +323,7 @@
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="MyProgressExt.vb" />
<Compile Include="PluginsEnvironment\Attributes\Attributes.vb" />
<Compile Include="PluginsEnvironment\Hosts\DownloadableMediaHost.vb" />
<Compile Include="PluginsEnvironment\Hosts\UserDataHost.vb" />
@@ -523,6 +531,9 @@
<EmbeddedResource Include="Editors\UserCreatorForm.resx">
<DependentUpon>UserCreatorForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Editors\UsersInfoForm.resx">
<DependentUpon>UsersInfoForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="MainFrame.resx">
<DependentUpon>MainFrame.vb</DependentUpon>
</EmbeddedResource>

18
SCrawler/SettingsCLS.vb
View File

@@ -140,6 +140,12 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
SearchInDescription = New XMLValue(Of Boolean)("SearchInDescription", False, MyXML, n)
SearchInLabel = New XMLValue(Of Boolean)("SearchInLabel", False, MyXML, n)
n = {"Metrics"}
UMetrics_What = New XMLValue(Of Integer)("What", -1, MyXML, n)
UMetrics_Order = New XMLValue(Of Integer)("Order", SortOrder.Descending, MyXML, n)
UMetrics_ShowDrives = New XMLValue(Of Boolean)("ShowDrives", True, MyXML, n)
UMetrics_ShowCollections = New XMLValue(Of Boolean)("ShowCollections", True, MyXML, n)
n = {"Defaults"}
DefaultTemporary = New XMLValue(Of Boolean)("Temporary", False, MyXML, n)
DefaultDownloadImages = New XMLValue(Of Boolean)("DownloadImages", True, MyXML, n)
@@ -310,7 +316,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End Using
Dim NeedUpdate As Boolean = False
Dim i%, indx% ', c%
Dim i%, indx%
Dim UsersListInitialCount% = UsersList.Count
Dim iUser As UserInfo
Dim userFileExists As Boolean, pluginFound As Boolean
@@ -349,9 +355,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End If
'Check paths
'c = IIf((Not .IncludedInCollection Or (.Merged Or .IsVirtual)) And Not .Plugin = PathPlugin.PluginKey, 1, 2)
'URGENT: changed user file validation
userFileExists = .File.Exists ' SFile.GetPath(.File.CutPath(c - 1).Path).Exists(SFO.Path, False)
userFileExists = .File.Exists
If Not pluginFound Or Not userFileExists Then
If Not .IsProtected Then
If userFileExists Then
@@ -705,6 +709,12 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property STDownloader_RemoveYTVideosOnClear As XMLValue(Of Boolean)
Friend ReadOnly Property STDownloader_LoadYTVideos As XMLValue(Of Boolean)
#End Region
#Region "User metrics"
Friend ReadOnly Property UMetrics_What As XMLValue(Of Integer)
Friend ReadOnly Property UMetrics_Order As XMLValue(Of Integer)
Friend ReadOnly Property UMetrics_ShowDrives As XMLValue(Of Boolean)
Friend ReadOnly Property UMetrics_ShowCollections As XMLValue(Of Boolean)
#End Region
#Region "User data"
Friend ReadOnly Property FromChannelDownloadTop As XMLValue(Of Integer)
Friend ReadOnly Property FromChannelDownloadTopUse As XMLValue(Of Boolean)