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

2022.9.24.0

Browse Source 
Fixed wrong image opening in Autodownloader
Fixed incorrect feed grid resizing when removing media
Fixed incorrect removal of users from the collection
Fixed Instagram function displaying number of requests: wrong value type.
Fixed XVIDEOS cycle bug
Collection: add multiple users
Collection: new collections at the top
Copying user data
Feed: 'Season' and 'Date' to the post title.
This commit is contained in:
Andy
2022-09-24 20:26:40 +03:00
parent a3e79eb4bc
commit 129558c262
42 changed files with 499 additions and 147 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
Changelog.md
View File

@@ -1,3 +1,21 @@
# 2022.9.24.0
*2022-09-24*
- Added
- Ability to copy user data to another destination
- Ability to add 'Session' and 'Date' values to the post title in the feed
- Minor feed improvements
- The newly created collection will now appear at the top of the list (after reopening the form)
- Ability to add multiple users at a time to the collection.
- Fixed
- Autodownloader opens a compressed image instead of a full one
- Incorrect resizing of the feed grid after deleting a media file
- Incorrect behavior when deleting/removing a user from a collection.
- An incorrect function that displayed the number of spent Instagram requests.
- Bug in the XVIDEOS downloader
- Minor bugs
# 2022.9.17.0
*2022-09-17*

BIN
ProgramScreenshots/MainContext.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 13 KiB

BIN
ProgramScreenshots/MainWindow.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 370 KiB

After

Width:  |  Height:  |  Size: 370 KiB

BIN
ProgramScreenshots/MainWindow2.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 379 KiB

After

Width:  |  Height:  |  Size: 381 KiB

BIN
ProgramScreenshots/SettingsGlobalDownloading.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 15 KiB

BIN
ProgramScreenshots/SettingsGlobalFeed.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 8.5 KiB

After

Width:  |  Height:  |  Size: 10 KiB

BIN
ProgramScreenshots/SettingsSiteInstagram.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 27 KiB

BIN
ProgramScreenshots/SettingsSiteRedGifs.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 13 KiB

BIN
ProgramScreenshots/SettingsSiteReddit.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 14 KiB

BIN
ProgramScreenshots/SettingsSiteTwitter.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 15 KiB

After

Width:  |  Height:  |  Size: 16 KiB

2
README.md
View File

