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

1.0.0.1

Browse Source 
Added: limited downloads, remove active downloads, simulation tasks management, copy channel image, x86
Removed reparse function
Fixed some errors, typo and Reddit parsing algo
This commit is contained in:
Andy
2021-12-09 18:36:22 +03:00
parent 6979ca018e
commit c7dc0eca7d
23 changed files with 642 additions and 277 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
Changelog.md Normal file
View File

@@ -0,0 +1,25 @@
# 1.0.0.1
- Added
- Limited download if user added from the channel
- Forced limited download for any user
- x86 compatibility
- Coping user image posted in the channel (if user added from the channel)
- Check for new version at start setting
- Removing currently downloading user
- Change maximum count of along downloading tasks of users
- Change maximum count of along downloading tasks of channels
- Removed
- Reparse not downloaded content (left from the older versions)
- Fixed
- ```No Label``` and ```No Parsed``` labels does not shown in the labels list
- User list does not refresh by labels change in the main window
- Disabled collection editing
- Collection name does not show in some operations
- Error (in some cases) on add to collection
- Wrong some Reddit videos parsing
- Wrong some Reddit images parsing
# 1.0.0.0
Initial release

2
SCrawler.sln
View File

@@ -10,8 +10,10 @@ EndProject
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{FE5CE5B9-DDBE-4399-A17C-880893635307}"
ProjectSection(SolutionItems) = preProject
.gitignore = .gitignore
Changelog.md = Changelog.md
README.md = README.md
Info\RedditUrlsInfo.txt = Info\RedditUrlsInfo.txt
ToDo.txt = ToDo.txt
Info\TwitterNewAlgo.txt = Info\TwitterNewAlgo.txt
Info\TwitterUrlsInfo.txt = Info\TwitterUrlsInfo.txt
EndProjectSection

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