@@ -8,6 +8,8 @@
A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram).
**If you like SCrawler, please like the program on [this site]( https://alternativeto.net/software/scrawler/about/)**
Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
[![ko-fi](https://www.ko-fi.com/img/githubbutton_sm.svg)](https://ko-fi.com/andyprogram)

4
SCrawler.Plugin.XVIDEOS/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("2022.9.17.0")>
<Assembly: AssemblyFileVersion("2022.9.17.0")>
<Assembly: AssemblyVersion("2022.9.24.0")>
<Assembly: AssemblyFileVersion("2022.9.24.0")>
<Assembly: NeutralResourcesLanguage("en")>

4
SCrawler.Plugin.XVIDEOS/SettingsForm.vb
View File

@@ -35,7 +35,7 @@ Public Class SettingsForm
Settings.UpdateDomains()
MyDefs.CloseForm()
End Sub
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Dim nd$ = InputBoxE("Enter a new domain using the pattern [xvideos.com]:", "New domain")
If Not nd.IsEmptyString Then
If Not LIST_DOMAINS.Items.Contains(nd) Then
@@ -45,7 +45,7 @@ Public Class SettingsForm
End If
End If
End Sub
Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
If _LatestSelected.ValueBetween(0, LIST_DOMAINS.Items.Count - 1) Then
Dim n$ = LIST_DOMAINS.Items(_LatestSelected)
If MsgBoxE({$"Are you sure you want to delete the [{n}] domain?", "Removing domains"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then

10
SCrawler.Plugin.XVIDEOS/UserData.vb
View File

@@ -71,7 +71,7 @@ Public Class UserData : Implements IPluginContentProvider
Dim NextPage% = 0
Dim r$
Dim j As EContainer, jj As EContainer
Dim jj As EContainer
Dim e As ErrorsDescriber = EDP.ThrowException
Dim user$ = Settings.GetUserUrl(Name, False)
Dim p As PluginUserMedia
@@ -82,8 +82,7 @@ Public Class UserData : Implements IPluginContentProvider
r = Responser.GetResponse($"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}",, e)
If Not r.IsEmptyString Then
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
j = JsonDocument.Parse(r).XmlIfNothing
With j
With JsonDocument.Parse(r).XmlIfNothing
If .Contains("videos") Then
With .Item("videos")
If .Count > 0 Then
@@ -94,9 +93,12 @@ Public Class UserData : Implements IPluginContentProvider
.URL = $"https://www.xvideos.com{jj.Value("u")}"
}
If Not p.PostID.IsEmptyString And Not jj.Value("u").IsEmptyString Then
If Not TempPostsList.Contains(p.PostID) Then TempPostsList.Add(p.PostID) : TempMediaList.Add(p) Else Exit Do
If Not TempPostsList.Contains(p.PostID) Then TempPostsList.Add(p.PostID) : TempMediaList.Add(p) Else .Dispose() : Exit Do
End If
Next
Else
.Dispose()
Exit Do
End If
End With
Else

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

@@ -879,6 +879,7 @@ BlockNullPicture:
DownloadDataF(Token)
ThrowAny(Token)
Else
'PENDING: UserDataBase ReparseMissing (DownloadDataF)
'ReparseMissing(Token)
End If
'_TempMediaList.ListAddList(ContentMissing, LNC)
@@ -1100,14 +1101,14 @@ BlockNullPicture:
End Try
End Sub
#End Region
#Region "Delete, Move, Merge"
#Region "Delete, Move, Merge, Copy"
Friend Overridable Function Delete() As Integer Implements IUserData.Delete
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
MainFrameObj.ImageHandler(Me, False)
If Not IncludedInCollection Then MainFrameObj.ImageHandler(Me, False)
Settings.UsersList.Remove(User)
Settings.UpdateUsersList()
Settings.Users.Remove(Me)
If Not IncludedInCollection Then Settings.Users.Remove(Me)
Downloader.UserRemove(Me)
Dispose(True)
Return 1
@@ -1224,6 +1225,48 @@ BlockNullPicture:
End If
Return f
End Function
Private Class FilesCopyingException : Inherits ErrorsDescriberException
Friend Sub New(ByVal User As IUserData, ByVal Msg As String, ByVal Path As SFile)
SendInLogOnlyMessage = True
If User.IncludedInCollection Then _MainMessage = $"[{User.CollectionName}] - "
_MainMessage &= $"[{User.Site}] - [{User.Name}]. {Msg}: {Path.Path}."
End Sub
End Class
Friend Overridable Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements IUserData.CopyFiles
Dim fSource As SFile = Nothing
Dim fDest As SFile = Nothing
Try
Dim pOffset%
If IncludedInCollection Then
If DataMerging Then pOffset = 1 Else pOffset = 2
Else
pOffset = 1
End If
fSource = User.File.CutPath(pOffset).Path.CSFileP
Dim OptPath$ = String.Empty
If IncludedInCollection Then
OptPath = $"Collections\{CollectionName}" 'Copying a collection based on the first file
Else
OptPath = $"{Site}\{Name}"
End If
fDest = $"{DestinationPath.PathWithSeparator}{OptPath}".CSFileP
If fDest.Exists(SFO.Path, False) AndAlso MsgBoxE({$"The following path already exists:{vbCr}{fDest.Path}" & vbCr &
"Do you want to copy files here?", "Copying files"}, vbExclamation + vbYesNo) = vbNo Then _
Throw New FilesCopyingException(Me, "The following path already exists", fDest)
If DestinationPath.Exists(SFO.Path, True) Then
My.Computer.FileSystem.CopyDirectory(fSource, fDest, FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.ThrowException)
Else
Throw New FilesCopyingException(Me, "Cannot create the following path", fDest)
End If
Return True
Catch cex As OperationCanceledException
Return ErrorsDescriber.Execute(e, New FilesCopyingException(Me, "Copy canceled", fDest),, False)
Catch ex As Exception
Return ErrorsDescriber.Execute(e, ex,, False)
End Try
End Function
#End Region
#Region "Errors functions"
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String)
@@ -1398,6 +1441,7 @@ BlockNullPicture:
''' </summary>
Function Delete() As Integer
Function MoveFiles(ByVal CollectionName As String) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder()
ReadOnly Property Self As IUserData
Property DownloadTopCount As Integer?

2
SCrawler/API/Instagram/SiteSettings.vb
View File

@@ -233,7 +233,7 @@ Namespace API.Instagram
LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n)
LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n)
LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value))
AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(__value)
AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(__value, Existable(Of Integer)).Value)
UrlPatternUser = "https://www.instagram.com/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)

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

@@ -150,6 +150,7 @@ Namespace API.Reddit
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
'PENDING: Reddit ReparseMissing (DownloadDataF)
'If Not IsSavedPosts AndAlso (Not IsChannel OrElse ChannelInfo Is Nothing) Then ReparseMissing(Token)
If IsSavedPosts Then
DownloadDataChannel(String.Empty, Token)
@@ -376,6 +377,7 @@ Namespace API.Reddit
ElseIf Not s.Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
tmpUrl = s.Value({"media", "reddit_video"}, "fallback_url")
If SaveToCache Then
'TODELETE: Reddit thumbnail -> GetVideoRedditPreview
'tmpUrl = s.Value("thumbnail")
tmpUrl = GetVideoRedditPreview(s)
If Not tmpUrl.IsEmptyString Then

1
SCrawler/API/Redgifs/SiteSettings.vb
View File

@@ -39,6 +39,7 @@ Namespace API.RedGifs
Return $"https://www.redgifs.com/watch/{PostID}"
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
'PENDING: RedGifs SiteSettings Available FALSE
Return False
End Function
End Class

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

@@ -34,6 +34,7 @@ Namespace API.Twitter
Else
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData(String.Empty, Token)
'PENDING: Twitter ReparseMissing (DownloadDataF)
'ReparseMissing(Token)
End If
End Sub
@@ -101,6 +102,7 @@ Namespace API.Twitter
If IsSavedPosts OrElse Not ParseUserMediaOnly OrElse (Not nn.Contains("retweeted_status") OrElse
(Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then
'TODELETE: Twitter ObtainMedia
'If Not CheckVideoNode(nn, PostID, PostDate) Then
' s = nn.ItemF({"extended_entities", "media"})
' If s Is Nothing OrElse s.Count = 0 Then s = nn.ItemF({"retweeted_status", "extended_entities", "media"})
@@ -161,6 +163,7 @@ Namespace API.Twitter
End If
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
'PENDING: Twitter ReparseMissing verify
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Try

33
SCrawler/API/UserDataBind.vb
View File

@@ -346,6 +346,14 @@ Namespace API
Return False
End Get
End Property
Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo
Throw New NotImplementedException("[CopyTo] method does not supported in collections context")
End Sub
Friend Sub Clear() Implements ICollection(Of IUserData).Clear
Collections.ListClearDispose
End Sub
#End Region
#Region "Add"
''' <exception cref="InvalidOperationException"></exception>
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
With _Item
@@ -413,6 +421,8 @@ Namespace API
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
End If
End Sub
#End Region
#Region "Move, Merge"
Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean
Throw New NotImplementedException("Move files is not available in the collection context")
End Function
@@ -440,15 +450,8 @@ Namespace API
End If
End If
End Sub
Friend Sub Clear() Implements ICollection(Of IUserData).Clear
Collections.ListClearDispose
End Sub
Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains
Return Count > 0 AndAlso Collections.Contains(_Item)
End Function
Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo
Throw New NotImplementedException("[CopyTo] method does not supported in collections context")
End Sub
#End Region
#Region "Remove, Delete"
Friend Function Remove(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Remove
If DataMerging Then
MsgBoxE($"Collection [{CollectionName}] data is already merged" & vbCr &
@@ -547,6 +550,17 @@ Namespace API
End If
End With
End Sub
#End Region
#Region "Copy"
Friend Overrides Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Return Count > 0 AndAlso Collections(0).CopyFiles(DestinationPath, e)
End Function
#End Region
#Region "Contains"
Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains
Return Count > 0 AndAlso Collections.Contains(_Item)
End Function
#End Region
#Region "IEnumerable Support"
Private Function GetEnumerator() As IEnumerator(Of IUserData) Implements IEnumerable(Of IUserData).GetEnumerator
Return New MyEnumerator(Of IUserData)(Me)
@@ -554,7 +568,6 @@ Namespace API
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
#End Region
#End Region
Friend Overrides Function Equals(ByVal Other As UserDataBase) As Boolean
If Other.IsCollection Then

BIN
SCrawler/Content/Pictures/PastePic32.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.9 KiB

4
SCrawler/Download/AutoDownloader.vb
View File

@@ -84,12 +84,14 @@ Namespace DownloadObjects
Using Notify As New Notification(Text, Title) With {.Key = Key}
Dim uPic As SFile = Nothing
Dim uif As SFile = Nothing
Dim uif_orig As SFile = Nothing
Dim uif_compressed As SFile = Nothing
Dim uifKey$ = String.Empty
If AutoDownloaderSource.ShowPictureUser Then uPic = DirectCast(User, UserDataBase).GetUserPictureToastAddress
If AutoDownloaderSource.ShowPictureUser AndAlso uPic.Exists Then Notify.Images = {New ToastImage(uPic)}
If AutoDownloaderSource.ShowPictureDownloaded And User.DownloadedPictures(False) > 0 Then
uif = DirectCast(User, UserDataBase).GetLastImageAddress
uif_orig = uif
If uif.Exists Then
uif_compressed = uif
uif_compressed.Path = CachePath.Path
@@ -101,7 +103,7 @@ Namespace DownloadObjects
If uif.Exists Then
Notify.Images = {New ToastImage(uif, IImage.Modes.Inline)}
uifKey = $"{Key}_{Images.Keys.Count + 1}_{KeyBttPhoto}"
If Not Images.ContainsKey(uifKey) Then Images.Add(uifKey, uif)
If Not Images.ContainsKey(uifKey) Then Images.Add(uifKey, uif_orig)
End If
End If
End If

87
SCrawler/Download/DownloadFeedForm.vb
View File

@@ -23,6 +23,7 @@ Namespace DownloadObjects
Private DataRows As Integer = 10
Private DataColumns As Integer = 1
Private FeedEndless As Boolean = False
Private ReadOnly FileNotExist As Predicate(Of UserMediaD) = Function(d) Not d.Data.File.Exists
#End Region
#Region "Initializer"
Friend Sub New()
@@ -112,6 +113,7 @@ Namespace DownloadObjects
End Sub
Private Sub RefillList() Handles BTT_REFRESH.Click
DataPopulated = False
Try : Downloader.Files.RemoveAll(FileNotExist) : Catch : End Try
DataList.ListAddList(Downloader.Files, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
MyRange.Source = DataList
ControlInvoke(ToolbarTOP, LBL_FILES, Sub() LBL_FILES.Text = String.Empty)
@@ -128,7 +130,7 @@ Namespace DownloadObjects
RefillList()
End Sub
#End Region
#Region "Data"
#Region "Delete"
Private Sub BTT_DELETE_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_DELETE_SELECTED.Click
Const MsgTitle$ = "Deleting marked files"
Try
@@ -139,25 +141,18 @@ Namespace DownloadObjects
Dim d% = 0
ControlInvoke(TP_DATA, Sub()
With TP_DATA
.SuspendLayout()
For Each fm As FeedMedia In c
If fm.DeleteFile(True) Then
d += 1
DataList.RemoveAll(Function(dd) dd.Data.File = fm.File)
TPRemoveControl(fm, False)
End If
Next
.ResumeLayout(True)
End With
End Sub)
If d > 0 Then
If DataList.Count > 0 Then
MyRange.HandlersSuspended = True
MyRange.Source = DataList
If indx.ValueBetween(0, MyRange.Count - 1) Then MyRange.CurrentIndex = indx
MyRange.HandlersSuspended = False
DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged()
Else
RefillList()
End If
End If
If d > 0 Then RefillAfterDelete()
MsgBoxE({$"{d}/{c.Count} file(s) deleted", MsgTitle})
Else
MsgBoxE({"Operation canceled", MsgTitle})
@@ -169,6 +164,59 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, MsgTitle)
End Try
End Sub
Private Sub FeedMedia_MediaDeleted(ByVal Sender As FeedMedia)
Try
ControlInvoke(TP_DATA, Sub() TPRemoveControl(Sender, True))
DataList.RemoveAll(Function(dd) dd.Data.File = Sender.File)
RefillAfterDelete()
Catch
End Try
End Sub
Private Sub TPRemoveControl(ByVal CNT As FeedMedia, ByVal Suspend As Boolean)
Try
If Suspend Then TP_DATA.SuspendLayout()
Dim p As TableLayoutPanelCellPosition = TP_DATA.GetCellPosition(CNT)
Dim HeightChanged As Boolean = False
TP_DATA.Controls.Remove(CNT)
CNT.Dispose()
If DataColumns = 1 Then
If p.Column >= 0 And p.Row >= 0 Then TP_DATA.RowStyles(p.Row).Height = 0 : HeightChanged = True
Else
If p.Row.ValueBetween(0, TP_DATA.RowStyles.Count - 1) And p.Column.ValueBetween(0, TP_DATA.ColumnStyles.Count - 1) Then
Dim found As Boolean = False
For i% = 0 To TP_DATA.ColumnStyles.Count - 1
If Not TP_DATA.GetControlFromPosition(i, p.Row) Is Nothing Then found = True : Exit For
Next
If Not found Then TP_DATA.RowStyles(p.Row).Height = 0 : HeightChanged = True
End If
End If
If HeightChanged Then TP_DATA.AutoScroll = False : TP_DATA.AutoScroll = True
Catch
Finally
If Suspend Then TP_DATA.ResumeLayout(True)
End Try
End Sub
Private Sub RefillAfterDelete()
If ControlInvoke(TP_DATA, Function() TP_DATA.Controls.Count) = 0 Then
With MyRange
Dim indx% = .CurrentIndex
.HandlersSuspended = True
.Source = DataList
If .Count > 0 Then
If indx.ValueBetween(0, .Count - 1) Then
.CurrentIndex = indx
ElseIf (indx - 1).ValueBetween(0, .Count - 1) Then
.CurrentIndex = indx - 1
Else
.CurrentIndex = .Count - 1
End If
.HandlersSuspended = False
DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged()
End If
.HandlersSuspended = False
End With
End If
End Sub
#End Region
#Region "Range"
Private DataPopulated As Boolean = False
@@ -205,6 +253,19 @@ Namespace DownloadObjects
Dim d As List(Of UserMediaD) = MyRange.Current
Dim d2 As List(Of UserMediaD)
Dim i%
If d.ListExists And d.All(Function(md) FileNotExist(md)) Then
i = Sender.CurrentIndex
Sender.HandlersSuspended = True
RefillList()
If Sender.Count > 0 Then
If i.ValueBetween(0, Sender.Count - 1) Then Sender.CurrentIndex = i
Sender.HandlersSuspended = False
End If
RefillInProgress = False
Sender.HandlersSuspended = False
DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged()
Exit Sub
End If
If d.ListExists Then
ClearTable()
If Sender.CurrentIndex > 0 And FeedEndless Then
@@ -214,7 +275,7 @@ Namespace DownloadObjects
Dim w% = GetWidth()
Dim p As New TPCELL(DataRows, DataColumns)
Dim fmList As New List(Of FeedMedia)
d.ForEach(Sub(de) fmList.Add(New FeedMedia(de, w)))
d.ForEach(Sub(de) fmList.Add(New FeedMedia(de, w, AddressOf FeedMedia_MediaDeleted)))
If fmList.Count > 0 Then fmList.ListDisposeRemoveAll(Function(fm) fm Is Nothing OrElse fm.HasError)
If fmList.Count > 0 Then
For i = 0 To fmList.Count - 1

17
SCrawler/Download/FeedMedia.vb
View File

@@ -16,6 +16,7 @@ Namespace DownloadObjects
<ToolboxItem(False), DesignTimeVisible(False)>
Public Class FeedMedia
#Region "Declarations"
Friend Event MediaDeleted(ByVal Sender As Object)
Private Const VideoHeight As Integer = 450
Private WithEvents MyPicture As PictureBox
Private ReadOnly MyImage As ImageRenderer
@@ -64,7 +65,7 @@ Namespace DownloadObjects
Public Sub New()
InitializeComponent()
End Sub
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer)
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Handler As MediaDeletedEventHandler)
Try
InitializeComponent()
File = Media.Data.File
@@ -131,12 +132,16 @@ Namespace DownloadObjects
End With
End If
If Settings.FeedAddSessionToCaption Then info = $"[{Media.Session}] {info}"
If Settings.FeedAddDateToCaption Then info &= $" ({Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)})"
LBL_INFO.Text = info
'TT_MAIN.SetToolTip(LBL_INFO, Information)
s = New Size(Width, h + TP_MAIN.RowStyles(0).Height + PaddingE.GetOf({TP_MAIN}).Vertical(2))
Size = s
MinimumSize = s
MaximumSize = s
If Not Handler Is Nothing Then AddHandler Me.MediaDeleted, Handler
Else
Throw New ArgumentNullException With {.HelpLink = 1}
End If
@@ -158,6 +163,9 @@ Namespace DownloadObjects
End Sub
#End Region
#Region "LBL"
Private Sub LBL_INFO_MouseClick(sender As Object, e As MouseEventArgs) Handles LBL_INFO.MouseClick
If e.Button = MouseButtons.Left Then ControlInvoke(CH_CHECKED, Sub() CH_CHECKED.Checked = Not CH_CHECKED.Checked)
End Sub
Private Sub LBL_INFO_DoubleClick(sender As Object, e As EventArgs) Handles LBL_INFO.DoubleClick
If Not UserKey.IsEmptyString Then
Dim u As IUserData = Settings.GetUser(UserKey)
@@ -214,11 +222,10 @@ Namespace DownloadObjects
Const msgTitle$ = "Deleting a file"
Try
If Silent OrElse MsgBoxE({$"Are you sure you want to delete the [{File.File}] file?{vbCr}{File}", msgTitle}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
If Not MyVideo Is Nothing Then MyVideo.Stop()
If File.Delete(SFO.File, Settings.DeleteMode, EDP.ThrowException) Then
If Not Silent Then MsgBoxE({"File deleted", msgTitle})
If Not Silent Then RaiseEvent MediaDeleted(Me) : MsgBoxE({"File deleted", msgTitle})
LBL_INFO.Height = 0
If Not MyPicture Is Nothing Then MyPicture.Size = New Size(0, 0)
If Not MyVideo Is Nothing Then MyVideo.MinimumSize = New Size(0, 0) : MyVideo.Size = New Size(0, 0)
Height = 0
Return True
End If

2
SCrawler/Download/FeedVideo.vb
View File

@@ -76,7 +76,7 @@ Namespace DownloadObjects
Try : MediaPlayer.Pause() : Catch : End Try
UpdateButtons()
End Sub
Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click
Friend Sub [Stop]() Handles BTT_STOP.Click
Try : MediaPlayer.Stop() : Catch : End Try
UpdateButtons()
End Sub

4
SCrawler/Download/SchedulerEditorForm.vb
View File

@@ -53,7 +53,7 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendInLog, ex)
End Try
End Sub
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Dim a As New AutoDownloader(True)
Using f As New AutoDownloaderEditorForm(a)
f.ShowDialog()
@@ -74,7 +74,7 @@ Namespace DownloadObjects
End If
End Sub
Private _DeleteInProgress As Boolean = False
Private Async Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
Private Async Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
If Not _DeleteInProgress Then
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
_DeleteInProgress = True

2
SCrawler/Download/TDownloader.vb
View File

@@ -27,7 +27,7 @@ Namespace DownloadObjects
Friend ReadOnly User As IUserData
Friend ReadOnly Data As UserMedia
Friend ReadOnly [Date] As Date
Private ReadOnly Session As Integer
Friend ReadOnly Session As Integer
Friend Sub New(ByVal Data As UserMedia, ByVal User As IUserData, ByVal Session As Integer)
Me.Data = Data
Me.User = User

10
SCrawler/Download/VideosDownloaderForm.vb
View File

@@ -109,15 +109,15 @@ Namespace DownloadObjects
StartDownloading()
End Sub
Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click
SetControlValueInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False)
ControlInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False)
MyJob.Stop()
End Sub
#End Region
#Region "Downloading"
Private Sub StartDownloading()
If Not MyJob.Working And MyJob.Count > 0 Then
SetControlValueInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = False)
SetControlValueInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = True)
ControlInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = False)
ControlInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = True)
MyJob.Start(AddressOf DownloadVideos, Threading.ApartmentState.STA)
End If
End Sub
@@ -137,8 +137,8 @@ Namespace DownloadObjects
RefillList()
MyJob.Progress.Visible = False
End If
SetControlValueInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = True)
SetControlValueInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False)
ControlInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = True)
ControlInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False)
MyJob.Stopped()
End Sub
#End Region