@@ -40,6 +40,7 @@ Namespace API.Base
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Private Const Name_Temporary As String = "Temporary"
Private Const Name_Favorite As String = "Favorite"
Private Const Name_CreatedByChannel As String = "CreatedByChannel"
Private Const Name_SeparateVideoFolder As String = "SeparateVideoFolder"
Private Const Name_CollectionName As String = "Collection"
@@ -103,6 +104,7 @@ Namespace API.Base
Return User.IsChannel
End Get
End Property
Friend Property CreatedByChannel As Boolean = False
Friend ReadOnly Property Self As IUserData Implements IUserData.Self
Get
Return Me
@@ -235,7 +237,6 @@ BlockNullPicture:
#Region "Content"
Protected ReadOnly _ContentList As List(Of UserMedia)
Protected ReadOnly _ContentNew As List(Of UserMedia)
Protected ReadOnly _ContentForReparse As List(Of UserMedia)
Protected ReadOnly _TempMediaList As List(Of UserMedia)
Protected ReadOnly _TempPostsList As List(Of String)
#End Region
@@ -250,8 +251,6 @@ BlockNullPicture:
End Set
End Property
Protected MyFileData As SFile
Protected MyFileDataR As SFile
Protected MyFileDataRV As SFile
Protected MyFilePosts As SFile
Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists
Friend Overridable Property DataMerging As Boolean
@@ -398,7 +397,6 @@ BlockNullPicture:
_InvokeImageHandler = InvokeImageHandler
_ContentList = New List(Of UserMedia)
_ContentNew = New List(Of UserMedia)
_ContentForReparse = New List(Of UserMedia)
_TempMediaList = New List(Of UserMedia)
_TempPostsList = New List(Of String)
Labels = New List(Of String)
@@ -430,6 +428,7 @@ BlockNullPicture:
ParseUserMediaOnly = x.Value(Name_ParseUserMediaOnly).FromXML(Of Boolean)(False)
Temporary = x.Value(Name_Temporary).FromXML(Of Boolean)(False)
Favorite = x.Value(Name_Favorite).FromXML(Of Boolean)(False)
CreatedByChannel = x.Value(Name_CreatedByChannel).FromXML(Of Boolean)(False)
SeparateVideoFolder = AConvert(Of Boolean)(x.Value(Name_SeparateVideoFolder), Nothing)
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
_CountVideo = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
@@ -440,7 +439,6 @@ BlockNullPicture:
Labels.ListAddList(x.Value(Name_LabelsName).StringToList(Of String, List(Of String))("|", EDP.ReturnValue), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
End Using
UpdateDataFiles()
_DataForReparseExists = MyFileDataR.Exists
End If
Catch ex As Exception
LogError(ex, "user information loading error")
@@ -458,6 +456,7 @@ BlockNullPicture:
x.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
x.Add(Name_Temporary, Temporary.BoolToInteger)
x.Add(Name_Favorite, Favorite.BoolToInteger)
x.Add(Name_CreatedByChannel, CreatedByChannel.BoolToInteger)
If SeparateVideoFolder.HasValue Then
x.Add(Name_SeparateVideoFolder, SeparateVideoFolder.Value.BoolToInteger)
Else
@@ -483,9 +482,6 @@ BlockNullPicture:
Friend Overridable Overloads Sub LoadContentInformation()
UpdateDataFiles()
LoadContentInformation(_ContentList, MyFileData)
LoadContentInformation(_ContentForReparse, MyFileDataR)
LoadContentInformation(_TempMediaList, MyFileDataRV)
_DataForReparseExists = False
End Sub
Private Overloads Sub LoadContentInformation(ByRef _CLIST As List(Of UserMedia), ByVal f As SFile)
Try
@@ -570,13 +566,7 @@ BlockNullPicture:
End Sub
#End Region
#Region "Download functions and options"
Friend Overridable Property DownloadReparseOnly As Boolean = False Implements IUserData.DownloadReparseOnly
Private _DataForReparseExists As Boolean = False
Friend Overridable ReadOnly Property DataForReparseExists As Boolean Implements IUserData.DataForReparseExists
Get
Return _ContentForReparse.Count > 0 Or _DataForReparseExists
End Get
End Property
Friend Overridable Property DownloadTopCount As Integer? = Nothing Implements IUserData.DownloadTopCount
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
Dim Canceled As Boolean = False
Try
@@ -586,79 +576,60 @@ BlockNullPicture:
_DownloadedVideosSession = 0
_TempMediaList.Clear()
_TempPostsList.Clear()
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
If Not _DataLoaded Then LoadContentInformation()
If Not DownloadReparseOnly Then
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
Token.ThrowIfCancellationRequested()
DownloadDataF(Token)
Token.ThrowIfCancellationRequested()
End If
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
ThrowAny(Token)
DownloadDataF(Token)
ThrowAny(Token)
ReparseVideo(Token)
If Token.IsCancellationRequested Then
If Not DownloadReparseOnly Then
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(c) c.Type = UserMedia.Types.VideoPre) Then
TextSaver.SaveTextToFile((From c As UserMedia In _TempMediaList
Where c.Type = UserMedia.Types.VideoPre
Select c.URL).ListToString(, Environment.NewLine), MyFileDataRV, True,, EDP.SendInLog)
Else
If MyFileDataRV.Exists Then MyFileDataRV.Delete(,,, EDP.SendInLog)
End If
End If
Else
If Not DownloadReparseOnly And _TempPostsList.Count > 0 Then TextSaver.SaveTextToFile(_TempPostsList.ListToString(, Environment.NewLine), MyFilePosts, True,, EDP.None)
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
End If
Dim r% = 0
Do While r <= 2 And (_ContentNew.Count > 0 Or _ContentForReparse.Count > 0) And Not Token.IsCancellationRequested
DownloadContent(Token)
If _ContentNew.Count > 0 Then
_ContentForReparse.ListAddList(_ContentNew.Where(Function(c) c.State = UState.Tried Or c.State = UState.Unknown), LNC)
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UState.Downloaded), LNC)
End If
If _ContentForReparse.Count > 0 Then _ContentForReparse.RemoveAll(Function(c) _ContentList.Contains(c))
_ContentNew.Clear()
If _ContentForReparse.Count > 0 Then _ContentNew.ListAddList(_ContentForReparse, LNC)
r += 1
Loop
ThrowAny(Token)
If _TempPostsList.Count > 0 And __SaveData Then TextSaver.SaveTextToFile(_TempPostsList.ListToString(, Environment.NewLine), MyFilePosts, True,, EDP.None)
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
DownloadContent(Token)
ThrowIfDisposed()
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UState.Downloaded), LNC)
_CountPictures = _ContentList.LongCount(Function(c) c.Type = UserMedia.Types.Picture)
_CountVideo = _ContentList.LongCount(Function(c) c.Type = UserMedia.Types.Video)
If DownloadedPictures + DownloadedVideos > 0 Then
LastUpdated = Now
If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser)
UpdateContentInformation(_ContentList, MyFileData)
If __SaveData Then
LastUpdated = Now
If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser)
UpdateContentInformation(_ContentList, MyFileData)
Else
_CountVideo = 0
_CountPictures = 0
_ContentList.Clear()
CreatedByChannel = False
End If
UpdateUserInformation()
End If
If _ContentForReparse.Count > 0 Then UpdateContentInformation(_ContentForReparse, MyFileDataR)
ThrowIfDisposed()
_DownloadedPicturesTotal += _DownloadedPicturesSession
_DownloadedVideosTotal += _DownloadedVideosSession
If UpPic Then Raise_OnPictureUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested
MyMainLOG = $"{Site} - {Name}: downloading canceled"
Canceled = True
Catch dex As ObjectDisposedException When Disposed
Canceled = True
Catch ex As Exception
LogError(ex, "downloading data error")
HasError = True
Finally
If Not Canceled Then _DataParsed = True ': LastUpdated = Now
_ContentNew.Clear()
DownloadReparseOnly = False
If _ContentForReparse.Count = 0 And MyFileDataR.Exists Then MyFileDataR.Delete(,,, EDP.SendInLog)
DownloadTopCount = Nothing
End Try
End Sub
Private Sub UpdateDataFiles()
If Not User.File.IsEmptyString Then
MyFileData = User.File
MyFileData.Name &= "_Data"
MyFileDataR = MyFileData
MyFileDataR.Name &= "_REPARSE"
MyFileDataRV = MyFileData
MyFileDataRV.Name &= "_RVideo"
MyFilePosts = User.File
MyFilePosts.Name &= "_Posts"
MyFilePosts.Extension = "txt"
@@ -687,9 +658,10 @@ BlockNullPicture:
End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal _MergeData As Boolean) As Boolean Implements IUserData.MoveFiles
Dim UserBefore As UserInfo = User
Dim Removed As Boolean = True
Dim _TurnBack As Boolean = False
Try
Dim f As SFile
Dim Removed As Boolean
If IncludedInCollection Then
Settings.Users.Add(Me)
Removed = False
@@ -701,6 +673,7 @@ BlockNullPicture:
User.CollectionName = __CollectionName
User.IncludedInCollection = True
End If
_TurnBack = True
User.UpdateUserFile()
f = User.File.CutPath(, EDP.ThrowException)
If f.Exists(SFO.Path, False) Then
@@ -711,6 +684,7 @@ BlockNullPicture:
MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation)
User = UserBefore
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
_TurnBack = False
Return False
End If
f.Delete(SFO.Path, False, False, EDP.ThrowException)
@@ -724,6 +698,9 @@ BlockNullPicture:
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Files moving error")
User = UserBefore
If _TurnBack Then
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
End If
Return False
End Try
End Function
@@ -789,6 +766,16 @@ BlockNullPicture:
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
End Sub
''' <exception cref="ObjectDisposedException"></exception>
Protected Sub ThrowIfDisposed()
If Disposed Then Throw New ObjectDisposedException(ToString(), "Object disposed")
End Sub
''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception>
Protected Sub ThrowAny(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
ThrowIfDisposed()
End Sub
#End Region
Public Overrides Function ToString() As String
If Settings.ViewModeIsPicture Then
@@ -861,7 +848,7 @@ BlockNullPicture:
#End Region
#Region "IDisposable Support"
Protected disposedValue As Boolean = False
Friend ReadOnly Property Disposed As Boolean
Friend ReadOnly Property Disposed As Boolean Implements IUserData.Disposed
Get
Return disposedValue
End Get
@@ -942,9 +929,9 @@ BlockNullPicture:
Function Delete() As Integer
Function MoveFiles(ByVal CollectionName As String, ByVal MergeData As Boolean) As Boolean
Sub OpenFolder()
Property DownloadReparseOnly As Boolean
ReadOnly Property DataForReparseExists As Boolean
ReadOnly Property Self As IUserData
Property DownloadTopCount As Integer?
ReadOnly Property Disposed As Boolean
End Interface
Friend Interface IChannelLimits
Property AutoGetLimits As Boolean

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

@@ -222,7 +222,7 @@ Namespace API.Reddit
End If
End Function
#End Region
#Region "IXMLContainer Support"
#Region "ILoaderSaver Support"
Friend Overloads Function LoadData(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Load
Return LoadData(File, False, e)
End Function

8
SCrawler/API/Reddit/ChannelsCollection.vb
View File

@@ -72,16 +72,18 @@ Namespace API.Reddit
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
Optional ByVal p As MyProgress = Nothing)
Try
Dim m% = Settings.ChannelsMaxJobsCount
If Count > 0 Then
Dim t As New List(Of Task)
Dim i% = 0
For Each c As Channel In Channels
If Not c.Downloading Then t.Add(Task.Run(Sub()
c.SetLimit(Me)
c.DownloadData(Token, SkipExists, p)
End Sub))
End Sub)) : i += 1
If t.Count > 0 And i >= m Then Task.WaitAll(t.ToArray, Token) : t.Clear() : i = 0
Next
If t.Count > 0 Then Task.WaitAll(t.ToArray)
Token.ThrowIfCancellationRequested()
If t.Count > 0 Then Task.WaitAll(t.ToArray, Token) : t.Clear()
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
End Try

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

@@ -80,7 +80,7 @@ Namespace API.Reddit
eFiles.Add(dFile)
Next
End Using
f = FFMPEG.ConcatenateFiles(eFiles, "ffmpeg.exe", ConcatFile, p, DPED)
f = FFMPEG.ConcatenateFiles(eFiles, Settings.FfmpegFile, ConcatFile, p, DPED)
eFiles.Clear()
Return f
End If

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

@@ -78,8 +78,8 @@ Namespace API.Reddit
End If
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
If IsChannel Then
_DownloadedChannelPosts = 0
DownloadDataChannel(String.Empty, Token)
Else
DownloadDataUser(String.Empty, Token)
@@ -87,6 +87,7 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Download Functions (User, Channel)"
Private _TotalPostsDownloaded As Integer = 0
Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
@@ -103,7 +104,7 @@ Namespace API.Reddit
Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
URL = $"https://gateway.reddit.com/desktopapi/v1/user/{Name}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort=new&t=all&layout=classic"
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
Dim r$ = GetSiteResponse(URL)
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r)
@@ -111,7 +112,7 @@ Namespace API.Reddit
n = w.GetNode(JsonNodesJson)
If Not n Is Nothing AndAlso n.Count > 0 Then
For Each nn In n
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
If nn.Count > 0 Then
PostID = nn.Name
If PostID.IsEmptyString AndAlso nn.Contains("id") Then PostID = nn("id").Value
@@ -129,19 +130,24 @@ Namespace API.Reddit
s = nn.ItemF({"source", "url"})
If s.XmlIfNothingValue("/").Contains("redgifs.com") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, PostID, PostDate,, IsChannel), LNC)
_TotalPostsDownloaded += 1
Else
s = nn.ItemF({"media"}).XmlIfNothing
__ItemType = s("type").XmlIfNothingValue
Select Case __ItemType
Case "gallery" : DownloadGallery(s, PostID, PostDate)
Case "gallery" : DownloadGallery(s, PostID, PostDate) : _TotalPostsDownloaded += 1
Case "image", "gifvideo"
If s.Contains("content") Then _
If s.Contains("content") Then
_TempMediaList.ListAddValue(MediaFromData(UPicType(__ItemType), s.Value("content"),
PostID, PostDate,, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
Case "video"
If s("hlsUrl").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then _
If Settings.UseM3U8 AndAlso s("hlsUrl").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value("hlsUrl"),
PostID, PostDate,, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
Case Else : added = False
End Select
End If
@@ -151,14 +157,16 @@ Namespace API.Reddit
With s.Value.ToLower
Select Case True
Case .Contains("redgifs") : tmpType = UTypes.VideoPre
Case .Contains("m3u8") : tmpType = UTypes.m3u8
Case .Contains("m3u8") : If Settings.UseM3U8 Then tmpType = UTypes.m3u8
Case .Contains(".gif") And TryFile(s.Value) : tmpType = UTypes.GIF
Case TryFile(s.Value) : tmpType = UTypes.Picture
Case Else : tmpType = UTypes.Undefined
End Select
End With
If Not tmpType = UTypes.Undefined Then _
If Not tmpType = UTypes.Undefined Then
_TempMediaList.ListAddValue(MediaFromData(tmpType, s.Value, PostID, PostDate,, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
End If
End If
End If
@@ -171,12 +179,12 @@ Namespace API.Reddit
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataUser(PostID, Token)
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, $"data downloading error [{URL}]")
HasError = True
End Try
End Sub
Private _DownloadedChannelPosts As Integer = 0
Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
@@ -189,7 +197,7 @@ Namespace API.Reddit
Dim lDate As Date?
URL = $"https://reddit.com/r/{Name}/new.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort=new&t=all&layout=classic"
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
Dim r$ = GetSiteResponse(URL)
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
@@ -197,14 +205,14 @@ Namespace API.Reddit
n = w.GetNode(ChannelJsonNodes)
If Not n Is Nothing AndAlso n.Count > 0 Then
For Each nn In n
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
s = nn.ItemF({eCount})
If Not s Is Nothing AndAlso s.Count > 0 Then
PostID = s.Value("name")
If PostID.IsEmptyString AndAlso s.Contains("id") Then PostID = s("id").Value
If ChannelPostsNames.Contains(PostID) Then ExistsDetected = True : Continue For 'Exit Sub
If DownloadLimitCount.HasValue AndAlso _DownloadedChannelPosts >= DownloadLimitCount.Value Then Exit Sub
If DownloadLimitCount.HasValue AndAlso _TotalPostsDownloaded >= DownloadLimitCount.Value Then Exit Sub
If Not DownloadLimitPost.IsEmptyString AndAlso DownloadLimitPost = PostID Then Exit Sub
If DownloadLimitDate.HasValue AndAlso _TempMediaList.Count > 0 Then
With (From __u In _TempMediaList Where __u.Post.Date.HasValue Select __u.Post.Date.Value)
@@ -226,20 +234,20 @@ Namespace API.Reddit
tmpUrl = s.Value({"media", "oembed"}, "thumbnail_url")
If Not tmpUrl.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_DownloadedChannelPosts += 1
_TotalPostsDownloaded += 1
End If
Else
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_DownloadedChannelPosts += 1
_TotalPostsDownloaded += 1
End If
ElseIf s.Item("media_metadata").XmlIfNothing.Count > 0 Then
DownloadGallery(s, PostID, PostDate, _UserID, SaveToCache)
_DownloadedChannelPosts += 1
_TotalPostsDownloaded += 1
ElseIf s.Contains("preview") Then
ss = s.ItemF({"preview", "images", eCount, "source", "url"}).XmlIfNothing
If Not ss.Value.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, ss.Value, PostID, PostDate, _UserID, IsChannel), LNC)
_DownloadedChannelPosts += 1
_TotalPostsDownloaded += 1
End If
End If
End If
@@ -251,6 +259,7 @@ Namespace API.Reddit
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataChannel(PostID, Token)
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, $"channel data downloading error [{URL}]")
HasError = True
@@ -279,15 +288,16 @@ Namespace API.Reddit
End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Try
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(p) p.Type = UTypes.VideoPre) Then
Dim r$, v$
Dim e As New ErrorsDescriber(EDP.ReturnValue)
Dim m As UserMedia
For i% = _TempMediaList.Count - 1 To 0 Step -1
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i)
r = GetSiteResponse(m.URL)
r = GetSiteResponse(m.URL, e)
_TempMediaList(i) = New UserMedia
If Not r.IsEmptyString Then
v = RegexReplace(r, VideoRegEx)
@@ -301,6 +311,7 @@ Namespace API.Reddit
Next
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "video reparsing error")
End Try
@@ -326,7 +337,7 @@ Namespace API.Reddit
If _URL.IsEmptyString And t = UTypes.Picture Then Return Nothing
_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 = CStr(RegexReplace(m.URL, FilesPattern)) Else m.File = Nothing
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = UrlToFile(m.URL) Else m.File = Nothing
If m.URL.Contains("preview") Then m.URL = $"https://i.redd.it/{m.File.File}"
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, If(IsChannel, DateProviderChannel, DateProvider), Nothing) Else m.Post.Date = Nothing
Return m
@@ -342,11 +353,15 @@ Namespace API.Reddit
Return False
End Try
End Function
Private Shared Function UrlToFile(ByVal URL As String) As SFile
Return CStr(RegexReplace(URL, FilesPattern))
End Function
#End Region
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Try
Dim i%
Token.ThrowIfCancellationRequested()
Dim dCount% = 0, dTotal% = 0
ThrowAny(Token)
If _ContentNew.Count > 0 Then
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then
@@ -386,12 +401,11 @@ Namespace API.Reddit
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
Progress.TotalCount += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
v = _ContentNew(i)
v.State = UStates.Tried
If v.Type = UTypes.Picture Then v.File = v.URL
If v.File.IsEmptyString Then
f = v.URL
f = UrlToFile(v.URL)
Else
f = v.File
End If
@@ -425,6 +439,7 @@ Namespace API.Reddit
v.File = f
v.Post.CachedFile = f
v.State = UStates.Downloaded
dCount += 1
End If
Catch wex As Exception
If Not IsChannel Then ErrorDownloading(f, v.URL)
@@ -433,29 +448,40 @@ Namespace API.Reddit
v.State = UStates.Skipped
End If
_ContentNew(i) = v
Progress.Perform()
If (CreatedByChannel And Settings.FromChannelDownloadTopUse And dCount >= Settings.FromChannelDownloadTop) Or
(DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value) Then
Progress.Perform(_ContentNew.Count - dTotal)
Exit Sub
Else
dTotal += 1
Progress.Perform()
End If
Next
End Using
End If
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "content downloading error")
HasError = True
End Try
End Sub
Protected Function GetSiteResponse(ByVal URL As String) As String
Protected Function GetSiteResponse(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As String
Try
Return Settings.Site(Sites.Reddit).Responser.GetResponse(URL,, EDP.ThrowException)
Catch ex As Exception
HasError = True
Dim e As EDP = EDP.SendInLog
Dim OptText$ = String.Empty
If Settings.Site(Sites.Reddit).Responser.StatusCode = HttpStatusCode.NotFound Then
e += EDP.ThrowException
OptText = ": USER NOT FOUND"
Else
e += EDP.ReturnValue
If Not e.Exists Then
Dim ee As EDP = EDP.SendInLog
If Settings.Site(Sites.Reddit).Responser.StatusCode = HttpStatusCode.NotFound Then
ee += EDP.ThrowException
OptText = ": USER NOT FOUND"
Else
ee += EDP.ReturnValue
End If
e = New ErrorsDescriber(ee)
End If
Return ErrorsDescriber.Execute(e, ex, $"[{Site} - {Name}: GetSiteResponse([{URL}])]{OptText}", String.Empty)
End Try

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

@@ -58,13 +58,13 @@ Namespace API.Twitter
URL = $"https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name={Name}&count=200&exclude_replies=false&include_rts=1&tweet_mode=extended"
If Not POST.IsEmptyString Then URL &= $"&max_id={POST}"
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
Dim r$ = Settings.Site(Sites.Twitter).Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r)
If Not w Is Nothing AndAlso w.Count > 0 Then
For Each nn In w
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
If nn.Count > 0 Then
PostID = nn.Value("id")
If ID.IsEmptyString Then
@@ -107,6 +107,7 @@ Namespace API.Twitter
If Not PostID.IsEmptyString And NewPostDetected Then DownloadData(PostID, Token)
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, $"data downloading error [{URL}]")
HasError = True
@@ -206,7 +207,7 @@ Namespace API.Twitter
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Try
Dim i%
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
If _ContentNew.Count > 0 Then
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then
@@ -219,7 +220,7 @@ Namespace API.Twitter
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
MainProgress.TotalCount += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1
Token.ThrowIfCancellationRequested()
ThrowAny(Token)
v = _ContentNew(i)
v.State = UStates.Tried
If v.File.IsEmptyString Then
@@ -255,6 +256,7 @@ Namespace API.Twitter
End If
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
LogError(ex, "content downloading error")
HasError = True

43
SCrawler/API/UserDataBind.vb
View File

@@ -20,6 +20,14 @@ Namespace API
ChangeCollectionName(NewName, True)
End Set
End Property
Friend Overrides Property Name As String
Get
Return CollectionName
End Get
Set(ByVal NewCollectionName As String)
CollectionName = NewCollectionName
End Set
End Property
Friend Overrides Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
_CollectionName = NewName
If Count > 0 Then Collections.ForEach(Sub(c) c.CollectionName = NewName)
@@ -233,22 +241,17 @@ Namespace API
Friend Overrides Sub LoadContentInformation()
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation())
End Sub
Friend Overrides Property DownloadReparseOnly As Boolean
Get
If Count > 0 Then Return Collections(0).DownloadReparseOnly Else Return False
End Get
Set(ByVal DRO As Boolean)
If Count > 0 Then Collections.ForEach(Sub(u) u.DownloadReparseOnly = DRO)
End Set
End Property
Friend Overrides ReadOnly Property DataForReparseExists As Boolean
Friend Overrides Property DownloadTopCount As Integer?
Get
If Count > 0 Then
Return Collections.Exists(Function(u) u.DataForReparseExists)
Return Collections(0).DownloadTopCount
Else
Return False
Return Nothing
End If
End Get
Set(ByVal NewLimit As Integer?)
If Count > 0 Then Collections.ForEach(Sub(c) c.DownloadTopCount = NewLimit)
End Set
End Property
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
If Count > 0 Then Downloader.AddRange(Collections)
@@ -282,16 +285,24 @@ Namespace API
Return False
End Get
End Property
''' <exception cref="InvalidOperationException"></exception>
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
With _Item
.Temporary = Temporary
.Favorite = Favorite
ImageHandler(_Item, False)
AddHandler _Item.OnPictureUpdated, AddressOf User_OnPictureUpdated
Dim m As Boolean = DataMerging
If .MoveFiles(CollectionName, m) Then
Collections.Add(_Item)
DirectCast(_Item, UserDataBase).CreateButtons(Count - 1)
With Collections.Last
If Collections.Count - 1 > 0 Then
.Temporary = Temporary
.Favorite = Favorite
.UpdateUserInformation()
End If
ImageHandler(_Item, False)
AddHandler .OnPictureUpdated, AddressOf User_OnPictureUpdated
DirectCast(.Self, UserDataBase).CreateButtons(Count - 1)
End With
Else
Throw New InvalidOperationException("User data doe not move to the collection folder")
End If
End With
End Sub