20
SCrawler/Editors/CollectionEditorForm.Designer.vb generated
View File

@@ -15,9 +15,9 @@
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(CollectionEditorForm))
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.CMB_COLLECTIONS = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
@@ -44,14 +44,14 @@
'
'CMB_COLLECTIONS
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Add"
ActionButton3.ToolTipText = "Add new collection"
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "ArrowDown"
ActionButton4.Visible = False
Me.CMB_COLLECTIONS.Buttons.Add(ActionButton3)
Me.CMB_COLLECTIONS.Buttons.Add(ActionButton4)
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Add"
ActionButton1.ToolTipText = "Add new collection"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "ArrowDown"
ActionButton2.Visible = False
Me.CMB_COLLECTIONS.Buttons.Add(ActionButton1)
Me.CMB_COLLECTIONS.Buttons.Add(ActionButton2)
Me.CMB_COLLECTIONS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_COLLECTIONS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_COLLECTIONS.Location = New System.Drawing.Point(2, 0)

4
SCrawler/Editors/CollectionEditorForm.resx
View File

@@ -121,7 +121,7 @@
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAADmUlE
@@ -143,7 +143,7 @@
0AUyNxOP1DOwcaG/8I+/LRB+At7psBnyDBG0AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL

5
SCrawler/Editors/CollectionEditorForm.vb
View File

@@ -27,6 +27,7 @@ Namespace Editors
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
Collections.ListAddList(Settings.LastCollections)
Collections.ListAddList((From c In Settings.Users Where c.IsCollection Select c.CollectionName), LAP.NotContainsOnly, EDP.ThrowException)
If Collections.ListExists Then Collections.Sort() : CMB_COLLECTIONS.Items.AddRange(From c In Collections Select New ListItem(c))
If Not Collection.IsEmptyString And Collections.Contains(Collection) Then CMB_COLLECTIONS.SelectedIndex = Collections.IndexOf(Collection)
@@ -46,6 +47,10 @@ Namespace Editors
Private Sub MyDefs_ButtonOkClick() Handles MyDefs.ButtonOkClick
If CMB_COLLECTIONS.SelectedIndex >= 0 Then
Collection = CMB_COLLECTIONS.Value.ToString
With Settings.LastCollections
If .Contains(Collection) Then .Remove(Collection)
If .Count = 0 Then .Add(Collection) Else .Insert(0, Collection)
End With
MyDefs.CloseForm()
Else
MsgBoxE("Collection not selected", MsgBoxStyle.Exclamation)

37
SCrawler/Editors/GlobalSettingsForm.Designer.vb generated
View File

@@ -95,6 +95,8 @@
Me.TXT_FEED_ROWS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FEED_COLUMNS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_FEED_ENDLESS = New System.Windows.Forms.CheckBox()
Me.CH_FEED_ADD_SESSION = New System.Windows.Forms.CheckBox()
Me.CH_FEED_ADD_DATE = New System.Windows.Forms.CheckBox()
Me.TAB_MAIN = New System.Windows.Forms.TabControl()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_BASIS = New System.Windows.Forms.TableLayoutPanel()
@@ -1091,14 +1093,17 @@
TP_FEED.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FEED.Controls.Add(TP_FEED_IMG_COUNT, 0, 0)
TP_FEED.Controls.Add(Me.CH_FEED_ENDLESS, 0, 1)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_SESSION, 0, 2)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_DATE, 0, 3)
TP_FEED.Dock = System.Windows.Forms.DockStyle.Fill
TP_FEED.Location = New System.Drawing.Point(0, 0)
TP_FEED.Name = "TP_FEED"
TP_FEED.RowCount = 3
TP_FEED.RowCount = 5
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_FEED.Size = New System.Drawing.Size(576, 284)
TP_FEED.TabIndex = 0
'
@@ -1117,7 +1122,7 @@
TP_FEED_IMG_COUNT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FEED_IMG_COUNT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED_IMG_COUNT.Size = New System.Drawing.Size(574, 28)
TP_FEED_IMG_COUNT.TabIndex = 1
TP_FEED_IMG_COUNT.TabIndex = 0
'
'TXT_FEED_ROWS
'
@@ -1158,10 +1163,32 @@
Me.CH_FEED_ENDLESS.Location = New System.Drawing.Point(4, 33)
Me.CH_FEED_ENDLESS.Name = "CH_FEED_ENDLESS"
Me.CH_FEED_ENDLESS.Size = New System.Drawing.Size(568, 19)
Me.CH_FEED_ENDLESS.TabIndex = 3
Me.CH_FEED_ENDLESS.TabIndex = 1
Me.CH_FEED_ENDLESS.Text = "Endless feed"
Me.CH_FEED_ENDLESS.UseVisualStyleBackColor = True
'
'CH_FEED_ADD_SESSION
'
Me.CH_FEED_ADD_SESSION.AutoSize = True
Me.CH_FEED_ADD_SESSION.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_SESSION.Location = New System.Drawing.Point(4, 59)
Me.CH_FEED_ADD_SESSION.Name = "CH_FEED_ADD_SESSION"
Me.CH_FEED_ADD_SESSION.Size = New System.Drawing.Size(568, 19)
Me.CH_FEED_ADD_SESSION.TabIndex = 2
Me.CH_FEED_ADD_SESSION.Text = "Add the session number to the post title"
Me.CH_FEED_ADD_SESSION.UseVisualStyleBackColor = True
'
'CH_FEED_ADD_DATE
'
Me.CH_FEED_ADD_DATE.AutoSize = True
Me.CH_FEED_ADD_DATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_DATE.Location = New System.Drawing.Point(4, 85)
Me.CH_FEED_ADD_DATE.Name = "CH_FEED_ADD_DATE"
Me.CH_FEED_ADD_DATE.Size = New System.Drawing.Size(568, 19)
Me.CH_FEED_ADD_DATE.TabIndex = 3
Me.CH_FEED_ADD_DATE.Text = "Add the date to the post title"
Me.CH_FEED_ADD_DATE.UseVisualStyleBackColor = True
'
'TAB_MAIN
'
Me.TAB_MAIN.Controls.Add(TAB_BASIS)
@@ -1314,5 +1341,7 @@
Private WithEvents TXT_FEED_ROWS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_FEED_COLUMNS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_FEED_ENDLESS As CheckBox
Private WithEvents CH_FEED_ADD_SESSION As CheckBox
Private WithEvents CH_FEED_ADD_DATE As CheckBox
End Class
End Namespace