64
SCrawler/Channels/ChannelViewForm.vb
View File

@@ -11,6 +11,28 @@ Imports CmbDefaultButtons = PersonalUtilities.Forms.Controls.Base.ActionButton.D
Imports RButton = PersonalUtilities.Tools.RangeSwitcherButton.Types
Friend Class ChannelViewForm : Implements IChannelLimits
Friend Event OnUsersAdded(ByVal StartIndex As Integer)
#Region "Appended user structure"
Private Structure PendingUser
Friend ID As String
Friend File As SFile
Friend Sub New(ByVal _ID As String, Optional ByVal _File As SFile = Nothing)
ID = _ID
If Settings.FromChannelCopyImageToUser Then File = _File
End Sub
Public Shared Widening Operator CType(ByVal _ID As String) As PendingUser
Return New PendingUser(_ID, False)
End Operator
Public Shared Widening Operator CType(ByVal u As PendingUser) As String
Return u.ToString
End Operator
Public Overrides Function ToString() As String
Return ID
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Return Obj.ToString = ID
End Function
End Structure
#End Region
#Region "Declarations"
Private ReadOnly MyDefs As DefaultFormProps
#Region "Controls"
@@ -84,7 +106,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Private Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit
End Sub
#End Region
Friend ReadOnly PendingUsers As List(Of String)
Private ReadOnly PendingUsers As List(Of PendingUser)
Private ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)
Private WithEvents MyRange As RangeSwitcher(Of UserPost)
Private ReadOnly SelectorExpression As Predicate(Of UserPost) = Function(ByVal Post As UserPost) As Boolean
@@ -106,7 +128,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
CProgress = New MyProgress(ToolbarBOTTOM, PR_CN, LBL_STATUS, "Downloading data") With {.PerformMod = 10, .DropCurrentProgressOnTotalChange = False}
CProvider = New ANumbers(ANumbers.Modes.USA) With {.GroupSize = 3, .DecimalDigits = 0}
LimitProvider = New ADateTime("dd.MM.yyyy HH:mm")
PendingUsers = New List(Of String)
PendingUsers = New List(Of PendingUser)
CMB_CHANNELS = New ComboBoxExtended With {
.CaptionMode = ICaptionControl.Modes.CheckBox,
@@ -179,6 +201,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End With
CMB_CHANNELS.Enabled(False) = Not CMB_CHANNELS.Checked
MyDefs.EndLoaderOperations()
SetLimitsByChannel(, False)
End Sub
Private Sub ChannelViewForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
AppendPendingUsers()
@@ -235,7 +258,9 @@ Friend Class ChannelViewForm : Implements IChannelLimits
#Region "Images refill methods"
Private Sub AppendPendingUsers()
If LIST_POSTS.CheckedIndices.Count > 0 Then
PendingUsers.ListAddList((From p As ListViewItem In LIST_POSTS.Items Where p.Checked Select p.Text), LNC)
PendingUsers.ListAddList((From p As ListViewItem In LIST_POSTS.Items
Where p.Checked
Select New PendingUser(p.Text, GetPostBySelected(CStr(p.Tag)).CachedFile)), LNC)
Dim a As Action = Sub() BTT_ADD_USERS.Text = $"Add ({PendingUsers.Count.ToString(CProvider)})"
If ToolbarTOP.InvokeRequired Then ToolbarTOP.Invoke(a) Else a.Invoke
End If
@@ -352,12 +377,12 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End If
End Try
End Sub
Private Function GetCurrentChannel() As Channel
Private Function GetCurrentChannel(Optional ByVal ShowExclamation As Boolean = True) As Channel
If CMB_CHANNELS.SelectedIndex >= 0 Then
Dim ChannelID$ = CMB_CHANNELS.Value
If Not ChannelID.IsEmptyString Then Return Settings.Channels.Find(ChannelID)
Else
MsgBoxE("No one channel selected", MsgBoxStyle.Exclamation)
If ShowExclamation Then MsgBoxE("No one channel selected", MsgBoxStyle.Exclamation)
End If
Return Nothing
End Function
@@ -380,19 +405,22 @@ Friend Class ChannelViewForm : Implements IChannelLimits
If PendingUsers.Count > 0 Then
Dim Added% = 0, Skipped% = 0
Dim StartIndex% = Settings.Users.Count
Dim f As SFile
Settings.Labels.Add(CannelsLabelName)
Settings.Labels.Add(LabelsKeeper.NoParsedUser)
Dim rUsers$() = UserBanned(PendingUsers.ToArray)
Dim rUsers$() = UserBanned(PendingUsers.Select(Function(u) u.ID).ToArray)
If rUsers.ListExists Then PendingUsers.RemoveAll(Function(u) rUsers.Contains(u))
If PendingUsers.Count > 0 Then
With PendingUsers.Select(Function(u) New UserInfo(u, Sites.Reddit))
For i = 0 To .Count - 1
If Not Settings.UsersList.Contains(.ElementAt(i)) Then
f = PendingUsers(i).File
Settings.UpdateUsersList(.ElementAt(i))
Settings.Users.Add(New UserData(.ElementAt(i), False) With {.Temporary = True})
Settings.Users.Add(New UserData(.ElementAt(i), False) With {.Temporary = True, .CreatedByChannel = True})
With Settings.Users.Last
.Labels.Add(CannelsLabelName)
.UpdateUserInformation()
If Settings.FromChannelCopyImageToUser And Not f.IsEmptyString And Not .File.IsEmptyString Then CopyFile(f, .File)
End With
Added += 1
Else
@@ -409,6 +437,17 @@ Friend Class ChannelViewForm : Implements IChannelLimits
MsgBoxE("No one users selected for add to collection")
End If
End Sub
Private Sub CopyFile(ByVal Source As SFile, ByVal Destination As SFile)
Try
If Not Source.IsEmptyString And Not Destination.IsEmptyString Then
Destination = Destination.CutPath.PathWithSeparator & "ChannelImage\"
Destination.Name = Source.Name
Destination.Extension = Source.Extension
If Source.Exists AndAlso Destination.Exists(SFO.Path) Then IO.File.Copy(Source, Destination)
End If
Catch ex As Exception
End Try
End Sub
#Region "Limits changer"
Private Sub OPT_LIMITS_DEFAULT_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_LIMITS_DEFAULT.CheckedChanged
If OPT_LIMITS_DEFAULT.Checked Then
@@ -444,9 +483,9 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End Sub
#End Region
#Region "CMB_CHANNELS"
Private Sub SetLimitsByChannel(Optional ByVal SelectedChannel As Channel = Nothing)
Private Sub SetLimitsByChannel(Optional ByVal SelectedChannel As Channel = Nothing, Optional ByVal ShowExclamation As Boolean = True)
LBL_STATUS.Text = String.Empty
Dim c As Channel = If(SelectedChannel, GetCurrentChannel())
Dim c As Channel = If(SelectedChannel, GetCurrentChannel(ShowExclamation))
LBL_LIMIT_TEXT.Text = String.Empty
If Not c Is Nothing Then
Settings.LatestSelectedChannel.Value = c.ID
@@ -500,6 +539,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Else
CMB_CHANNELS.Button(ActionButton.BTT_UP_NAME).Enabled = False
CMB_CHANNELS.Button(ActionButton.BTT_DOWN_NAME).Enabled = False
SetLimitsByChannel()
End If
End Sub
Private Sub AddNewChannel()
@@ -642,11 +682,11 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Dim f As SFile = GetPostBySelected().CachedFile
If f.Exists Then f.Open() Else MsgBoxE($"Picture file [{f}] does not found", MsgBoxStyle.Critical)
End Sub
Private Function GetPostBySelected() As UserPost
Private Function GetPostBySelected(Optional ByVal SpecificTag As String = Nothing) As UserPost
Dim p As UserPost = Nothing
Try
If LIST_POSTS.SelectedItems.Count > 0 Then
Dim t$ = LIST_POSTS.SelectedItems(0).Tag
If LIST_POSTS.SelectedItems.Count > 0 Or Not SpecificTag.IsEmptyString Then
Dim t$ = If(SpecificTag.IsEmptyString, LIST_POSTS.SelectedItems(0).Tag, SpecificTag)
With Settings.Channels.Find(CMB_CHANNELS.Value)
If .Count > 0 Then p = .Posts.Find(Function(pp) pp.ID = t)
End With

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

@@ -22,6 +22,8 @@
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_IMAGES As System.Windows.Forms.TableLayoutPanel
Dim TP_CHANNELS_IMGS As System.Windows.Forms.TableLayoutPanel
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.TXT_GLOBAL_PATH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_SEPARATE_VIDEO_FOLDER = New System.Windows.Forms.CheckBox()
@@ -31,6 +33,11 @@
Me.CH_DEF_TEMP = New System.Windows.Forms.CheckBox()
Me.TXT_CHANNELS_ROWS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_CHANNELS_COLUMNS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_CHANNEL_USER_POST_LIMIT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_COPY_CHANNEL_USER_IMAGE = New System.Windows.Forms.CheckBox()
Me.CH_CHECK_VER_START = New System.Windows.Forms.CheckBox()
Me.TXT_MAX_JOBS_USERS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_MAX_JOBS_CHANNELS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_IMAGES = New System.Windows.Forms.TableLayoutPanel()
@@ -45,6 +52,9 @@
TP_CHANNELS_IMGS.SuspendLayout()
CType(Me.TXT_CHANNELS_ROWS, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_CHANNELS_COLUMNS, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_CHANNEL_USER_POST_LIMIT, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_MAX_JOBS_USERS, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_MAX_JOBS_CHANNELS, System.ComponentModel.ISupportInitialize).BeginInit()
Me.CONTAINER_MAIN.ContentPanel.SuspendLayout()
Me.CONTAINER_MAIN.SuspendLayout()
Me.SuspendLayout()
@@ -60,17 +70,27 @@
TP_MAIN.Controls.Add(TP_IMAGES, 0, 1)
TP_MAIN.Controls.Add(Me.CH_DEF_TEMP, 0, 3)
TP_MAIN.Controls.Add(TP_CHANNELS_IMGS, 0, 5)
TP_MAIN.Controls.Add(Me.TXT_CHANNEL_USER_POST_LIMIT, 0, 6)
TP_MAIN.Controls.Add(Me.CH_COPY_CHANNEL_USER_IMAGE, 0, 7)
TP_MAIN.Controls.Add(Me.CH_CHECK_VER_START, 0, 8)
TP_MAIN.Controls.Add(Me.TXT_MAX_JOBS_USERS, 0, 9)
TP_MAIN.Controls.Add(Me.TXT_MAX_JOBS_CHANNELS, 0, 10)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 6
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 16.66667!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 16.66667!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 16.66667!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 16.66667!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 16.66667!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 16.66667!))
TP_MAIN.Size = New System.Drawing.Size(584, 191)
TP_MAIN.RowCount = 11
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.090549!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.090549!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.090549!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.090549!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.090549!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.090549!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.092355!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.092355!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.091001!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.09009!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 9.09091!))
TP_MAIN.Size = New System.Drawing.Size(584, 337)
TP_MAIN.TabIndex = 0
'
'TXT_GLOBAL_PATH
@@ -96,10 +116,10 @@
'
Me.CH_SEPARATE_VIDEO_FOLDER.AutoSize = True
Me.CH_SEPARATE_VIDEO_FOLDER.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_SEPARATE_VIDEO_FOLDER.Location = New System.Drawing.Point(4, 66)
Me.CH_SEPARATE_VIDEO_FOLDER.Location = New System.Drawing.Point(4, 64)
Me.CH_SEPARATE_VIDEO_FOLDER.Name = "CH_SEPARATE_VIDEO_FOLDER"
Me.CH_SEPARATE_VIDEO_FOLDER.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_SEPARATE_VIDEO_FOLDER.Size = New System.Drawing.Size(576, 24)
Me.CH_SEPARATE_VIDEO_FOLDER.Size = New System.Drawing.Size(576, 23)
Me.CH_SEPARATE_VIDEO_FOLDER.TabIndex = 2
Me.CH_SEPARATE_VIDEO_FOLDER.Text = "Separate video folders"
TT_MAIN.SetToolTip(Me.CH_SEPARATE_VIDEO_FOLDER, resources.GetString("CH_SEPARATE_VIDEO_FOLDER.ToolTip"))
@@ -115,7 +135,7 @@
Me.TXT_COLLECTIONS_PATH.CaptionToolTipEnabled = True
Me.TXT_COLLECTIONS_PATH.CaptionToolTipText = "Set collections folder name (name only)"
Me.TXT_COLLECTIONS_PATH.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_COLLECTIONS_PATH.Location = New System.Drawing.Point(4, 128)
Me.TXT_COLLECTIONS_PATH.Location = New System.Drawing.Point(4, 124)
Me.TXT_COLLECTIONS_PATH.Name = "TXT_COLLECTIONS_PATH"
Me.TXT_COLLECTIONS_PATH.Size = New System.Drawing.Size(576, 22)
Me.TXT_COLLECTIONS_PATH.TabIndex = 4
@@ -128,13 +148,13 @@
TP_IMAGES.Controls.Add(Me.TXT_IMAGE_LARGE, 0, 0)
TP_IMAGES.Controls.Add(Me.TXT_IMAGE_SMALL, 1, 0)
TP_IMAGES.Dock = System.Windows.Forms.DockStyle.Fill
TP_IMAGES.Location = New System.Drawing.Point(1, 32)
TP_IMAGES.Location = New System.Drawing.Point(1, 31)
TP_IMAGES.Margin = New System.Windows.Forms.Padding(0)
TP_IMAGES.Name = "TP_IMAGES"
TP_IMAGES.RowCount = 1
TP_IMAGES.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_IMAGES.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_IMAGES.Size = New System.Drawing.Size(582, 30)
TP_IMAGES.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 29.0!))
TP_IMAGES.Size = New System.Drawing.Size(582, 29)
TP_IMAGES.TabIndex = 1
'
'TXT_IMAGE_LARGE
@@ -173,10 +193,10 @@
'
Me.CH_DEF_TEMP.AutoSize = True
Me.CH_DEF_TEMP.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DEF_TEMP.Location = New System.Drawing.Point(4, 97)
Me.CH_DEF_TEMP.Location = New System.Drawing.Point(4, 94)
Me.CH_DEF_TEMP.Name = "CH_DEF_TEMP"
Me.CH_DEF_TEMP.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_DEF_TEMP.Size = New System.Drawing.Size(576, 24)
Me.CH_DEF_TEMP.Size = New System.Drawing.Size(576, 23)
Me.CH_DEF_TEMP.TabIndex = 3
Me.CH_DEF_TEMP.Text = "Temporary default"
TT_MAIN.SetToolTip(Me.CH_DEF_TEMP, "Default value on user creating")
@@ -190,13 +210,13 @@
TP_CHANNELS_IMGS.Controls.Add(Me.TXT_CHANNELS_ROWS, 0, 0)
TP_CHANNELS_IMGS.Controls.Add(Me.TXT_CHANNELS_COLUMNS, 1, 0)
TP_CHANNELS_IMGS.Dock = System.Windows.Forms.DockStyle.Fill
TP_CHANNELS_IMGS.Location = New System.Drawing.Point(1, 156)
TP_CHANNELS_IMGS.Location = New System.Drawing.Point(1, 151)
TP_CHANNELS_IMGS.Margin = New System.Windows.Forms.Padding(0)
TP_CHANNELS_IMGS.Name = "TP_CHANNELS_IMGS"
TP_CHANNELS_IMGS.RowCount = 1
TP_CHANNELS_IMGS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_CHANNELS_IMGS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 34.0!))
TP_CHANNELS_IMGS.Size = New System.Drawing.Size(582, 34)
TP_CHANNELS_IMGS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 29.0!))
TP_CHANNELS_IMGS.Size = New System.Drawing.Size(582, 29)
TP_CHANNELS_IMGS.TabIndex = 5
'
'TXT_CHANNELS_ROWS
@@ -227,19 +247,103 @@
Me.TXT_CHANNELS_COLUMNS.Text = "0"
Me.TXT_CHANNELS_COLUMNS.TextBoxTextAlign = System.Windows.Forms.HorizontalAlignment.Center
'
'TXT_CHANNEL_USER_POST_LIMIT
'
Me.TXT_CHANNEL_USER_POST_LIMIT.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.CheckBox
Me.TXT_CHANNEL_USER_POST_LIMIT.CaptionSizeType = System.Windows.Forms.SizeType.Percent
Me.TXT_CHANNEL_USER_POST_LIMIT.CaptionText = "Download limit for channel user"
Me.TXT_CHANNEL_USER_POST_LIMIT.CaptionToolTipText = "Set count of downloading posts limit if user added from channel"
Me.TXT_CHANNEL_USER_POST_LIMIT.CaptionWidth = 50.0R
Me.TXT_CHANNEL_USER_POST_LIMIT.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.TXT_CHANNEL_USER_POST_LIMIT.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_CHANNEL_USER_POST_LIMIT.Location = New System.Drawing.Point(4, 184)
Me.TXT_CHANNEL_USER_POST_LIMIT.Name = "TXT_CHANNEL_USER_POST_LIMIT"
Me.TXT_CHANNEL_USER_POST_LIMIT.NumberMaximum = New Decimal(New Integer() {1000, 0, 0, 0})
Me.TXT_CHANNEL_USER_POST_LIMIT.NumberMinimum = New Decimal(New Integer() {1, 0, 0, 0})
Me.TXT_CHANNEL_USER_POST_LIMIT.Size = New System.Drawing.Size(576, 22)
Me.TXT_CHANNEL_USER_POST_LIMIT.TabIndex = 6
Me.TXT_CHANNEL_USER_POST_LIMIT.Text = "1"
Me.TXT_CHANNEL_USER_POST_LIMIT.TextBoxTextAlign = System.Windows.Forms.HorizontalAlignment.Center
'
'CH_COPY_CHANNEL_USER_IMAGE
'
Me.CH_COPY_CHANNEL_USER_IMAGE.AutoSize = True
Me.CH_COPY_CHANNEL_USER_IMAGE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_COPY_CHANNEL_USER_IMAGE.Location = New System.Drawing.Point(4, 214)
Me.CH_COPY_CHANNEL_USER_IMAGE.Name = "CH_COPY_CHANNEL_USER_IMAGE"
Me.CH_COPY_CHANNEL_USER_IMAGE.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_COPY_CHANNEL_USER_IMAGE.Size = New System.Drawing.Size(576, 23)
Me.CH_COPY_CHANNEL_USER_IMAGE.TabIndex = 7
Me.CH_COPY_CHANNEL_USER_IMAGE.Text = "Copy channel user image"
TT_MAIN.SetToolTip(Me.CH_COPY_CHANNEL_USER_IMAGE, "Copy image posted by user (in the channel you added from) to the user destination" &
" folder.")
Me.CH_COPY_CHANNEL_USER_IMAGE.UseVisualStyleBackColor = True
'
'CH_CHECK_VER_START
'
Me.CH_CHECK_VER_START.AutoSize = True
Me.CH_CHECK_VER_START.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_CHECK_VER_START.Location = New System.Drawing.Point(4, 244)
Me.CH_CHECK_VER_START.Name = "CH_CHECK_VER_START"
Me.CH_CHECK_VER_START.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_CHECK_VER_START.Size = New System.Drawing.Size(576, 23)
Me.CH_CHECK_VER_START.TabIndex = 8
Me.CH_CHECK_VER_START.Text = "Check new version at start"
Me.CH_CHECK_VER_START.UseVisualStyleBackColor = True
'
'TXT_MAX_JOBS_USERS
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Index = 0
ActionButton4.Name = "BTT_REFRESH"
ActionButton4.ToolTipText = "Set to default"
Me.TXT_MAX_JOBS_USERS.Buttons.Add(ActionButton4)
Me.TXT_MAX_JOBS_USERS.CaptionSizeType = System.Windows.Forms.SizeType.Percent
Me.TXT_MAX_JOBS_USERS.CaptionText = "Maximum downloading tasks of users"
Me.TXT_MAX_JOBS_USERS.CaptionWidth = 50.0R
Me.TXT_MAX_JOBS_USERS.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.TXT_MAX_JOBS_USERS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_MAX_JOBS_USERS.Location = New System.Drawing.Point(4, 274)
Me.TXT_MAX_JOBS_USERS.Name = "TXT_MAX_JOBS_USERS"
Me.TXT_MAX_JOBS_USERS.NumberMinimum = New Decimal(New Integer() {1, 0, 0, 0})
Me.TXT_MAX_JOBS_USERS.Size = New System.Drawing.Size(576, 22)
Me.TXT_MAX_JOBS_USERS.TabIndex = 9
Me.TXT_MAX_JOBS_USERS.Text = "1"
Me.TXT_MAX_JOBS_USERS.TextBoxTextAlign = System.Windows.Forms.HorizontalAlignment.Center
'
'TXT_MAX_JOBS_CHANNELS
'
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Index = 0
ActionButton5.Name = "BTT_REFRESH"
ActionButton5.ToolTipText = "Set to default"
Me.TXT_MAX_JOBS_CHANNELS.Buttons.Add(ActionButton5)
Me.TXT_MAX_JOBS_CHANNELS.CaptionSizeType = System.Windows.Forms.SizeType.Percent
Me.TXT_MAX_JOBS_CHANNELS.CaptionText = "Maximum downloading tasks of channels"
Me.TXT_MAX_JOBS_CHANNELS.CaptionWidth = 50.0R
Me.TXT_MAX_JOBS_CHANNELS.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.TXT_MAX_JOBS_CHANNELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_MAX_JOBS_CHANNELS.Location = New System.Drawing.Point(4, 304)
Me.TXT_MAX_JOBS_CHANNELS.Name = "TXT_MAX_JOBS_CHANNELS"
Me.TXT_MAX_JOBS_CHANNELS.NumberMinimum = New Decimal(New Integer() {1, 0, 0, 0})
Me.TXT_MAX_JOBS_CHANNELS.Size = New System.Drawing.Size(576, 22)
Me.TXT_MAX_JOBS_CHANNELS.TabIndex = 10
Me.TXT_MAX_JOBS_CHANNELS.Text = "1"
Me.TXT_MAX_JOBS_CHANNELS.TextBoxTextAlign = System.Windows.Forms.HorizontalAlignment.Center
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
Me.CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(584, 191)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(584, 337)
Me.CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_MAIN.LeftToolStripPanelVisible = False
Me.CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
Me.CONTAINER_MAIN.Name = "CONTAINER_MAIN"
Me.CONTAINER_MAIN.RightToolStripPanelVisible = False
Me.CONTAINER_MAIN.Size = New System.Drawing.Size(584, 191)
Me.CONTAINER_MAIN.Size = New System.Drawing.Size(584, 337)
Me.CONTAINER_MAIN.TabIndex = 0
Me.CONTAINER_MAIN.TopToolStripPanelVisible = False
'
@@ -247,14 +351,14 @@
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(584, 191)
Me.ClientSize = New System.Drawing.Size(584, 337)
Me.Controls.Add(Me.CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(600, 230)
Me.MaximumSize = New System.Drawing.Size(600, 376)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(600, 230)
Me.MinimumSize = New System.Drawing.Size(600, 376)
Me.Name = "GlobalSettingsForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
@@ -270,6 +374,9 @@
TP_CHANNELS_IMGS.ResumeLayout(False)
CType(Me.TXT_CHANNELS_ROWS, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_CHANNELS_COLUMNS, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_CHANNEL_USER_POST_LIMIT, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_MAX_JOBS_USERS, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_MAX_JOBS_CHANNELS, System.ComponentModel.ISupportInitialize).EndInit()
Me.CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
Me.CONTAINER_MAIN.ResumeLayout(False)
Me.CONTAINER_MAIN.PerformLayout()
@@ -283,8 +390,13 @@
Private WithEvents TXT_COLLECTIONS_PATH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_IMAGE_LARGE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_IMAGE_SMALL As PersonalUtilities.Forms.Controls.TextBoxExtended
Friend WithEvents CH_DEF_TEMP As CheckBox
Private WithEvents TXT_CHANNELS_ROWS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_CHANNELS_COLUMNS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_CHANNEL_USER_POST_LIMIT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_COPY_CHANNEL_USER_IMAGE As CheckBox
Private WithEvents CH_DEF_TEMP As CheckBox
Private WithEvents CH_CHECK_VER_START As CheckBox
Private WithEvents TXT_MAX_JOBS_USERS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_MAX_JOBS_CHANNELS As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

32
SCrawler/Editors/GlobalSettingsForm.resx
View File

@@ -165,4 +165,36 @@ If checked then videos will be stored in separated folder; otherwise, videos wil
<metadata name="TP_CHANNELS_IMGS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
</root>

39
SCrawler/Editors/GlobalSettingsForm.vb
View File

@@ -23,6 +23,12 @@ Namespace Editors
CH_DEF_TEMP.Checked = .DefaultTemporary.Value
TXT_CHANNELS_COLUMNS.Value = .ChannelsImagesColumns.Value
TXT_CHANNELS_ROWS.Value = .ChannelsImagesRows.Value
TXT_CHANNEL_USER_POST_LIMIT.Value = .FromChannelDownloadTop.Value
TXT_CHANNEL_USER_POST_LIMIT.Checked = .FromChannelDownloadTopUse.Value
CH_COPY_CHANNEL_USER_IMAGE.Checked = .FromChannelCopyImageToUser
CH_CHECK_VER_START.Checked = .CheckUpdatesAtStart
TXT_MAX_JOBS_USERS.Value = .MaxUsersJobsCount.Value
TXT_MAX_JOBS_CHANNELS.Value = .ChannelsMaxJobsCount.Value
End With
.MyFieldsChecker = New FieldsChecker
With .MyFieldsChecker
@@ -40,6 +46,27 @@ Namespace Editors
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK
If MyDefs.MyFieldsChecker.AllParamsOK Then
With Settings
Dim a As Func(Of String, Object, Integer) =
Function(t, v) MsgBoxE({$"You are set up higher than default count of along {t} downloading tasks." & vbNewLine &
$"Default: {SettingsCLS.DefaultMaxDownloadingTasks}" & vbNewLine &
$"Your value: {CInt(v)}" & vbNewLine &
"Increasing this value may lead to higher CPU usage." & vbNewLine &
"Do you really want to continue?",
"Increasing download tasks"},
vbExclamation,,, {"Confirm", $"Set to default ({SettingsCLS.DefaultMaxDownloadingTasks})", "Cancel"})
If CInt(TXT_MAX_JOBS_USERS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then
Select Case a.Invoke("users", TXT_MAX_JOBS_USERS.Value)
Case 1 : TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks
Case 2 : Exit Sub
End Select
End If
If CInt(TXT_MAX_JOBS_CHANNELS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then
Select Case a.Invoke("channels", TXT_MAX_JOBS_CHANNELS.Value)
Case 1 : TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks
Case 2 : Exit Sub
End Select
End If
.BeginUpdate()
.GlobalPath.Value = TXT_GLOBAL_PATH.Text
.MaxLargeImageHeigh.Value = CInt(TXT_IMAGE_LARGE.Value)
.MaxSmallImageHeigh.Value = CInt(TXT_IMAGE_SMALL.Value)
@@ -48,6 +75,12 @@ Namespace Editors
.DefaultTemporary.Value = CH_DEF_TEMP.Checked
.ChannelsImagesRows.Value = CInt(TXT_CHANNELS_ROWS.Value)
.ChannelsImagesColumns.Value = CInt(TXT_CHANNELS_COLUMNS.Value)
.FromChannelDownloadTopUse.Value = TXT_CHANNEL_USER_POST_LIMIT.Checked
.FromChannelDownloadTop.Value = CInt(TXT_CHANNEL_USER_POST_LIMIT.Value)
.FromChannelCopyImageToUser.Value = CH_COPY_CHANNEL_USER_IMAGE.Checked
.CheckUpdatesAtStart.Value = CH_CHECK_VER_START.Checked
.MaxUsersJobsCount.Value = CInt(TXT_MAX_JOBS_USERS.Value)
.EndUpdate()
End With
MyDefs.CloseForm()
End If
@@ -61,5 +94,11 @@ Namespace Editors
If Not f.IsEmptyString Then TXT_GLOBAL_PATH.Text = f
End If
End Sub
Private Sub TXT_MAX_JOBS_USERS_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_MAX_JOBS_USERS.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Refresh Then TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks
End Sub
Private Sub TXT_MAX_JOBS_CHANNELS_ActionOnButtonClick(ByVal Sender As ActionButton) Handles TXT_MAX_JOBS_CHANNELS.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Refresh Then TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks
End Sub
End Class
End Namespace

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

@@ -13,10 +13,10 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(LabelsForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton6 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
Me.CMB_LABELS = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.CONTAINER_MAIN.ContentPanel.SuspendLayout()
@@ -42,21 +42,21 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
'
'CMB_LABELS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Index = 0
ActionButton1.Name = "BTT_COMBOBOX_ARROW"
ActionButton1.Visible = False
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Index = 1
ActionButton2.Name = "BTT_ADD"
ActionButton2.ToolTipText = "Add new label (Insert)"
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Index = 2
ActionButton3.Name = "BTT_CLEAR"
ActionButton3.ToolTipText = "Clear checked labels"
Me.CMB_LABELS.Buttons.Add(ActionButton1)
Me.CMB_LABELS.Buttons.Add(ActionButton2)
Me.CMB_LABELS.Buttons.Add(ActionButton3)
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Index = 0
ActionButton4.Name = "BTT_COMBOBOX_ARROW"
ActionButton4.Visible = False
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Index = 1
ActionButton5.Name = "BTT_ADD"
ActionButton5.ToolTipText = "Add new label (Insert)"
ActionButton6.BackgroundImage = CType(resources.GetObject("ActionButton6.BackgroundImage"), System.Drawing.Image)
ActionButton6.Index = 2
ActionButton6.Name = "BTT_CLEAR"
ActionButton6.ToolTipText = "Clear checked labels"
Me.CMB_LABELS.Buttons.Add(ActionButton4)
Me.CMB_LABELS.Buttons.Add(ActionButton5)
Me.CMB_LABELS.Buttons.Add(ActionButton6)
Me.CMB_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_LABELS.ListCheckBoxes = True
Me.CMB_LABELS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
@@ -64,7 +64,7 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
Me.CMB_LABELS.ListMultiSelect = True
Me.CMB_LABELS.Location = New System.Drawing.Point(0, 0)
Me.CMB_LABELS.Name = "CMB_LABELS"
Me.CMB_LABELS.Size = New System.Drawing.Size(374, 421)
Me.CMB_LABELS.Size = New System.Drawing.Size(376, 422)
Me.CMB_LABELS.TabIndex = 0
'
'LabelsForm
@@ -73,6 +73,7 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(374, 421)
Me.Controls.Add(Me.CONTAINER_MAIN)
Me.KeyPreview = True
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(390, 460)
Me.Name = "LabelsForm"

6
SCrawler/Editors/LabelsForm.resx
View File

@@ -118,7 +118,7 @@
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL
@@ -208,7 +208,7 @@
AAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAADmUlE
@@ -230,7 +230,7 @@
0AUyNxOP1DOwcaG/8I+/LRB+At7psBnyDBG0AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton6.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go

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

@@ -217,7 +217,7 @@
Me.CH_READY_FOR_DOWN.Size = New System.Drawing.Size(218, 22)
Me.CH_READY_FOR_DOWN.TabIndex = 1
Me.CH_READY_FOR_DOWN.Text = "Ready for download"
TT_MAIN.SetToolTip(Me.CH_READY_FOR_DOWN, "If checked then this user can be downloaded by [Download All]")
TT_MAIN.SetToolTip(Me.CH_READY_FOR_DOWN, "Can be downloaded by [Download All]")
Me.CH_READY_FOR_DOWN.UseVisualStyleBackColor = True
'
'TXT_DESCR

1
SCrawler/LabelsKeeper.vb
View File

@@ -18,6 +18,7 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
NewLabels = New List(Of String)
CurrentSelection = New List(Of String)
If LabelsFile.Exists Then LabelsList.ListAddList(IO.File.ReadAllLines(LabelsFile), LAP.NotContainsOnly)
LabelsList.ListAddList({NoLabeledName, NoParsedUser}, LAP.NotContainsOnly)
End Sub
Friend ReadOnly Property ToList As List(Of String)
Get

15
SCrawler/MainFrame.Designer.vb generated
View File

@@ -82,6 +82,7 @@ Partial Class MainFrame
Me.BTT_CONTEXT_OPEN_PATH = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_OPEN_SITE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_INFO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_DOWN_LIMITED = 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()
@@ -421,9 +422,9 @@ Partial Class MainFrame
'
'USER_CONTEXT
'
Me.USER_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.BTT_CONTEXT_EDIT, Me.BTT_CONTEXT_DELETE, CONTEXT_SEP_1, Me.BTT_CONTEXT_FAV, Me.BTT_CONTEXT_TEMP, Me.BTT_CONTEXT_GROUPS, Me.BTT_CONTEXT_ADD_TO_COL, Me.BTT_CONTEXT_COL_MERGE, 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_EDIT, Me.BTT_CONTEXT_DELETE, CONTEXT_SEP_1, Me.BTT_CONTEXT_FAV, Me.BTT_CONTEXT_TEMP, Me.BTT_CONTEXT_GROUPS, Me.BTT_CONTEXT_ADD_TO_COL, Me.BTT_CONTEXT_COL_MERGE, 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(196, 298)
Me.USER_CONTEXT.Size = New System.Drawing.Size(196, 342)
'
'BTT_CONTEXT_DOWN
'
@@ -507,6 +508,15 @@ Partial Class MainFrame
Me.BTT_CONTEXT_INFO.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_INFO.Text = "Information"
'
'BTT_CONTEXT_DOWN_LIMITED
'
Me.BTT_CONTEXT_DOWN_LIMITED.AutoToolTip = True
Me.BTT_CONTEXT_DOWN_LIMITED.Image = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_CONTEXT_DOWN_LIMITED.Name = "BTT_CONTEXT_DOWN_LIMITED"
Me.BTT_CONTEXT_DOWN_LIMITED.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_DOWN_LIMITED.Text = "Download data limited"
Me.BTT_CONTEXT_DOWN_LIMITED.ToolTipText = "Download top ... posts"
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -575,4 +585,5 @@ Partial Class MainFrame
Private WithEvents BTT_EDIT_USER As ToolStripButton
Private WithEvents BTT_CONTEXT_GROUPS As ToolStripMenuItem
Private WithEvents BTT_VERSION_INFO As ToolStripButton
Private WithEvents BTT_CONTEXT_DOWN_LIMITED As ToolStripMenuItem
End Class

119
SCrawler/MainFrame.vb
View File

@@ -63,7 +63,6 @@ Public Class MainFrame
RefillList()
UpdateLabelsGroups()
SetShowButtonsCheckers(Settings.ShowingMode.Value)
CheckForReparse()
CheckVersion(False)
_UFinit = False
GoTo EndFunction
@@ -313,7 +312,7 @@ CloseResume:
#End Region
#Region "Download"
Private Sub BTT_DOWN_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_SELECTED.Click
DownloadSelectedUser()
DownloadSelectedUser(False)
End Sub
Private Sub BTT_DOWN_ALL_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_ALL.Click
Downloader.AddRange(Settings.Users.Where(Function(u) u.ReadyForDownload))
@@ -414,11 +413,20 @@ CloseResume:
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
If f.LabelsList.Count > 0 Then
Dim b As Boolean = False
If Settings.Labels.CurrentSelection.Count = 0 Then
b = True
Else
If Settings.Labels.CurrentSelection.Exists(Function(l) Not f.LabelsList.Contains(l)) Then b = True
If Not b AndAlso f.LabelsList.Exists(Function(l) Not Settings.Labels.CurrentSelection.Contains(l)) Then b = True
End If
Settings.Labels.CurrentSelection.ListAddList(f.LabelsList, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
Settings.LatestSelectedLabels.Value = Settings.Labels.CurrentSelection.ListToString(, "|")
If b Then RefillList()
Else
Settings.Labels.CurrentSelection.Clear()
Settings.LatestSelectedLabels.Value = String.Empty
SetShowButtonsCheckers(ShowingModes.All)
End If
End If
End Using
@@ -444,7 +452,10 @@ CloseResume:
End Sub
#Region "Context"
Private Sub BTT_CONTEXT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click
DownloadSelectedUser()
DownloadSelectedUser(False)
End Sub
Private Sub BTT_CONTEXT_DOWN_LIMITED_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN_LIMITED.Click
DownloadSelectedUser(True)
End Sub
Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click
EditSelectedUser()
@@ -477,26 +488,26 @@ CloseResume:
Dim users As List(Of IUserData) = GetSelectedUserArray()
If users.ListExists Then
Dim l As List(Of String) = ListAddList(Nothing, users.SelectMany(Function(u) u.Labels), LAP.NotContainsOnly)
If l.ListExists Then
Using f As New LabelsForm(l) With {.MultiUser = True}
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Dim _lp As LAP = LAP.NotContainsOnly
If f.MultiUserClearExists Then _lp += LAP.ClearBeforeAdd
Dim lp As New ListAddParams(_lp)
users.ForEach(Sub(ByVal u As IUserData)
If u.IsCollection Then
With DirectCast(u, UserDataBind)
If .Count > 0 Then .Collections.ForEach(Sub(uu) uu.Labels.ListAddList(f.LabelsList, lp))
End With
Else
u.Labels.ListAddList(f.LabelsList, lp)
End If
u.UpdateUserInformation()
End Sub)
End If
End Using
End If
Using f As New LabelsForm(l) With {.MultiUser = True}
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Dim _lp As LAP = LAP.NotContainsOnly
If f.MultiUserClearExists Then _lp += LAP.ClearBeforeAdd
Dim lp As New ListAddParams(_lp)
users.ForEach(Sub(ByVal u As IUserData)
If u.IsCollection Then
With DirectCast(u, UserDataBind)
If .Count > 0 Then .Collections.ForEach(Sub(uu) uu.Labels.ListAddList(f.LabelsList, lp))
End With
Else
u.Labels.ListAddList(f.LabelsList, lp)
End If
u.UpdateUserInformation()
End Sub)
End If
End Using
Else
MsgBoxE("No one user does not detected", vbExclamation)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.ShowAllMsg, ex, "[ChangeUserGroups]")
@@ -505,9 +516,9 @@ CloseResume:
Private Function AskForMassReplace(ByVal users As List(Of IUserData), ByVal param As String) As Boolean
Dim u$ = users.ListIfNothing.Take(20).Select(Function(uu) uu.Name).ListToString(, vbCr)
If Not u.IsEmptyString And users.ListExists(21) Then u &= vbCr & "..."
Return users.ListExists AndAlso (users.Count = 1 OrElse MsgBox($"Do you really want to change [{param}] for {users.Count} users?{vbCr}{vbCr}{u}",
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton1,
"Users' change parameter") = MsgBoxResult.Yes)
Return users.ListExists AndAlso (users.Count = 1 OrElse MsgBoxE({$"Do you really want to change [{param}] for {users.Count} users?{vbCr}{vbCr}{u}",
"Users' parameters change"},
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes)
End Function
Private Sub BTT_CHANGE_IMAGE_Click(sender As Object, e As EventArgs) Handles BTT_CHANGE_IMAGE.Click
Dim user As IUserData = GetSelectedUser()
@@ -539,12 +550,22 @@ CloseResume:
.Users.Add(New UserDataBind(f.Collection))
i = .Users.Count - 1
End If
DirectCast(.Users(i), UserDataBind).Add(user)
RemoveUserFromList(user)
i = .Users.FindIndex(fCol)
If i >= 0 Then UserListUpdate(.Users(i), Added) Else RefillList()
Try
DirectCast(.Users(i), UserDataBind).Add(user)
RemoveUserFromList(user)
i = .Users.FindIndex(fCol)
If i >= 0 Then UserListUpdate(.Users(i), Added) Else RefillList()
MsgBoxE($"[{user.Name}] was added to collection [{f.Collection}]")
Catch ex As InvalidOperationException
i = .Users.FindIndex(fCol)
If i >= 0 Then
If DirectCast(.Users(i), UserDataBind).Count = 0 Then
.Users(i).Dispose()
.Users.RemoveAt(i)
End If
End If
End Try
End With
MsgBoxE($"[{user.Name}] was added to collection [{f.Collection}]")
End If
End Using
End If
@@ -667,13 +688,7 @@ CloseResume:
On Error Resume Next
If user.IsCollection Then
If USER_CONTEXT.Visible Then USER_CONTEXT.Hide()
Using f As New CollectionEditorForm(user.CollectionName)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
user.CollectionName = f.Collection
UserListUpdate(user, False)
End If
End Using
MsgBoxE("This is collection!{vbNewLine}Edit collections does not allowed!", vbExclamation)
Else
Using f As New UserCreatorForm(user)
f.ShowDialog()
@@ -736,17 +751,43 @@ CloseResume:
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on trying to delete user / collection")
End Try
End Sub
Private Sub DownloadSelectedUser()
Private Sub DownloadSelectedUser(ByVal UseLimits As Boolean)
Dim users As List(Of IUserData) = GetSelectedUserArray()
If users.ListExists Then
Dim l%? = Nothing
If UseLimits Then
Do
l = AConvert(Of Integer)(InputBoxE("Enter top posts limit for downloading:", "Download limit", 10), Nothing)
If l.HasValue Then
Select Case MsgBoxE(New MMessage($"You are set up downloading top [{l.Value}] posts", "Download limit",
{"Confirm", "Try again", "Disable limit", "Cancel"}) With {.ButtonsPerRow = 2}).Index
Case 0 : Exit Do
Case 2 : l = Nothing
Case 3 : GoTo CancelDownloadingOperation
End Select
Else
Select Case MsgBoxE({"You are not set up downloading limit", "Download limit"},,,, {"Confirm", "Try again", "Cancel"}).Index
Case 0 : Exit Do
Case 2 : GoTo CancelDownloadingOperation
End Select
End If
Loop
End If
If USER_CONTEXT.Visible Then USER_CONTEXT.Hide()
GoTo ResumeDownloadingOperation
CancelDownloadingOperation:
MsgBoxE("Operation canceled")
Exit Sub
ResumeDownloadingOperation:
If users.Count = 1 Then
users(0).DownloadTopCount = l
Downloader.Add(users(0))
Else
Dim uStr$ = users.Select(Function(u) u.ToString()).ListToString(, vbNewLine)
If MsgBoxE({$"You are select {users.Count} users' profiles{vbNewLine}Do you want to download all of them?{vbNewLine.StringDup(2)}" &
$"Selected users:{vbNewLine}{uStr}", "A few users selected"},
MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
users.ForEach(Sub(u) u.DownloadTopCount = l)
Downloader.AddRange(users)
End If
End If

19
SCrawler/MainMod.vb
View File

@@ -74,7 +74,7 @@ Friend Module MainMod
x.Attribute(Name_Collection).Value, x.Attribute(Name_Merged).Value.FromXML(Of Boolean)(False))
IsChannel = x.Attribute(Name_IsChannel).Value.FromXML(Of Boolean)(False)
End Sub
Friend Sub New(ByVal c As API.Reddit.Channel)
Friend Sub New(ByVal c As Reddit.Channel)
Name = c.Name
Site = Sites.Reddit
File = c.File
@@ -245,23 +245,6 @@ Friend Module MainMod
Return ErrorsDescriber.Execute(e, ex, "Downloading video by URL error", False)
End Try
End Function
Friend Sub CheckForReparse()
Try
Dim p As Func(Of IUserData, Boolean) = Function(u) u.DataForReparseExists
With Settings.Users
If .Count > 0 AndAlso .Exists(Function(u) p.Invoke(u)) Then
If MsgBox("Some users contain not parsed data" & vbCr &
"Do you want to start trying to download?",
MsgBoxStyle.Question + MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton1,
"Not parsed data found") = MsgBoxResult.Yes Then
Downloader.AddRange(.Where(p).SelectMany(Function(u) If(u.IsCollection, DirectCast(u, UserDataBind).Collections.Where(p), {u})), True)
End If
End If
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, "CheckForReparse")
End Try
End Sub
Friend Structure UserBan
Friend ReadOnly Name As String
Friend ReadOnly Reason As String

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

81
SCrawler/SettingsCLS.vb
View File

@@ -3,8 +3,17 @@ Imports PersonalUtilities.Functions.XML.Base
Imports SCrawler.API
Imports SCrawler.API.Base
Friend Class SettingsCLS : Implements IDisposable
Friend Const DefaultMaxDownloadingTasks As Integer = 5
Friend ReadOnly Design As XmlFile
Private ReadOnly MyXML As XmlFile
Friend ReadOnly OS64 As Boolean
Friend ReadOnly FfmpegExists As Boolean
Friend ReadOnly FfmpegFile As SFile
Friend ReadOnly Property UseM3U8 As Boolean
Get
Return OS64 And FfmpegExists
End Get
End Property
Private ReadOnly MySites As Dictionary(Of Sites, SiteSettings)
Friend ReadOnly Property Users As List(Of IUserData)
Friend ReadOnly Property UsersList As List(Of UserInfo)
@@ -14,12 +23,17 @@ Friend Class SettingsCLS : Implements IDisposable
Private ReadOnly BlackListFile As SFile = $"{SettingsFolderName}\BlackList.txt"
Private ReadOnly UsersSettingsFile As SFile = $"{SettingsFolderName}\Users.xml"
Friend Sub New()
OS64 = Environment.Is64BitOperatingSystem
FfmpegFile = "ffmpeg.exe"
FfmpegExists = FfmpegFile.Exists
If OS64 And Not FfmpegExists Then MsgBoxE("[ffmpeg.exe] is missing", vbExclamation)
Design = New XmlFile("Settings\Design.xml")
Design.DefaultsLoading(False)
MyXML = New XmlFile(Nothing) With {.AutoUpdateFile = True}
Users = New List(Of IUserData)
UsersList = New List(Of UserInfo)
BlackList = New List(Of UserBan)
GlobalPath = New XMLValue(Of SFile)("GlobalPath", New SFile($"{SFile.GetPath(Application.StartupPath).PathWithSeparator}Data\"), MyXML,,
XMLValue(Of SFile).ToFilePath)
MySites = New Dictionary(Of Sites, SiteSettings) From {
@@ -27,22 +41,29 @@ Friend Class SettingsCLS : Implements IDisposable
{Sites.Twitter, New SiteSettings(Sites.Twitter, MyXML, GlobalPath.Value)}
}
MySites(Sites.Reddit).Responser.Decoders.Add(SymbolsConverter.Converters.Unicode)
MaxLargeImageHeigh = New XMLValue(Of Integer)("MaxLargeImageHeigh", 150, MyXML)
MaxSmallImageHeigh = New XMLValue(Of Integer)("MaxSmallImageHeigh", 15, MyXML)
ViewMode = New XMLValue(Of Integer)("ViewMode", ViewModes.IconLarge, MyXML)
ShowingMode = New XMLValue(Of Integer)("ShowingMode", ShowingModes.All, MyXML)
SeparateVideoFolder = New XMLValue(Of Boolean)("SeparateVideoFolder", True, MyXML)
CollectionsPath = New XMLValue(Of String)("CollectionsPath", "Collections", MyXML)
DefaultTemporary = New XMLValue(Of Boolean)("DefaultTemporary", False, MyXML)
MaxUsersJobsCount = New XMLValue(Of Integer)("MaxUsersJobsCount", DefaultMaxDownloadingTasks, MyXML)
MaxLargeImageHeigh = New XMLValue(Of Integer)("MaxLargeImageHeigh", 150, MyXML)
MaxSmallImageHeigh = New XMLValue(Of Integer)("MaxSmallImageHeigh", 15, MyXML)
InfoViewMode = New XMLValue(Of Integer)("InfoViewMode", DownloadedInfoForm.ViewModes.Session, MyXML)
ViewMode = New XMLValue(Of Integer)("ViewMode", ViewModes.IconLarge, MyXML)
ShowingMode = New XMLValue(Of Integer)("ShowingMode", ShowingModes.All, MyXML)
LatestSavingPath = New XMLValue(Of SFile)("LatestSavingPath", Nothing, MyXML,, XMLValue(Of SFile).ToFilePath)
LatestSelectedLabels = New XMLValue(Of String)("LatestSelectedLabels",, MyXML)
LatestSelectedChannel = New XMLValue(Of String)("LatestSelectedChannel",, MyXML)
ChannelsHideExistsUser = New XMLValue(Of Boolean)("ChannelsHideExistsUser", True, MyXML)
InfoViewMode = New XMLValue(Of Integer)("InfoViewMode", DownloadedInfoForm.ViewModes.Session, MyXML)
ChannelsImagesRows = New XMLValue(Of Integer)("ChannelsImagesRows", 2, MyXML)
ChannelsImagesColumns = New XMLValue(Of Integer)("ChannelsImagesColumns", 5, MyXML)
ChannelsHideExistsUser = New XMLValue(Of Boolean)("ChannelsHideExistsUser", True, MyXML)
ChannelsMaxJobsCount = New XMLValue(Of Integer)("ChannelsMaxJobsCount", DefaultMaxDownloadingTasks, MyXML)
FromChannelDownloadTop = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML)
FromChannelDownloadTopUse = New XMLValue(Of Boolean)("FromChannelDownloadTopUse", False, MyXML)
FromChannelCopyImageToUser = New XMLValue(Of Boolean)("FromChannelCopyImageToUser", True, MyXML)
CheckUpdatesAtStart = New XMLValue(Of Boolean)("CheckUpdatesAtStart", True, MyXML)
ShowNewVersionNotification = New XMLValue(Of Boolean)("ShowNewVersionNotification", True, MyXML)
@@ -171,24 +192,19 @@ Friend Class SettingsCLS : Implements IDisposable
Friend Overloads Function UserExists(ByVal _User As UserInfo) As Boolean
Return UserExists(_User.Site, _User.Name)
End Function
Friend Sub BeginUpdate()
MyXML.BeginUpdate()
End Sub
Friend Sub EndUpdate()
MyXML.EndUpdate()
If MyXML.ChangesDetected Then MyXML.UpdateData()
End Sub
Friend ReadOnly Property Site(ByVal s As Sites) As SiteSettings
Get
Return MySites(s)
End Get
End Property
Friend ReadOnly Property GlobalPath As XMLValue(Of SFile)
Friend ReadOnly Property MaxLargeImageHeigh As XMLValue(Of Integer)
Friend ReadOnly Property MaxSmallImageHeigh As XMLValue(Of Integer)
Friend ReadOnly Property ViewMode As XMLValue(Of Integer)
Friend ReadOnly Property ViewModeIsPicture As Boolean
Get
Select Case ViewMode.Value
Case View.LargeIcon, View.SmallIcon : Return True
Case Else : Return False
End Select
End Get
End Property
Friend ReadOnly Property ShowingMode As XMLValue(Of Integer)
Friend ReadOnly Property SeparateVideoFolder As XMLValue(Of Boolean)
Friend ReadOnly Property CollectionsPath As XMLValue(Of String)
Friend ReadOnly Property CollectionsPathF As SFile
@@ -201,16 +217,41 @@ Friend Class SettingsCLS : Implements IDisposable
End Get
End Property
Friend ReadOnly Property DefaultTemporary As XMLValue(Of Boolean)
Friend ReadOnly Property MaxUsersJobsCount As XMLValue(Of Integer)
#Region "View"
Friend ReadOnly Property MaxLargeImageHeigh As XMLValue(Of Integer)
Friend ReadOnly Property MaxSmallImageHeigh As XMLValue(Of Integer)
Friend ReadOnly Property InfoViewMode As XMLValue(Of Integer)
Friend ReadOnly Property ViewMode As XMLValue(Of Integer)
Friend ReadOnly Property ViewModeIsPicture As Boolean
Get
Select Case ViewMode.Value
Case View.LargeIcon, View.SmallIcon : Return True
Case Else : Return False
End Select
End Get
End Property
Friend ReadOnly Property ShowingMode As XMLValue(Of Integer)
#End Region
#Region "Latest values"
Friend ReadOnly Property LatestSavingPath As XMLValue(Of SFile)
Friend ReadOnly Property LatestSelectedLabels As XMLValue(Of String)
Friend ReadOnly Property LatestSelectedChannel As XMLValue(Of String)
Friend ReadOnly Property InfoViewMode As XMLValue(Of Integer)
#End Region
#Region "Channels properties"
Friend ReadOnly Property ChannelsImagesRows As XMLValue(Of Integer)
Friend ReadOnly Property ChannelsImagesColumns As XMLValue(Of Integer)
Friend ReadOnly Property ChannelsHideExistsUser As XMLValue(Of Boolean)
Friend ReadOnly Property ChannelsMaxJobsCount As XMLValue(Of Integer)
Friend ReadOnly Property FromChannelDownloadTop As XMLValue(Of Integer)
Friend ReadOnly Property FromChannelDownloadTopUse As XMLValue(Of Boolean)
Friend ReadOnly Property FromChannelCopyImageToUser As XMLValue(Of Boolean)
#End Region
#Region "New version properties"
Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean)
Friend ReadOnly Property ShowNewVersionNotification As XMLValue(Of Boolean)
Friend ReadOnly Property LatestVersion As XMLValue(Of String)
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)

39
SCrawler/TDownloader.vb
View File

@@ -81,11 +81,16 @@ Friend Class TDownloader : Implements IDisposable
Const nf As ANumbers.Formats = ANumbers.Formats.Number
Dim t As New List(Of Task)
Dim i% = -1
Dim j% = Settings.MaxUsersJobsCount - 1
Dim Keys As New List(Of String)
For Each _Item As IUserData In Items
i += 1
If i > 4 Then Exit For
Token.ThrowIfCancellationRequested()
t.Add(Task.Run(Sub() _Item.DownloadData(Token)))
If Not _Item.Disposed Then
Keys.Add(_Item.LVIKey)
Token.ThrowIfCancellationRequested()
t.Add(Task.Run(Sub() _Item.DownloadData(Token)))
i += 1
If i >= j Then Exit For
End If
Next
If t.Count > 0 Then
_CurrentDownloadingTasks = t.Count
@@ -95,19 +100,24 @@ Friend Class TDownloader : Implements IDisposable
.InformationTemporary = .Information
End With
Token.ThrowIfCancellationRequested()
Task.WaitAll(t.ToArray)
Task.WaitAll(t.ToArray, Token)
Dim dcc As Boolean = False
If Count > 0 And Count >= t.Count Then
For i = t.Count - 1 To 0 Step -1
With Items(i)
If Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
If Not Downloaded.Contains(.Self) Then Downloaded.Add(GetUserFromMainCollection(.Self))
dcc = True
End If
If Keys.Count > 0 Then
For Each k$ In Keys
i = Items.FindIndex(Function(ii) ii.LVIKey = k)
If i >= 0 Then
With Items(i)
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
If Not Downloaded.Contains(.Self) Then Downloaded.Add(GetUserFromMainCollection(.Self))
dcc = True
End If
End With
Items.RemoveAt(i)
End With
End If
Next
End If
Keys.Clear()
Items.RemoveAll(Function(ii) ii.Disposed)
If dcc Then Downloaded.RemoveAll(Function(u) u Is Nothing)
If dcc And Downloaded.Count > 0 Then RaiseEvent OnDownloadCountChange()
t.Clear()
@@ -153,11 +163,10 @@ Friend Class TDownloader : Implements IDisposable
If Not _Working Then Start()
End If
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData), Optional ByVal ReparseOnly As Boolean = False)
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If _Items.ListExists Then
For i% = 0 To _Items.Count - 1
'If i = 5 Then UpdateJobsLabel() : Start()
If ReparseOnly Then _Items(i).DownloadReparseOnly = True
If _Items(i).IsCollection Then _Items(i).DownloadData(Nothing) Else Items.Add(_Items(i))
Next
UpdateJobsLabel()