4
SCrawler/Editors/GlobalSettingsForm.vb
View File

@@ -83,6 +83,8 @@ Namespace Editors
TXT_FEED_ROWS.Value = .FeedDataRows.Value
TXT_FEED_COLUMNS.Value = .FeedDataColumns.Value
CH_FEED_ENDLESS.Checked = .FeedEndless
CH_FEED_ADD_SESSION.Checked = .FeedAddSessionToCaption
CH_FEED_ADD_DATE.Checked = .FeedAddDateToCaption
End With
.MyFieldsChecker = New FieldsChecker
With .MyFieldsCheckerE
@@ -191,6 +193,8 @@ Namespace Editors
.FeedDataRows.Value = CInt(TXT_FEED_ROWS.Value)
.FeedDataColumns.Value = CInt(TXT_FEED_COLUMNS.Value)
.FeedEndless.Value = CH_FEED_ENDLESS.Checked
.FeedAddSessionToCaption.Value = CH_FEED_ADD_SESSION.Checked
.FeedAddDateToCaption.Value = CH_FEED_ADD_DATE.Checked
FeedParametersChanged = .FeedDataRows.ChangesDetected Or .FeedDataColumns.ChangesDetected Or .FeedEndless.ChangesDetected
.EndUpdate()

4
SCrawler/ListImagesLoader.vb
View File

@@ -176,9 +176,7 @@ Friend Class ListImagesLoader
Try
Dim t As New List(Of Task)
Dim l As New List(Of UserOption)
For Each u As IUserData In Settings.Users
If u.FitToAddParams Then t.Add(Task.Run(Sub() l.Add(New UserOption(u, MyList, True))))
Next
t.AddRange(From u As IUserData In Settings.Users Where u.FitToAddParams Select Task.Run(Sub() l.Add(New UserOption(u, MyList, True))))
If t.Count > 0 Then Task.WaitAll(t.ToArray)
If l.Count > 0 Then
For i% = 0 To l.Count - 1

31
SCrawler/MainFrame.Designer.vb generated
View File

@@ -73,6 +73,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_SHOW_GROUPS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_NOT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
Me.BTT_VERSION_INFO = New System.Windows.Forms.ToolStripButton()
Me.BTT_DONATE = New System.Windows.Forms.ToolStripButton()
@@ -89,6 +90,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_CONTEXT_DOWN_DATE_LIMIT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_EDIT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_DELETE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_COPY_TO_FOLDER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_TEMP = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_READY = New System.Windows.Forms.ToolStripMenuItem()
@@ -106,7 +108,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
@@ -537,6 +538,14 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_LIMIT_DATES_NOT.Text = "Limit dates (not in range)"
Me.BTT_SHOW_LIMIT_DATES_NOT.ToolTipText = "Filter users whose last download date is not in the selected date range"
'
'BTT_SHOW_LIMIT_DATES_IN
'
Me.BTT_SHOW_LIMIT_DATES_IN.AutoToolTip = True
Me.BTT_SHOW_LIMIT_DATES_IN.Name = "BTT_SHOW_LIMIT_DATES_IN"
Me.BTT_SHOW_LIMIT_DATES_IN.Size = New System.Drawing.Size(231, 22)
Me.BTT_SHOW_LIMIT_DATES_IN.Text = "Limit dates (in range)"
Me.BTT_SHOW_LIMIT_DATES_IN.ToolTipText = "Filter users whose last download date is in the selected date range"
'
'BTT_LOG
'
Me.BTT_LOG.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
@@ -622,9 +631,9 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'
'USER_CONTEXT
'
Me.USER_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.BTT_CONTEXT_DOWN_LIMITED, Me.BTT_CONTEXT_DOWN_DATE_LIMIT, Me.BTT_CONTEXT_EDIT, Me.BTT_CONTEXT_DELETE, CONTEXT_SEP_1, Me.BTT_CONTEXT_FAV, Me.BTT_CONTEXT_TEMP, Me.BTT_CONTEXT_READY, Me.BTT_CONTEXT_GROUPS, Me.BTT_CONTEXT_SCRIPT, Me.BTT_CONTEXT_ADD_TO_COL, Me.BTT_CONTEXT_COL_MERGE, Me.BTT_CONTEXT_CHANGE_FOLDER, CONTEXT_SEP_2, Me.BTT_CHANGE_IMAGE, CONTEXT_SEP_3, Me.BTT_CONTEXT_OPEN_PATH, CONTEXT_SEP_4, Me.BTT_CONTEXT_OPEN_SITE, CONTEXT_SEP_5, Me.BTT_CONTEXT_INFO})
Me.USER_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.BTT_CONTEXT_DOWN_LIMITED, Me.BTT_CONTEXT_DOWN_DATE_LIMIT, Me.BTT_CONTEXT_EDIT, Me.BTT_CONTEXT_DELETE, Me.BTT_CONTEXT_COPY_TO_FOLDER, CONTEXT_SEP_1, Me.BTT_CONTEXT_FAV, Me.BTT_CONTEXT_TEMP, Me.BTT_CONTEXT_READY, Me.BTT_CONTEXT_GROUPS, Me.BTT_CONTEXT_SCRIPT, Me.BTT_CONTEXT_ADD_TO_COL, Me.BTT_CONTEXT_COL_MERGE, Me.BTT_CONTEXT_CHANGE_FOLDER, CONTEXT_SEP_2, Me.BTT_CHANGE_IMAGE, CONTEXT_SEP_3, Me.BTT_CONTEXT_OPEN_PATH, CONTEXT_SEP_4, Me.BTT_CONTEXT_OPEN_SITE, CONTEXT_SEP_5, Me.BTT_CONTEXT_INFO})
Me.USER_CONTEXT.Name = "USER_CONTEXT"
Me.USER_CONTEXT.Size = New System.Drawing.Size(222, 408)
Me.USER_CONTEXT.Size = New System.Drawing.Size(222, 452)
'
'BTT_CONTEXT_DOWN
'
@@ -663,6 +672,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_CONTEXT_DELETE.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_DELETE.Text = "Delete user / collection"
'
'BTT_CONTEXT_COPY_TO_FOLDER
'
Me.BTT_CONTEXT_COPY_TO_FOLDER.Image = Global.SCrawler.My.Resources.Resources.PastePic32
Me.BTT_CONTEXT_COPY_TO_FOLDER.Name = "BTT_CONTEXT_COPY_TO_FOLDER"
Me.BTT_CONTEXT_COPY_TO_FOLDER.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_COPY_TO_FOLDER.Text = "Copy data to another folder"
'
'BTT_CONTEXT_FAV
'
Me.BTT_CONTEXT_FAV.Image = Global.SCrawler.My.Resources.Resources.StarPic_24
@@ -786,14 +802,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_CLOSE_NO_SCRIPT.ToolTipText = "Close the program without executing the script"
Me.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = False
'
'BTT_SHOW_LIMIT_DATES_IN
'
Me.BTT_SHOW_LIMIT_DATES_IN.AutoToolTip = True
Me.BTT_SHOW_LIMIT_DATES_IN.Name = "BTT_SHOW_LIMIT_DATES_IN"
Me.BTT_SHOW_LIMIT_DATES_IN.Size = New System.Drawing.Size(231, 22)
Me.BTT_SHOW_LIMIT_DATES_IN.Text = "Limit dates (in range)"
Me.BTT_SHOW_LIMIT_DATES_IN.ToolTipText = "Filter users whose last download date is in the selected date range"
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -892,4 +900,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Friend WithEvents Toolbar_TOP As ToolStrip
Private WithEvents BTT_FEED As ToolStripButton
Private WithEvents BTT_SHOW_LIMIT_DATES_IN As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_COPY_TO_FOLDER As ToolStripMenuItem
End Class

58
SCrawler/MainFrame.resx
View File

@@ -312,6 +312,35 @@
<metadata name="TRAY_CONTEXT.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>623, 17</value>
</metadata>
<data name="BTT_TRAY_CLOSE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m
dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3
WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo
2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S
pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6
+TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS
JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp
G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J
EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ
zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL
E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU
gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz
wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW
Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs
BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP
nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v
b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl
JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA
7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC
m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM
GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL
S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq
FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu
C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA
b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC
</value>
</data>
<data name="TrayIcon.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAABAAEAMDAAAAEAIACoJQAAFgAAACgAAAAwAAAAYAAAAAEAIAAAAAAAACQAAMMOAADDDgAAAAAAAAAA
@@ -476,35 +505,6 @@
AAAAAAAAH/8AAAAAAAA//wAAAAAAAH//AAAAAAAA//8AAAAAAAP//wAAAAAAB///AAAAAAAP//8AAAAA
AB///wAAAAAAf///AAAAAAH///8AAAAAB////wAAAAAf////AAAAAP////8AAAAH/////wAAAH//////
AAA=
</value>
</data>
<data name="BTT_TRAY_CLOSE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m
dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3
WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo
2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S
pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6
+TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS
JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp
G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J
EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ
zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL
E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU
gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz
wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW
Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs
BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP
nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v
b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl
JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA
7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC
m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM
GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL
S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq
FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu
C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA
b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC
</value>
</data>
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">

201
SCrawler/MainFrame.vb
View File

@@ -10,6 +10,7 @@ Imports System.ComponentModel
Imports System.Globalization
Imports System.Threading
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.Messaging
Imports SCrawler.API
Imports SCrawler.API.Base
Imports SCrawler.Editors
@@ -672,6 +673,9 @@ CloseResume:
Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click
DeleteSelectedUser()
End Sub
Private Sub BTT_CONTEXT_COPY_TO_FOLDER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_COPY_TO_FOLDER.Click
CopyUserData()
End Sub
Private Sub BTT_CONTEXT_FAV_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_FAV.Click
Dim users As List(Of IUserData) = GetSelectedUserArray()
If AskForMassReplace(users, "Favorite") Then
@@ -776,40 +780,83 @@ CloseResume:
End If
End Sub
Private Sub BTT_CONTEXT_ADD_TO_COL_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_ADD_TO_COL.Click
Const MsgTitle$ = "Add users to the collection"
If Settings.CollectionsPath.Value.IsEmptyString Then
MsgBoxE("Collection path not specified", MsgBoxStyle.Exclamation)
MsgBoxE({"Collection path not specified", MsgTitle}, MsgBoxStyle.Exclamation)
Else
Dim user As IUserData = GetSelectedUser()
If Not user Is Nothing Then
If user.IsCollection Then
MsgBoxE("Collection can not be added to collection!", MsgBoxStyle.Critical)
Else
Using f As New CollectionEditorForm(user.CollectionName)
Dim users As List(Of IUserData) = GetSelectedUserArray()
If users.ListExists Then
Dim i%
Dim _col_user As Predicate(Of IUserData) = Function(u) u.IsCollection
Dim userCollection As UserDataBind = users.Find(_col_user)
Dim _col_name$ = String.Empty
If Not userCollection Is Nothing Then
i = users.LongCount(Function(u) _col_user(u))
If i > 1 OrElse i = users.Count OrElse
(i = 1 AndAlso
MsgBoxE({$"Do you want to add the following users to the [{userCollection.Name}] collection?" & vbCr &
users.Where(Function(u) Not _col_user(u)).ListToString(vbCr),
MsgTitle}, vbQuestion + vbYesNo) = vbNo) Then _
MsgBoxE({"The collection cannot be added to the collection!", MsgTitle}, MsgBoxStyle.Critical) : Exit Sub
_col_name = userCollection.Name
End If
If _col_name.IsEmptyString Then
Using f As New CollectionEditorForm
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
With Settings
Dim fCol As Predicate(Of IUserData) = Function(u) u.IsCollection And u.CollectionName = f.Collection
Dim i% = .Users.FindIndex(fCol)
Dim Added As Boolean = i < 0
If i < 0 Then
.Users.Add(New UserDataBind(f.Collection))
MainFrameObj.CollectionHandler(DirectCast(.Users.Last, UserDataBind))
i = .Users.Count - 1
End If
Try
DirectCast(.Users(i), UserDataBind).Add(user)
RemoveUserFromList(user)
i = .Users.FindIndex(fCol)
If i >= 0 Then UserListUpdate(.Users(i), Added)
MsgBoxE($"[{user.Name}] was added to collection [{f.Collection}]")
Catch ex As InvalidOperationException
i = .Users.FindIndex(fCol)
If i >= 0 AndAlso DirectCast(.Users(i), UserDataBind).Count = 0 Then .Users(i).Dispose() : .Users.RemoveAt(i)
End Try
End With
End If
If f.DialogResult = DialogResult.OK Then _col_name = f.Collection
End Using
End If
If _col_name.IsEmptyString Then
MsgBoxE({"The destination collection has not been selected.", MsgTitle}, vbExclamation)
Else
With Settings
userCollection = .Users.Find(Function(u) u.IsCollection And u.CollectionName = _col_name)
Dim Added As Boolean = userCollection Is Nothing
If Added Then
.Users.Add(New UserDataBind(_col_name))
MainFrameObj.CollectionHandler(DirectCast(.Users.Last, UserDataBind))
userCollection = .Users.Last
End If
Dim __added_users As New List(Of IUserData)
Dim __added_users_not As New List(Of IUserData)
For Each user As IUserData In users
If Not user.IsCollection Then
Try
userCollection.Add(user)
RemoveUserFromList(user)
UserListUpdate(userCollection, Added)
If Not Added Then FocusUser(userCollection.LVIKey)
Added = False
__added_users.Add(user)
Catch ex As InvalidOperationException
userCollection.Remove(user)
If __added_users.Count > 0 AndAlso __added_users.Contains(user) Then __added_users.Remove(user)
__added_users_not.Add(user)
End Try
End If
Next
If userCollection.Count = 0 Then
RemoveUserFromList(userCollection)
If Settings.Users.Remove(userCollection) Then userCollection.Dispose()
MsgBoxE({$"No users have been added to the [{_col_name}] collection.", MsgTitle}, vbCritical)
ElseIf __added_users.Count = 1 And __added_users_not.Count = 0 Then
MsgBoxE({$"The user [{__added_users(0)}] has been added to the collection [{_col_name}].", MsgTitle})
ElseIf __added_users.Count = 0 And __added_users_not.Count = 1 Then
MsgBoxE({$"The user [{__added_users_not(0)}] was not added to the collection [{_col_name}].", MsgTitle}, vbCritical)
Else
Dim m As New MMessage($"The following users have been added to the [{_col_name}] collection:{vbCr}", MsgTitle,,
If(__added_users_not.Count > 0, vbExclamation, vbInformation))
m.Text &= __added_users.ListToString(vbCr)
If __added_users_not.Count > 0 Then
m.Text &= $"{vbNewLine.StringDup(2)}The following users have not been added to the [{_col_name}] collection:{vbCr}"
m.Text &= __added_users_not.ListToString(vbCr)
End If
MsgBoxE(m)
End If
__added_users.Clear()
__added_users_not.Clear()
End With
End If
End If
End If
End Sub
@@ -1025,15 +1072,15 @@ CloseResume:
If USER_CONTEXT.Visible Then USER_CONTEXT.Hide()
Dim ugn As Func(Of IUserData, String) = Function(u) $"{IIf(u.IsCollection, "Collection", "User")}: {u.Name}"
Dim m As New MMessage(users.Select(ugn).ListToString(vbNewLine), "Users deleting",
{New Messaging.MsgBoxButton("Delete and ban") With {.ToolTip = "Users and their data will be deleted and added to the blacklist"},
New Messaging.MsgBoxButton("Delete user only and ban") With {
{New MsgBoxButton("Delete and ban") With {.ToolTip = "Users and their data will be deleted and added to the blacklist"},
New MsgBoxButton("Delete user only and ban") With {
.ToolTip = "Users will be deleted and added to the blacklist (user data will not be deleted)"},
New Messaging.MsgBoxButton("Delete and ban with reason") With {
New MsgBoxButton("Delete and ban with reason") With {
.ToolTip = "Users and their data will be deleted and added to the blacklist with set a reason to delete"},
New Messaging.MsgBoxButton("Delete user only and ban with reason") With {
New MsgBoxButton("Delete user only and ban with reason") With {
.ToolTip = "Users will be deleted and added to the blacklist with set a reason to delete (user data will not be deleted)"},
New Messaging.MsgBoxButton("Delete") With {.ToolTip = "Delete users and their data"},
New Messaging.MsgBoxButton("Delete user only") With {.ToolTip = "Delete users but keep data"}, "Cancel"},
New MsgBoxButton("Delete") With {.ToolTip = "Delete users and their data"},
New MsgBoxButton("Delete user only") With {.ToolTip = "Delete users but keep data"}, "Cancel"},
MsgBoxStyle.Exclamation) With {.ButtonsPerRow = 2, .ButtonsPlacing = MMessage.ButtonsPlacings.StartToEnd}
m.Text = $"The following users ({users.Count}) will be deleted:{vbNewLine}{m.Text}"
Dim result% = MsgBoxE(m)
@@ -1094,7 +1141,89 @@ CloseResume:
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on trying to delete user / collection")
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error when trying to delete user / collection")
End Try
End Sub
Private Sub CopyUserData()
Const MsgTitle$ = "Copying user data"
Try
Dim users As List(Of IUserData) = GetSelectedUserArray()
If users.ListExists Then
Dim f As SFile = Settings.LastCopyPath
Dim _select_path As Func(Of Boolean) = Function() As Boolean
f = SFile.SelectPath(f, True)
If f.Exists(SFO.Path, False) Then
Return MsgBoxE({$"Are you sure you want to copy the data to the selected folder?{vbCr}{f}",
MsgTitle}, vbQuestion + vbYesNo) = vbYes
Else
MsgBoxE({$"Destination path not selected.{vbCr}Operation canceled.", MsgTitle}, vbExclamation)
Return False
End If
End Function
If f.Exists(SFO.Path, False) Then
Select Case MsgBoxE({$"Last folder you copied to:{vbCr}{f}" & vbCr &
"Do you want to copy to this folder or choose another destination?", MsgTitle}, vbQuestion,,,
{New MsgBoxButton("Process") With {.ToolTip = "Use last folder"},
New MsgBoxButton("Choose new") With {.ToolTip = "Choose a new destination"},
New MsgBoxButton("Cancel")})
Case 1 : If Not _select_path.Invoke Then Exit Sub
Case 2 : MsgBoxE({"Operation canceled", MsgTitle}) : Exit Sub
End Select
Else
If Not _select_path.Invoke Then Exit Sub
End If
If f.Exists(SFO.Path, False) Then
Settings.LastCopyPath.Value = f
Using logger As New TextSaver With {.LogMode = True}
Dim m As New MMessage("", MsgTitle,,, {logger})
Dim err As New ErrorsDescriber(EDP.SendInLog) With {.DeclaredMessage = m}
Dim __copied_users As New List(Of IUserData)
Dim __copied_users_not As New List(Of IUserData)
For Each user As IUserData In users
If user.CopyFiles(f, err) Then
__copied_users.Add(user)
Else
__copied_users_not.Add(user)
End If
Next
err = Nothing
Dim buttons As New List(Of MsgBoxButton) From {New MsgBoxButton("OK")}
If __copied_users_not.Count > 0 Then
err = New ErrorsDescriber(EDP.ShowAllMsg)
m.Style = If(__copied_users.Count > 0, vbExclamation, vbCritical)
If Not logger.IsEmptyString Then
m.DefaultButton = 0
m.CancelButton = 0
buttons.Add(New MsgBoxButton("Show LOG") With {
.IsDialogResultButton = False,
.BackColor = MyColor.DeleteBack,
.ForeColor = MyColor.DeleteFore,
.KeyCode = Keys.F1,
.ToolTip = "Show error log",
.CallBack = Sub(r, mm, b)
Using ff As New LOG_FORM(logger) : ff.ShowDialog() : End Using
End Sub})
End If
End If
m.Buttons = buttons
If __copied_users_not.Count = 0 Then
m.Text = "All users are copied."
ElseIf __copied_users.Count = 0 And __copied_users_not.Count > 0 Then
m.Text = "No users have been copied."
Else
m.Text = $"The following users have been copied:{vbNewLine}"
m.Text &= __copied_users.ListToString(vbNewLine)
If __copied_users_not.Count > 0 Then
m.Text = $"{vbNewLine.StringDup(2)}The following users have not been copied:{vbNewLine}"
m.Text &= __copied_users_not.ListToString(vbNewLine)
End If
End If
MsgBoxE(m,, err)
End Using
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error when trying to copy data")
End Try
End Sub
Friend Sub UserRemovedFromCollection(ByVal User As IUserData)

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("2022.9.17.0")>
<Assembly: AssemblyFileVersion("2022.9.17.0")>
<Assembly: AssemblyVersion("2022.9.24.0")>
<Assembly: AssemblyFileVersion("2022.9.24.0")>
<Assembly: NeutralResourcesLanguage("en")>

10
SCrawler/My Project/Resources.Designer.vb generated
View File

@@ -170,6 +170,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>
Friend ReadOnly Property PastePic32() As System.Drawing.Bitmap
Get
Dim obj As Object = ResourceManager.GetObject("PastePic32", resourceCulture)
Return CType(obj,System.Drawing.Bitmap)
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>

3
SCrawler/My Project/Resources.resx
View File

@@ -214,4 +214,7 @@
<data name="StopPic32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\StopPic32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="PastePic32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\PastePic32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
</root>

1
SCrawler/SCrawler.vbproj
View File

@@ -492,6 +492,7 @@
<None Include="Content\Icons\RedGifsIcon.ico" />
<None Include="Content\Icons\RSSIcon.ico" />
<None Include="Content\Pictures\StopPic32.png" />
<None Include="Content\Pictures\PastePic32.png" />
<Content Include="ffmpeg.exe">
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</Content>

9
SCrawler/SettingsCLS.vb
View File

@@ -36,6 +36,7 @@ Friend Class SettingsCLS : Implements IDisposable
Friend Property Channels As Reddit.ChannelsCollection
Friend ReadOnly Property Labels As LabelsKeeper
Friend ReadOnly Property Groups As Groups.DownloadGroupCollection
Friend ReadOnly Property LastCollections As List(Of String)
Friend Property Automation As Scheduler
Friend ReadOnly Property BlackList As List(Of UserBan)
Private ReadOnly BlackListFile As SFile = $"{SettingsFolderName}\BlackList.txt"
@@ -52,9 +53,11 @@ Friend Class SettingsCLS : Implements IDisposable
UsersList = New List(Of UserInfo)
BlackList = New List(Of UserBan)
Plugins = New List(Of PluginHost)
LastCollections = New List(Of String)
GlobalPath = New XMLValue(Of SFile)("GlobalPath", New SFile($"{SFile.GetPath(Application.StartupPath).PathWithSeparator}Data\"), MyXML,,
New XMLValueBase.ToFilePath)
LastCopyPath = New XMLValue(Of SFile)("LastCopyPath",, MyXML,, New XMLValueBase.ToFilePath)
CookiesEncrypted = New XMLValue(Of Boolean)("CookiesEncrypted", False, MyXML)
EncryptCookies.CookiesEncrypted = CookiesEncrypted
@@ -122,6 +125,8 @@ Friend Class SettingsCLS : Implements IDisposable
FeedDataColumns = New XMLValue(Of Integer)("DataColumns", 1, MyXML, n)
FeedDataRows = New XMLValue(Of Integer)("DataRows", 10, MyXML, n)
FeedEndless = New XMLValue(Of Boolean)("Endless", True, MyXML, n)
FeedAddDateToCaption = New XMLValue(Of Boolean)("AddDateToCaption", True, MyXML, n)
FeedAddSessionToCaption = New XMLValue(Of Boolean)("AddSessionToCaption", False, MyXML, n)
n = {"Users"}
FromChannelDownloadTop = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML, n)
@@ -420,6 +425,7 @@ Friend Class SettingsCLS : Implements IDisposable
End Get
End Property
Friend ReadOnly Property GlobalPath As XMLValue(Of SFile)
Friend ReadOnly Property LastCopyPath As XMLValue(Of SFile)
Friend ReadOnly Property SeparateVideoFolder As XMLValue(Of Boolean)
Friend ReadOnly Property CollectionsPath As XMLValue(Of String)
Friend ReadOnly Property CollectionsPathF As SFile
@@ -519,6 +525,8 @@ Friend Class SettingsCLS : Implements IDisposable
Friend ReadOnly Property FeedDataColumns As XMLValue(Of Integer)
Friend ReadOnly Property FeedDataRows As XMLValue(Of Integer)
Friend ReadOnly Property FeedEndless As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddDateToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddSessionToCaption As XMLValue(Of Boolean)
#End Region
#Region "New version properties"
Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean)
@@ -550,6 +558,7 @@ Friend Class SettingsCLS : Implements IDisposable
If Not Automation Is Nothing Then Automation.Dispose()
CachePath.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.None)
Plugins.Clear()
LastCollections.Clear()
Users.ListClearDispose
UsersList.Clear()
SelectedSites.Dispose()