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

Browse Source 
Add full channel support, make ready for download prop available for collections and multiusers
Fixed imgur pics compatibility
Updated abstract classes and functions for channels compatibility
This commit is contained in:
Andy
2021-12-12 14:47:34 +03:00
parent 70e73c7d97
commit 67c4b25d22
16 changed files with 645 additions and 232 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
Changelog.md
View File

@@ -1,3 +1,11 @@
# 1.0.0.4
- Added
- Full channels support (you can now add channel (subreddit) for standard download)
- ```Ready for download``` now available for collections and can be changed for multiple user
- Fixed
- Images hosted on Imgur won't download
# 1.0.0.3
- Fixed

7
README.md
View File

@@ -7,7 +7,7 @@ Enjoying the tool? Considering adding to my coffee fund :)
[![ko-fi](https://www.ko-fi.com/img/githubbutton_sm.svg)](https://ko-fi.com/andyprogram)
# What can program do:
- Download pictures and videos from users' profiles:
- Download pictures and videos from users' profiles and subreddits:
- Reddit images;
- Reddit galleries of images;
- Redgifs hosted videos (https://www.redgifs.com/);
@@ -47,10 +47,13 @@ Just add user profile and press ```Start downloading``` button.
Users can be added by patterns:
- https://twitter.com/SomeUserName
- https://reddit.com/user/SomeUserName
- https://reddit.com/r/SomeSubredditName
- u/SomeUserName
- r/SomeSubredditName
- SomeUserName (in this case you must to choose user site)
- SomeSubredditName
More about users adding [here](https://github.com/AAndyProgram/SCrawler/wiki/Users)
More about users and subreddits adding [here](https://github.com/AAndyProgram/SCrawler/wiki/Users)
**Full guide you can find [here](https://github.com/AAndyProgram/SCrawler/wiki)**

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

@@ -33,6 +33,7 @@ Namespace API.Base
#End Region
#Region "XML Declarations"
Private Const Name_Site As String = "Site"
Private Const Name_IsChannel As String = "IsChannel"
Private Const Name_UserName As String = "UserName"
Private Const Name_FriendlyName As String = "FriendlyName"
Private Const Name_UserID As String = "UserID"
@@ -131,7 +132,7 @@ Namespace API.Base
Protected Function GetNullPicture(ByVal MaxHeigh As XML.Base.XMLValue(Of Integer)) As Bitmap
Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value)
End Function
Private Function GetPicture(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As Image
Protected Function GetPicture(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As Image
Dim f As SFile = Nothing
Dim p As UserImage = Nothing
Dim DelPath As Boolean = True
@@ -234,7 +235,7 @@ BlockNullPicture:
#Region "Downloading params"
Protected _DataLoaded As Boolean = False
Protected _DataParsed As Boolean = False
Friend Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
Friend Overridable Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
Friend Property DownloadImages As Boolean = True Implements IUserData.DownloadImages
Friend Property DownloadVideos As Boolean = True Implements IUserData.DownloadVideos
#End Region
@@ -409,7 +410,12 @@ BlockNullPicture:
''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Overloads Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
Select Case u.Site
Case Sites.Reddit : Return New Reddit.UserData(u, _LoadUserInformation)
Case Sites.Reddit
If u.IsChannel Then
Return New Reddit.Channel(u, _LoadUserInformation)
Else
Return New Reddit.UserData(u, _LoadUserInformation)
End If
Case Sites.Twitter : Return New Twitter.UserData(u, _LoadUserInformation)
Case Else : Throw New ArgumentOutOfRangeException("Site", $"Site [{u.Site}] information does not recognized by loader")
End Select
@@ -560,7 +566,7 @@ BlockNullPicture:
Try
Dim URL$ = String.Empty
Select Case Site
Case Sites.Reddit : URL = $"https://www.reddit.com/user/{Name}/"
Case Sites.Reddit : URL = $"https://www.reddit.com/{IIf(IsChannel, "r", "user")}/{Name}/"
Case Sites.Twitter : URL = $"https://twitter.com/{Name}"
Case Else : MsgBoxE($"Site [{Site}] opening does not implemented", MsgBoxStyle.Exclamation)
End Select
@@ -640,7 +646,7 @@ BlockNullPicture:
DownloadTopCount = Nothing
End Try
End Sub
Private Sub UpdateDataFiles()
Protected Sub UpdateDataFiles()
If Not User.File.IsEmptyString Then
MyFileData = User.File
MyFileData.Name &= "_Data"
@@ -680,32 +686,38 @@ BlockNullPicture:
#End Region
#Region "Delete, Move, Merge"
Friend Overridable Function Delete() As Integer Implements IUserData.Delete
Return DeleteF(Me)
End Function
Friend Function DeleteF(ByVal Instance As IUserData) As Integer
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso f.Delete(SFO.Path, False, False) Then
ImageHandler(Me, False)
Settings.UsersList.Remove(User)
Settings.UpdateUsersList()
Settings.Users.Remove(Me)
Downloader.UserRemove(Me)
Settings.Users.Remove(Instance)
Downloader.UserRemove(Instance)
Dispose(True)
Return 1
Else
Return 0
End If
End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal _MergeData As Boolean) As Boolean Implements IUserData.MoveFiles
Friend Overridable Function MoveFiles(ByVal __CollectionName As String) As Boolean Implements IUserData.MoveFiles
Return MoveFilesF(Me, __CollectionName)
End Function
Friend Function MoveFilesF(ByRef Instance As IUserData, ByVal __CollectionName As String) As Boolean
Dim UserBefore As UserInfo = User
Dim Removed As Boolean = True
Dim _TurnBack As Boolean = False
Try
Dim f As SFile
If IncludedInCollection Then
Settings.Users.Add(Me)
Settings.Users.Add(Instance)
Removed = False
User.CollectionName = String.Empty
User.IncludedInCollection = False
Else
Settings.Users.Remove(Me)
Settings.Users.Remove(Instance)
Removed = True
User.CollectionName = __CollectionName
User.IncludedInCollection = True
@@ -720,7 +732,7 @@ BlockNullPicture:
"Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then
MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation)
User = UserBefore
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
If Removed Then Settings.Users.Add(Instance) Else Settings.Users.Remove(Instance)
_TurnBack = False
Return False
End If
@@ -736,7 +748,7 @@ BlockNullPicture:
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)
If Removed Then Settings.Users.Add(Instance) Else Settings.Users.Remove(Instance)
End If
Return False
End Try
@@ -783,6 +795,8 @@ BlockNullPicture:
End If
UpdateUserInformation()
End If
Catch ioex As InvalidOperationException When ioex.HelpLink = 1
MsgBoxE(ioex.Message, vbCritical)
Catch ex As Exception
LogError(ex, "[UserDataBase.MergeData]")
End Try
@@ -872,7 +886,11 @@ BlockNullPicture:
Return OutValue
End Function
Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If TypeOf Obj Is Reddit.Channel Then
Return CompareTo(DirectCast(DirectCast(Obj, Reddit.Channel).Instance, UserDataBase))
Else
Return CompareTo(DirectCast(Obj, UserDataBase))
End If
End Function
#End Region
#Region "IEquatable Support"
@@ -880,7 +898,11 @@ BlockNullPicture:
Return Site = Other.Site And Name = Other.Name
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
If TypeOf Obj Is Reddit.Channel Then
Return Equals(DirectCast(DirectCast(Obj, Reddit.Channel).Instance, UserDataBase))
Else
Return Equals(DirectCast(Obj, UserDataBase))
End If
End Function
#End Region
#Region "IDisposable Support"
@@ -966,7 +988,7 @@ BlockNullPicture:
''' 3 - Collection splitted
''' </summary>
Function Delete() As Integer
Function MoveFiles(ByVal CollectionName As String, ByVal MergeData As Boolean) As Boolean
Function MoveFiles(ByVal CollectionName As String) As Boolean
Sub OpenFolder()
ReadOnly Property Self As IUserData
Property DownloadTopCount As Integer?

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

@@ -2,9 +2,10 @@
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.XML
Imports SCrawler.API.Base
Imports System.Threading
Namespace API.Reddit
Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel),
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IDisposable
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IUserData, IDisposable
#Region "XML Nodes' Names"
Private Const Name_Name As String = "Name"
Private Const Name_ID As String = "ID"
@@ -12,8 +13,237 @@ Namespace API.Reddit
Private Const Name_PostsNode As String = "Posts"
#End Region
Friend Const DefaultDownloadLimitCount As Integer = 1000
Friend Property Name As String = String.Empty
Friend Property ID As String = String.Empty
#Region "IUserData Support"
Private Event OnPictureUpdated(User As IUserData) Implements IUserData.OnPictureUpdated
Friend Property Instance As IUserData
Private Property IUserData_ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly
Private ReadOnly Property IUserData_IsCollection As Boolean Implements IUserData.IsCollection
Get
Return Instance.IsCollection
End Get
End Property
Private Property IUserData_CollectionName As String Implements IUserData.CollectionName
Get
Return Instance.CollectionName
End Get
Set(ByVal NewName As String)
Instance.CollectionName = NewName
End Set
End Property
Private ReadOnly Property IUserData_IncludedInCollection As Boolean Implements IUserData.IncludedInCollection
Get
Return Instance.IncludedInCollection
End Get
End Property
Private ReadOnly Property IUserData_Labels As List(Of String) Implements IUserData.Labels
Get
Return Instance.Labels
End Get
End Property
Private ReadOnly Property IUserData_IsChannel As Boolean = True Implements IUserData.IsChannel
Private Property IUserData_ReadyForDownload As Boolean Implements IUserData.ReadyForDownload
Get
Return Instance.ReadyForDownload
End Get
Set(ByVal IsReady As Boolean)
Instance.ReadyForDownload = IsReady
End Set
End Property
Private Property IUserData_File As SFile Implements IUserData.File
Get
Return Instance.File
End Get
Set(ByVal NewFile As SFile)
Instance.File = NewFile
End Set
End Property
Private Property IUserData_FileExists As Boolean Implements IUserData.FileExists
Get
Return Instance.FileExists
End Get
Set(ByVal IsExists As Boolean)
Instance.FileExists = IsExists
End Set
End Property
Private Property IUserData_DownloadedPictures As Integer Implements IUserData.DownloadedPictures
Get
Return Instance.DownloadedPictures
End Get
Set(ByVal c As Integer)
Instance.DownloadedPictures = c
End Set
End Property
Private Property IUserData_DownloadedVideos As Integer Implements IUserData.DownloadedVideos
Get
Return Instance.DownloadedVideos
End Get
Set(ByVal c As Integer)
Instance.DownloadedVideos = c
End Set
End Property
Private ReadOnly Property IUserData_DownloadedTotal(Optional Total As Boolean = True) As Integer Implements IUserData.DownloadedTotal
Get
Return Instance.DownloadedTotal
End Get
End Property
Private ReadOnly Property IUserData_DownloadedInformation As String Implements IUserData.DownloadedInformation
Get
Return Instance.DownloadedInformation
End Get
End Property
Private Property IUserData_HasError As Boolean Implements IUserData.HasError
Get
Return Instance.HasError
End Get
Set(ByVal e As Boolean)
Instance.HasError = e
End Set
End Property
Private ReadOnly Property IUserData_FitToAddParams As Boolean Implements IUserData.FitToAddParams
Get
Return Instance.FitToAddParams
End Get
End Property
Private ReadOnly Property IUserData_LVIKey As String Implements IUserData.LVIKey
Get
Return Instance.LVIKey
End Get
End Property
Private ReadOnly Property IUserData_LVIIndex As Integer Implements IUserData.LVIIndex
Get
Return Instance.LVIIndex
End Get
End Property
Private Property IUserData_DownloadImages As Boolean Implements IUserData.DownloadImages
Get
Return Instance.DownloadImages
End Get
Set(ByVal d As Boolean)
Instance.DownloadImages = d
End Set
End Property
Private Property IUserData_DownloadVideos As Boolean Implements IUserData.DownloadVideos
Get
Return Instance.DownloadVideos
End Get
Set(ByVal d As Boolean)
Instance.DownloadVideos = d
End Set
End Property
Private ReadOnly Property IUserData_Self As IUserData Implements IUserData.Self
Get
Return Instance
End Get
End Property
Private Property IUserData_DownloadTopCount As Integer? Implements IUserData.DownloadTopCount
Get
Return Instance.DownloadTopCount
End Get
Set(ByVal c As Integer?)
Instance.DownloadTopCount = c
End Set
End Property
Friend Property Site As Sites = Sites.Reddit Implements IContentProvider.Site
Private Property IUserData_FriendlyName As String Implements IContentProvider.FriendlyName
Get
Return Instance.FriendlyName
End Get
Set(ByVal NewName As String)
Instance.FriendlyName = NewName
End Set
End Property
Private Property IUserData_Description As String Implements IContentProvider.Description
Get
Return Instance.Description
End Get
Set(ByVal d As String)
Instance.Description = d
End Set
End Property
Private Property IUserData_Favorite As Boolean Implements IContentProvider.Favorite
Get
Return Instance.Favorite
End Get
Set(ByVal f As Boolean)
Instance.Favorite = f
End Set
End Property
Private Property IUserData_Temporary As Boolean Implements IContentProvider.Temporary
Get
Return Instance.Temporary
End Get
Set(ByVal t As Boolean)
Instance.Temporary = t
End Set
End Property
Private Sub IUserData_SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Instance.SetPicture(f)
End Sub
Private Sub IUserData_LoadUserInformation() Implements IUserData.LoadUserInformation
Instance.LoadUserInformation()
End Sub
Private Sub IUserData_UpdateUserInformation() Implements IUserData.UpdateUserInformation
Instance.UpdateUserInformation()
End Sub
Private Sub IUserData_OpenFolder() Implements IUserData.OpenFolder
Instance.OpenFolder()
End Sub
Private Sub IUserData_OpenSite() Implements IContentProvider.OpenSite
Instance.OpenSite()
End Sub
Private Sub IUserData_DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
DownloadData(Token, False, Nothing)
End Sub
Private Function IUserData_GetPicture() As Image Implements IUserData.GetPicture
Return Instance.GetPicture()
End Function
Private Function IUserData_GetLVI(ByVal Destination As ListView) As ListViewItem Implements IUserData.GetLVI
Return Instance.GetLVI(Destination)
End Function
Private Function IUserData_GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Implements IUserData.GetLVIGroup
Return Instance.GetLVIGroup(Destination)
End Function
Private Function IUserData_Delete() As Integer Implements IUserData.Delete
Return DirectCast(Instance, UserDataBase).DeleteF(Me)
End Function
Private Function IUserData_MoveFiles(ByVal CollectionName As String) As Boolean Implements IUserData.MoveFiles
Return DirectCast(Instance, UserDataBase).MoveFilesF(Me, CollectionName)
End Function
#End Region
Private _Name As String = String.Empty
Friend Property Name As String Implements IUserData.Name
Get
If IsRegularChannel Then
Return Instance.Name
Else
Return _Name
End If
End Get
Set(ByVal NewName As String)
If IsRegularChannel Then
Instance.Name = NewName
Else
_Name = NewName
End If
End Set
End Property
Private _ID As String = String.Empty
Friend Property ID As String Implements IUserData.ID
Get
If IsRegularChannel Then
Return Instance.ID
Else
Return _ID
End If
End Get
Set(ByVal NewID As String)
If IsRegularChannel Then
Instance.ID = NewID
Else
_ID = NewID
End If
End Set
End Property
Friend ReadOnly Property CUser As UserInfo
Get
Return New UserInfo(Me)
@@ -122,6 +352,7 @@ Namespace API.Reddit
End Sub
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
#End Region
Friend ReadOnly IsRegularChannel As Boolean = False
Friend Sub New()
Posts = New List(Of UserPost)
PostsLatest = New List(Of UserPost)
@@ -131,9 +362,19 @@ Namespace API.Reddit
Me.New
LoadData(f, False)
End Sub
Friend Sub New(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True)
Me.New
Instance = New UserData(u, _LoadUserInformation) With {.SaveToCache = False, .SkipExistsUsers = False, .ChannelInfo = Me}
AutoGetLimits = True
DirectCast(Instance, UserData).SetLimit(Me)
IsRegularChannel = True
End Sub
Public Shared Widening Operator CType(ByVal f As SFile) As Channel
Return New Channel(f)
End Operator
Public Shared Widening Operator CType(ByVal c As Channel) As UserDataBase
Return DirectCast(c.Instance, UserDataBase)
End Operator
Public Overrides Function ToString() As String
If Not Name.IsEmptyString Then
Return Name
@@ -144,10 +385,13 @@ Namespace API.Reddit
Friend Sub Delete()
If File.Exists Then File.Delete()
End Sub
Friend Sub DownloadData(ByVal Token As Threading.CancellationToken, Optional ByVal SkipExists As Boolean = True,
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
Optional ByVal p As MyProgress = Nothing)
Try
_Downloading = True
If Not Instance Is Nothing Then
Instance.DownloadData(Token)
Else
Using d As New UserData(CUser, False, False) With {
.Progress = p,
.SaveToCache = True,
@@ -159,8 +403,8 @@ Namespace API.Reddit
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
Token.ThrowIfCancellationRequested()
End Using
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Finally
_Downloading = False
@@ -201,26 +445,50 @@ Namespace API.Reddit
Friend Overloads Function Equals(ByVal Other As Channel) As Boolean Implements IEquatable(Of Channel).Equals
Return ID = Other.ID
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not Obj Is Nothing Then
If TypeOf Obj Is String Then
Return ID = CStr(Obj)
Else
Return Equals(DirectCast(Obj, Channel))
End If
Private Overloads Function Equals(ByVal Other As UserDataBase) As Boolean Implements IEquatable(Of UserDataBase).Equals
If Not Instance Is Nothing Then
Return Instance.Equals(Other)
Else
Return False
End If
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not Obj Is Nothing Then
If TypeOf Obj Is String Then
Return ID = CStr(Obj)
ElseIf TypeOf Obj Is Channel Then
Return Equals(DirectCast(Obj, Channel))
ElseIf TypeOf Obj Is UserDataBase Then
Return Equals(DirectCast(Obj, UserDataBase))
End If
End If
Return False
End Function
#End Region
#Region "IComparable Support"
Friend Function CompareTo(ByVal Other As Channel) As Integer Implements IComparable(Of Channel).CompareTo
Friend Overloads Function CompareTo(ByVal Other As Channel) As Integer Implements IComparable(Of Channel).CompareTo
If Not Name.IsEmptyString And Not Other.Name.IsEmptyString Then
Return Name.CompareTo(Other.Name)
Else
Return ID.CompareTo(Other.ID)
End If
End Function
Private Overloads Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
If Not Instance Is Nothing Then
Return Instance.CompareTo(Other)
Else
Return 0
End If
End Function
Private Overloads Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If TypeOf Obj Is Channel Then
Return CompareTo(DirectCast(Obj, Channel))
ElseIf TypeOf Obj Is UserDataBase And Not Instance Is Nothing Then
Return Instance.CompareTo(Obj)
Else
Return 0
End If
End Function
#End Region
#Region "ILoaderSaver Support"
Friend Overloads Function LoadData(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Load
@@ -280,12 +548,18 @@ Namespace API.Reddit
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Friend ReadOnly Property Disposed As Boolean Implements IUserData.Disposed
Get
Return disposedValue
End Get
End Property
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
Posts.Clear()
PostsLatest.Clear()
Range.Dispose()
If Not Instance Is Nothing Then Instance.Dispose()
If CachePath.Exists(SFO.Path, False) Then CachePath.Delete(SFO.Path, False, False, EDP.SendInLog)
End If
disposedValue = True

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

@@ -66,7 +66,7 @@ Namespace API.Reddit
#End Region
#Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
If IsChannel Then
If IsChannel AndAlso Not ChannelInfo.IsRegularChannel Then
ChannelPostsNames.ListAddList(ChannelInfo.PostsAll.Select(Function(p) p.ID), LNC)
If SkipExistsUsers Then _ExistsUsersNames.ListAddList(Settings.UsersList.Select(Function(p) p.Name), LNC)
DownloadDataF(Token)
@@ -80,7 +80,18 @@ Namespace API.Reddit
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
If IsChannel Then
If ChannelInfo.IsRegularChannel Then
ChannelPostsNames.ListAddList(_TempPostsList, LNC)
If ChannelPostsNames.Count > 0 Then
DownloadLimitCount = Nothing
With _ContentList.Where(Function(c) c.Post.Date.HasValue)
If .Count > 0 Then DownloadLimitDate = .Max(Function(p) p.Post.Date.Value).AddMinutes(-10)
End With
End If
If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount
End If
DownloadDataChannel(String.Empty, Token)
If ChannelInfo.IsRegularChannel Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
Else
DownloadDataUser(String.Empty, Token)
End If
@@ -131,7 +142,7 @@ 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)
Else
ElseIf Not CreateImgurMedia(s.XmlIfNothingValue, PostID, PostDate,, IsChannel) Then
s = nn.ItemF({"media"}).XmlIfNothing
__ItemType = s("type").XmlIfNothingValue
Select Case __ItemType
@@ -241,6 +252,8 @@ Namespace API.Reddit
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
ElseIf CreateImgurMedia(tmpUrl, PostID, PostDate, _UserID, IsChannel) Then
_TotalPostsDownloaded += 1
ElseIf s.Item("media_metadata").XmlIfNothing.Count > 0 Then
DownloadGallery(s, PostID, PostDate, _UserID, SaveToCache)
_TotalPostsDownloaded += 1
@@ -268,6 +281,43 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Download Base Functions"
Private Function ImgurPicture(ByVal Source As EContainer, ByVal Value As String) As String
Try
Dim e As EContainer = Source({"source", "url"}).XmlIfNothing
If Not e.IsEmptyString AndAlso e.Value.ToLower.Contains("imgur") Then
Return e.Value
Else
Return Value
End If
Catch ex As Exception
LogError(ex, "[ImgurPicture]")
Return Value
End Try
End Function
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As Boolean
If Not _URL.IsEmptyString AndAlso _URL.Contains("imgur") Then
If _URL.StringContains({".jpg", ".png", ".jpeg"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
ElseIf _URL.Contains(".gifv") Then
If SaveToCache Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL.Replace(".gifv", ".gif"),
PostID, PostDate, _UserID, IsChannel), LNC)
Else
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL.Replace(".gifv", ".mp4"),
PostID, PostDate, _UserID, IsChannel), LNC)
End If
ElseIf _URL.Contains(".gif") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
Else
If Not TryFile(_URL) Then _URL &= ".jpg"
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
End If
Return True
Else
Return False
End If
End Function
Private Function DownloadGallery(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = Nothing, Optional ByVal FirstOnly As Boolean = False) As Boolean
Try
@@ -349,7 +399,7 @@ Namespace API.Reddit
End Function
Private Function TryFile(ByVal URL As String) As Boolean
Try
If Not URL.IsEmptyString AndAlso URL.Contains(".jpg") Then
If Not URL.IsEmptyString AndAlso URL.StringContains({".jpg", ".png", ".jpeg"}) Then
Dim f As SFile = CStr(RegexReplace(URL, FilesPattern))
Return Not f.IsEmptyString And Not f.File.IsEmptyString
End If

49
SCrawler/API/UserDataBind.vb
View File

@@ -98,7 +98,7 @@ Namespace API
Friend Overrides Property DataMerging As Boolean
Get
If Count > 0 Then
Return DirectCast(Collections(0), UserDataBase).DataMerging
Return DirectCast(Collections(0).Self, UserDataBase).DataMerging
Else
Return False
End If
@@ -142,6 +142,14 @@ Namespace API
UpdateUserInformation()
End Set
End Property
Friend Overrides Property ReadyForDownload As Boolean
Get
Return Count > 0 AndAlso Collections(0).ReadyForDownload
End Get
Set(ByVal IsReady As Boolean)
If Count > 0 Then Collections.ForEach(Sub(c) c.ReadyForDownload = IsReady)
End Set
End Property
Friend Overrides ReadOnly Property Labels As List(Of String)
Get
If Count > 0 Then
@@ -153,15 +161,15 @@ Namespace API
End Property
Friend Overrides Function GetUserInformation() As String
Dim OutStr$ = String.Empty
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), $"{vbCrLf}{vbCrLf}"))
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c.Self, UserDataBase).GetUserInformation(), $"{vbCrLf}{vbCrLf}"))
Return OutStr
End Function
Friend Overrides Property LastUpdated As Date?
Get
If Count > 0 Then
With If((From c In Collections
Where DirectCast(c, UserDataBase).LastUpdated.HasValue
Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
Where DirectCast(c.Self, UserDataBase).LastUpdated.HasValue
Select DirectCast(c.Self, UserDataBase).LastUpdated.Value).ToList, New List(Of Date))
If .Count > 0 Then Return .Max
End With
End If
@@ -179,7 +187,7 @@ Namespace API
Friend ReadOnly Property ContextDown As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DOWN).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_DOWN).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -188,7 +196,7 @@ Namespace API
Friend ReadOnly Property ContextEdit As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_EDIT).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_EDIT).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -197,7 +205,7 @@ Namespace API
Friend ReadOnly Property ContextDelete As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DELETE).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_DELETE).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -206,7 +214,7 @@ Namespace API
Friend ReadOnly Property ContextPath As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_PATH).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_OPEN_PATH).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -215,7 +223,7 @@ Namespace API
Friend ReadOnly Property ContextSite As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_OPEN_SITE).ToArray
Return Collections.Select(Function(c) DirectCast(c.Self, UserDataBase).BTT_CONTEXT_OPEN_SITE).ToArray
Else
Return New ToolStripMenuItem() {}
End If
@@ -239,7 +247,7 @@ Namespace API
If Count > 0 Then Collections.ForEach(Sub(c) c.UpdateUserInformation())
End Sub
Friend Overrides Sub LoadContentInformation()
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation())
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c.Self, UserDataBase).LoadContentInformation())
End Sub
Friend Overrides Property DownloadTopCount As Integer?
Get
@@ -288,8 +296,8 @@ Namespace API
''' <exception cref="InvalidOperationException"></exception>
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
With _Item
Dim m As Boolean = DataMerging
If .MoveFiles(CollectionName, m) Then
If .MoveFiles(CollectionName) Then
If DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
Collections.Add(_Item)
With Collections.Last
If Collections.Count - 1 > 0 Then
@@ -298,7 +306,7 @@ Namespace API
.UpdateUserInformation()
End If
ImageHandler(_Item, False)
AddHandler .OnPictureUpdated, AddressOf User_OnPictureUpdated
AddHandler .Self.OnPictureUpdated, AddressOf User_OnPictureUpdated
DirectCast(.Self, UserDataBase).CreateButtons(Count - 1)
End With
Else
@@ -313,7 +321,7 @@ Namespace API
Case Sites.Twitter : Collections.Add(New Twitter.UserData(u, _LoadData))
Case Else : Exit Sub
End Select
With DirectCast(Collections(Count - 1), UserDataBase)
With DirectCast(Collections.Last.Self, UserDataBase)
.CreateButtons(Count - 1)
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf BTT_CONTEXT_DELETE_Click
End With
@@ -324,7 +332,7 @@ Namespace API
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
End If
End Sub
Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal _MergeData As Boolean) As Boolean
Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean
Throw New NotImplementedException("Files moving does not available if collection context")
End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
@@ -334,7 +342,7 @@ Namespace API
MsgBoxE($"Collection [{CollectionName}] data already merged")
Else
If Collections.Count > 1 Then
Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).MergeData())
Collections.ForEach(Sub(c) DirectCast(c.Self, UserDataBase).MergeData())
MsgBoxE($"Collection [{CollectionName}] data merged")
Else
MsgBoxE($"Collection [{CollectionName}] contains only one user profile" & vbCr &
@@ -367,21 +375,24 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical)
Return False
Else
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty, False)
DirectCast(_Item.Self, UserDataBase).MoveFiles(String.Empty)
ImageHandler(_Item)
Return Collections.Remove(_Item)
End If
End Function
Friend Overrides Function Delete() As Integer
If Count > 0 Then
Dim f As SFile
If MsgBoxE({$"Collection may contain data{vbCr}Do you really want to delete collection and all of it files?", "Collection deleting"},
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
f = Collections(0).File.CutPath(2).PathWithSeparator
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) c.Delete())
Downloader.UserRemove(Me)
ImageHandler(Me, False)
Collections.ListClearDispose
Dispose(False)
If f.Exists(SFO.Path, False) Then f.Delete(SFO.Path, True, False, EDP.SendInLog)
Return 2
Else
If DataMerging Then
@@ -390,10 +401,10 @@ Namespace API
End If
If MsgBoxE({$"Do you want to delete collection only?{vbCr}Users will not be deleted", "Collection deleting"},
MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
Dim f As SFile = Collections(0).File.CutPath(2)
f = Collections(0).File.CutPath(2)
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c)
c.MoveFiles(String.Empty, False)
c.MoveFiles(String.Empty)
ImageHandler(c)
End Sub)
Collections.Clear()

6
SCrawler/DownloadedInfoForm.vb
View File

@@ -54,8 +54,8 @@ Friend Class DownloadedInfoForm
End Sub
Private Class UsersDateOrder : Implements IComparer(Of IUserData)
Friend Function Compare(ByVal x As IUserData, ByVal y As IUserData) As Integer Implements IComparer(Of IUserData).Compare
Dim xv& = If(DirectCast(x, UserDataBase).LastUpdated.HasValue, DirectCast(x, UserDataBase).LastUpdated.Value.Ticks, 0)
Dim yv& = If(DirectCast(y, UserDataBase).LastUpdated.HasValue, DirectCast(y, UserDataBase).LastUpdated.Value.Ticks, 0)
Dim xv& = If(DirectCast(x.Self, UserDataBase).LastUpdated.HasValue, DirectCast(x.Self, UserDataBase).LastUpdated.Value.Ticks, 0)
Dim yv& = If(DirectCast(y.Self, UserDataBase).LastUpdated.HasValue, DirectCast(y.Self, UserDataBase).LastUpdated.Value.Ticks, 0)
Return xv.CompareTo(yv) * -1
End Function
End Class
@@ -114,7 +114,7 @@ Friend Class DownloadedInfoForm
Private Sub LIST_DOWN_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_DOWN.MouseDoubleClick
Try
If _LatestSelected >= 0 AndAlso _LatestSelected <= _TempUsersList.Count - 1 AndAlso
Not DirectCast(_TempUsersList(_LatestSelected), UserDataBase).Disposed Then _TempUsersList(_LatestSelected).OpenFolder()
Not DirectCast(_TempUsersList(_LatestSelected).Self, UserDataBase).Disposed Then _TempUsersList(_LatestSelected).OpenFolder()
Catch ex As Exception
End Try
End Sub

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

@@ -28,6 +28,7 @@
Me.TXT_USER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.OPT_REDDIT = New System.Windows.Forms.RadioButton()
Me.OPT_TWITTER = New System.Windows.Forms.RadioButton()
Me.CH_IS_CHANNEL = New System.Windows.Forms.CheckBox()
Me.CH_TEMP = New System.Windows.Forms.CheckBox()
Me.CH_FAV = New System.Windows.Forms.CheckBox()
Me.CH_PARSE_USER_MEDIA = New System.Windows.Forms.CheckBox()
@@ -88,7 +89,7 @@
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 16.66542!))
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.Absolute, 150.0!))
TP_MAIN.Size = New System.Drawing.Size(454, 378)
TP_MAIN.Size = New System.Drawing.Size(454, 403)
TP_MAIN.TabIndex = 0
'
'TXT_USER
@@ -105,19 +106,20 @@
'TP_SITE
'
TP_SITE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_SITE.ColumnCount = 2
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_SITE.ColumnCount = 3
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_SITE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_SITE.Controls.Add(Me.OPT_REDDIT, 0, 0)
TP_SITE.Controls.Add(Me.OPT_TWITTER, 1, 0)
TP_SITE.Controls.Add(Me.OPT_TWITTER, 2, 0)
TP_SITE.Controls.Add(Me.CH_IS_CHANNEL, 1, 0)
TP_SITE.Dock = System.Windows.Forms.DockStyle.Fill
TP_SITE.Location = New System.Drawing.Point(1, 59)
TP_SITE.Margin = New System.Windows.Forms.Padding(0)
TP_SITE.Name = "TP_SITE"
TP_SITE.RowCount = 1
TP_SITE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_SITE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_SITE.Size = New System.Drawing.Size(452, 27)
TP_SITE.Size = New System.Drawing.Size(452, 31)
TP_SITE.TabIndex = 2
'
'OPT_REDDIT
@@ -126,7 +128,7 @@
Me.OPT_REDDIT.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_REDDIT.Location = New System.Drawing.Point(4, 4)
Me.OPT_REDDIT.Name = "OPT_REDDIT"
Me.OPT_REDDIT.Size = New System.Drawing.Size(218, 19)
Me.OPT_REDDIT.Size = New System.Drawing.Size(143, 23)
Me.OPT_REDDIT.TabIndex = 0
Me.OPT_REDDIT.TabStop = True
Me.OPT_REDDIT.Text = "Reddit"
@@ -136,14 +138,25 @@
'
Me.OPT_TWITTER.AutoSize = True
Me.OPT_TWITTER.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_TWITTER.Location = New System.Drawing.Point(229, 4)
Me.OPT_TWITTER.Location = New System.Drawing.Point(304, 4)
Me.OPT_TWITTER.Name = "OPT_TWITTER"
Me.OPT_TWITTER.Size = New System.Drawing.Size(219, 19)
Me.OPT_TWITTER.Size = New System.Drawing.Size(144, 23)
Me.OPT_TWITTER.TabIndex = 1
Me.OPT_TWITTER.TabStop = True
Me.OPT_TWITTER.Text = "Twitter"
Me.OPT_TWITTER.UseVisualStyleBackColor = True
'
'CH_IS_CHANNEL
'
Me.CH_IS_CHANNEL.AutoSize = True
Me.CH_IS_CHANNEL.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_IS_CHANNEL.Location = New System.Drawing.Point(154, 4)
Me.CH_IS_CHANNEL.Name = "CH_IS_CHANNEL"
Me.CH_IS_CHANNEL.Size = New System.Drawing.Size(143, 23)
Me.CH_IS_CHANNEL.TabIndex = 2
Me.CH_IS_CHANNEL.Text = "Channel"
Me.CH_IS_CHANNEL.UseVisualStyleBackColor = True
'
'TP_PARAMS
'
TP_PARAMS.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
@@ -153,13 +166,13 @@
TP_PARAMS.Controls.Add(Me.CH_TEMP, 0, 0)
TP_PARAMS.Controls.Add(Me.CH_FAV, 1, 0)
TP_PARAMS.Dock = System.Windows.Forms.DockStyle.Fill
TP_PARAMS.Location = New System.Drawing.Point(1, 87)
TP_PARAMS.Location = New System.Drawing.Point(1, 91)
TP_PARAMS.Margin = New System.Windows.Forms.Padding(0)
TP_PARAMS.Name = "TP_PARAMS"
TP_PARAMS.RowCount = 1
TP_PARAMS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_PARAMS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_PARAMS.Size = New System.Drawing.Size(452, 27)
TP_PARAMS.Size = New System.Drawing.Size(452, 31)
TP_PARAMS.TabIndex = 3
'
'CH_TEMP
@@ -168,7 +181,7 @@
Me.CH_TEMP.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_TEMP.Location = New System.Drawing.Point(4, 4)
Me.CH_TEMP.Name = "CH_TEMP"
Me.CH_TEMP.Size = New System.Drawing.Size(218, 19)
Me.CH_TEMP.Size = New System.Drawing.Size(218, 23)
Me.CH_TEMP.TabIndex = 0
Me.CH_TEMP.Text = "Temporary"
Me.CH_TEMP.UseVisualStyleBackColor = True
@@ -179,7 +192,7 @@
Me.CH_FAV.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FAV.Location = New System.Drawing.Point(229, 4)
Me.CH_FAV.Name = "CH_FAV"
Me.CH_FAV.Size = New System.Drawing.Size(219, 19)
Me.CH_FAV.Size = New System.Drawing.Size(219, 23)
Me.CH_FAV.TabIndex = 1
Me.CH_FAV.Text = "Favorite"
Me.CH_FAV.UseVisualStyleBackColor = True
@@ -193,13 +206,13 @@
TP_OTHER.Controls.Add(Me.CH_PARSE_USER_MEDIA, 1, 0)
TP_OTHER.Controls.Add(Me.CH_READY_FOR_DOWN, 0, 0)
TP_OTHER.Dock = System.Windows.Forms.DockStyle.Fill
TP_OTHER.Location = New System.Drawing.Point(1, 143)
TP_OTHER.Location = New System.Drawing.Point(1, 155)
TP_OTHER.Margin = New System.Windows.Forms.Padding(0)
TP_OTHER.Name = "TP_OTHER"
TP_OTHER.RowCount = 1
TP_OTHER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_OTHER.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_OTHER.Size = New System.Drawing.Size(452, 27)
TP_OTHER.Size = New System.Drawing.Size(452, 31)
TP_OTHER.TabIndex = 5
'
'CH_PARSE_USER_MEDIA
@@ -208,7 +221,7 @@
Me.CH_PARSE_USER_MEDIA.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_PARSE_USER_MEDIA.Location = New System.Drawing.Point(229, 4)
Me.CH_PARSE_USER_MEDIA.Name = "CH_PARSE_USER_MEDIA"
Me.CH_PARSE_USER_MEDIA.Size = New System.Drawing.Size(219, 19)
Me.CH_PARSE_USER_MEDIA.Size = New System.Drawing.Size(219, 23)
Me.CH_PARSE_USER_MEDIA.TabIndex = 0
Me.CH_PARSE_USER_MEDIA.Text = "Get user media only"
TT_MAIN.SetToolTip(Me.CH_PARSE_USER_MEDIA, "For twitter only!" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "If checked then user media only will be downloaded." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Otherwise" &
@@ -221,7 +234,7 @@
Me.CH_READY_FOR_DOWN.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_READY_FOR_DOWN.Location = New System.Drawing.Point(4, 4)
Me.CH_READY_FOR_DOWN.Name = "CH_READY_FOR_DOWN"
Me.CH_READY_FOR_DOWN.Size = New System.Drawing.Size(218, 19)
Me.CH_READY_FOR_DOWN.Size = New System.Drawing.Size(218, 23)
Me.CH_READY_FOR_DOWN.TabIndex = 1
Me.CH_READY_FOR_DOWN.Text = "Ready for download"
TT_MAIN.SetToolTip(Me.CH_READY_FOR_DOWN, "Can be downloaded by [Download All]")
@@ -240,7 +253,7 @@
Me.TXT_DESCR.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_DESCR.GroupBoxed = True
Me.TXT_DESCR.GroupBoxText = "Description"
Me.TXT_DESCR.Location = New System.Drawing.Point(4, 229)
Me.TXT_DESCR.Location = New System.Drawing.Point(4, 254)
Me.TXT_DESCR.Multiline = True
Me.TXT_DESCR.Name = "TXT_DESCR"
Me.TXT_DESCR.Size = New System.Drawing.Size(446, 145)
@@ -265,12 +278,12 @@
Me.TP_ADD_BY_LIST.Controls.Add(Me.CH_ADD_BY_LIST, 0, 0)
Me.TP_ADD_BY_LIST.Controls.Add(Me.CH_AUTO_DETECT_SITE, 1, 0)
Me.TP_ADD_BY_LIST.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_ADD_BY_LIST.Location = New System.Drawing.Point(1, 171)
Me.TP_ADD_BY_LIST.Location = New System.Drawing.Point(1, 187)
Me.TP_ADD_BY_LIST.Margin = New System.Windows.Forms.Padding(0)
Me.TP_ADD_BY_LIST.Name = "TP_ADD_BY_LIST"
Me.TP_ADD_BY_LIST.RowCount = 1
Me.TP_ADD_BY_LIST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_ADD_BY_LIST.Size = New System.Drawing.Size(452, 26)
Me.TP_ADD_BY_LIST.Size = New System.Drawing.Size(452, 31)
Me.TP_ADD_BY_LIST.TabIndex = 6
'
'CH_ADD_BY_LIST
@@ -279,7 +292,7 @@
Me.CH_ADD_BY_LIST.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_ADD_BY_LIST.Location = New System.Drawing.Point(4, 4)
Me.CH_ADD_BY_LIST.Name = "CH_ADD_BY_LIST"
Me.CH_ADD_BY_LIST.Size = New System.Drawing.Size(218, 18)
Me.CH_ADD_BY_LIST.Size = New System.Drawing.Size(218, 23)
Me.CH_ADD_BY_LIST.TabIndex = 0
Me.CH_ADD_BY_LIST.Text = "Add by list"
Me.CH_ADD_BY_LIST.UseVisualStyleBackColor = True
@@ -290,7 +303,7 @@
Me.CH_AUTO_DETECT_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_AUTO_DETECT_SITE.Location = New System.Drawing.Point(229, 4)
Me.CH_AUTO_DETECT_SITE.Name = "CH_AUTO_DETECT_SITE"
Me.CH_AUTO_DETECT_SITE.Size = New System.Drawing.Size(219, 18)
Me.CH_AUTO_DETECT_SITE.Size = New System.Drawing.Size(219, 23)
Me.CH_AUTO_DETECT_SITE.TabIndex = 1
Me.CH_AUTO_DETECT_SITE.Text = "Auto detect site"
Me.CH_AUTO_DETECT_SITE.UseVisualStyleBackColor = True
@@ -308,7 +321,7 @@
Me.TXT_LABELS.CaptionText = "Labels"
Me.TXT_LABELS.CaptionWidth = 50.0R
Me.TXT_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_LABELS.Location = New System.Drawing.Point(4, 201)
Me.TXT_LABELS.Location = New System.Drawing.Point(4, 222)
Me.TXT_LABELS.Name = "TXT_LABELS"
Me.TXT_LABELS.Size = New System.Drawing.Size(446, 22)
Me.TXT_LABELS.TabIndex = 7
@@ -323,13 +336,13 @@
TP_DOWN_OPTIONS.Controls.Add(Me.CH_DOWN_IMAGES, 0, 0)
TP_DOWN_OPTIONS.Controls.Add(Me.CH_DOWN_VIDEOS, 1, 0)
TP_DOWN_OPTIONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_DOWN_OPTIONS.Location = New System.Drawing.Point(1, 115)
TP_DOWN_OPTIONS.Location = New System.Drawing.Point(1, 123)
TP_DOWN_OPTIONS.Margin = New System.Windows.Forms.Padding(0)
TP_DOWN_OPTIONS.Name = "TP_DOWN_OPTIONS"
TP_DOWN_OPTIONS.RowCount = 1
TP_DOWN_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_DOWN_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_DOWN_OPTIONS.Size = New System.Drawing.Size(452, 27)
TP_DOWN_OPTIONS.Size = New System.Drawing.Size(452, 31)
TP_DOWN_OPTIONS.TabIndex = 4
'
'CH_DOWN_IMAGES
@@ -338,7 +351,7 @@
Me.CH_DOWN_IMAGES.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_IMAGES.Location = New System.Drawing.Point(4, 4)
Me.CH_DOWN_IMAGES.Name = "CH_DOWN_IMAGES"
Me.CH_DOWN_IMAGES.Size = New System.Drawing.Size(218, 19)
Me.CH_DOWN_IMAGES.Size = New System.Drawing.Size(218, 23)
Me.CH_DOWN_IMAGES.TabIndex = 0
Me.CH_DOWN_IMAGES.Text = "Download Images"
Me.CH_DOWN_IMAGES.UseVisualStyleBackColor = True
@@ -349,7 +362,7 @@
Me.CH_DOWN_VIDEOS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_VIDEOS.Location = New System.Drawing.Point(229, 4)
Me.CH_DOWN_VIDEOS.Name = "CH_DOWN_VIDEOS"
Me.CH_DOWN_VIDEOS.Size = New System.Drawing.Size(219, 19)
Me.CH_DOWN_VIDEOS.Size = New System.Drawing.Size(219, 23)
Me.CH_DOWN_VIDEOS.TabIndex = 1
Me.CH_DOWN_VIDEOS.Text = "Download videos"
Me.CH_DOWN_VIDEOS.UseVisualStyleBackColor = True
@@ -360,7 +373,7 @@
'CONTAINER_MAIN.ContentPanel
'
Me.CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(454, 378)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(454, 403)
Me.CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_MAIN.LeftToolStripPanelVisible = False
Me.CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -425,5 +438,6 @@
Private WithEvents TXT_LABELS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_DOWN_IMAGES As CheckBox
Private WithEvents CH_DOWN_VIDEOS As CheckBox
Private WithEvents CH_IS_CHANNEL As CheckBox
End Class
End Namespace

71
SCrawler/Editors/UserCreatorForm.vb
View File

@@ -72,7 +72,7 @@ Namespace Editors
Me.New
If Not _Instance Is Nothing Then
UserInstance = _Instance
User = DirectCast(UserInstance, UserDataBase).User
User = DirectCast(UserInstance.Self, UserDataBase).User
End If
End Sub
Private Sub UserCreatorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
@@ -80,6 +80,7 @@ Namespace Editors
With MyDef
.MyViewInitialize(Me, Settings.Design, True)
.AddOkCancelToolbar()
CH_AUTO_DETECT_SITE.Enabled = False
If User.Name.IsEmptyString Then
OPT_REDDIT.Checked = False
OPT_TWITTER.Checked = False
@@ -97,6 +98,8 @@ Namespace Editors
End Select
OPT_REDDIT.Enabled = False
OPT_TWITTER.Enabled = False
CH_IS_CHANNEL.Checked = User.IsChannel
CH_IS_CHANNEL.Enabled = False
If Not UserInstance Is Nothing Then
TXT_USER.Enabled = False
With UserInstance
@@ -149,11 +152,12 @@ Namespace Editors
With tmpUser
.Name = TXT_USER.Text
.Site = IIf(OPT_REDDIT.Checked, Sites.Reddit, Sites.Twitter)
.IsChannel = CH_IS_CHANNEL.Checked
.UpdateUserFile()
End With
User = tmpUser
If Not UserInstance Is Nothing Then
With DirectCast(UserInstance, UserDataBase)
With DirectCast(UserInstance.Self, UserDataBase)
.User = User
.FriendlyName = TXT_USER_FRIENDLY.Text
.Favorite = CH_FAV.Checked
@@ -192,72 +196,64 @@ CloseForm:
Private ReadOnly TwitterRegEx As New RegexStructure("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1)
Private ReadOnly RedditRegEx1 As New RegexStructure("[htps:/]{7,8}.*?reddit.com/user/([^/]+)", 1)
Private ReadOnly RedditRegEx2 As New RegexStructure(".?u/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx1 As New RegexStructure("[htps:/]{7,8}.*?reddit.com/r/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx2 As New RegexStructure(".?r/([^/]+)", 1)
Private _TextChangeInvoked As Boolean = False
Private Sub TXT_USER_ActionOnTextChange() Handles TXT_USER.ActionOnTextChange
Try
If Not _TextChangeInvoked Then
_TextChangeInvoked = True
If Not CH_ADD_BY_LIST.Checked Then
Select Case GetSiteByText(TXT_USER.Text)
Dim s() As Object = GetSiteByText(TXT_USER.Text)
Select Case s(0)
Case Sites.Twitter : OPT_TWITTER.Checked = True
Case Sites.Reddit : OPT_REDDIT.Checked = True
Case Else : OPT_TWITTER.Checked = False : OPT_REDDIT.Checked = False
End Select
CH_IS_CHANNEL.Checked = CBool(s(1))
End If
MyDef.Detector()
_TextChangeInvoked = False
End If
Catch ex As Exception
End Try
End Sub
Private Function GetSiteByText(ByRef TXT As String) As Sites
Private Function GetSiteByText(ByRef TXT As String) As Object()
If Not TXT.IsEmptyString AndAlso TXT.Length > 8 Then
Dim s$ = RegexReplace(TXT, TwitterRegEx)
If Not s.IsEmptyString Then
TXT = s
Return Sites.Twitter
Else
s = RegexReplace(TXT, RedditRegEx1)
If Not s.IsEmptyString Then
TXT = s
Return Sites.Reddit
Else
s = RegexReplace(TXT, RedditRegEx2)
If Not s.IsEmptyString Then
TXT = s
Return Sites.Reddit
If CheckRegex(TXT, TwitterRegEx) Then
Return {Sites.Twitter, False}
ElseIf CheckRegex(TXT, RedditRegEx1) OrElse CheckRegex(TXT, RedditRegEx2) Then
Return {Sites.Reddit, False}
ElseIf CheckRegex(TXT, RedditChannelRegEx1) OrElse CheckRegex(TXT, RedditChannelRegEx2) Then
Return {Sites.Reddit, True}
End If
End If
End If
End If
Return Sites.Undefined
Return {Sites.Undefined, False}
End Function
Private Function CheckRegex(ByRef TXT As String, ByVal r As RegexStructure) As Boolean
Dim s$ = RegexReplace(TXT, r)
If Not s.IsEmptyString Then TXT = s : Return True Else Return False
End Function
Private Sub OPT_REDDIT_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_REDDIT.CheckedChanged
MyDef.Detector()
If OPT_REDDIT.Checked Then CH_IS_CHANNEL.Enabled = True
End Sub
Private Sub OPT_TWITTER_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_TWITTER.CheckedChanged
MyDef.Detector()
CH_PARSE_USER_MEDIA.Enabled = OPT_TWITTER.Checked
If OPT_TWITTER.Checked Then CH_IS_CHANNEL.Checked = False : CH_IS_CHANNEL.Enabled = False
End Sub
Private Sub CH_TEMP_CheckedChanged(sender As Object, e As EventArgs) Handles CH_TEMP.CheckedChanged
If CH_TEMP.Checked Then CH_FAV.Checked = False
MyDef.Detector()
End Sub
Private Sub CH_FAV_CheckedChanged(sender As Object, e As EventArgs) Handles CH_FAV.CheckedChanged
If CH_FAV.Checked Then CH_TEMP.Checked = False
MyDef.Detector()
End Sub
Private Sub CH_READY_FOR_DOWN_CheckedChanged(sender As Object, e As EventArgs) Handles CH_READY_FOR_DOWN.CheckedChanged
MyDef.Detector()
End Sub
Private Sub CH_PARSE_USER_MADIA_CheckedChanged(sender As Object, e As EventArgs) Handles CH_PARSE_USER_MEDIA.CheckedChanged
MyDef.Detector()
End Sub
Private Sub CH_ADD_BY_LIST_CheckedChanged(sender As Object, e As EventArgs) Handles CH_ADD_BY_LIST.CheckedChanged
If CH_ADD_BY_LIST.Checked Then
TXT_DESCR.GroupBoxText = "Users list"
CH_AUTO_DETECT_SITE.Enabled = True
Else
TXT_DESCR.GroupBoxText = "Description"
CH_AUTO_DETECT_SITE.Checked = False
CH_AUTO_DETECT_SITE.Enabled = False
End If
TXT_USER.Enabled = Not CH_ADD_BY_LIST.Checked
TXT_USER_FRIENDLY.Enabled = Not CH_ADD_BY_LIST.Checked
@@ -265,6 +261,7 @@ CloseForm:
Private Sub CH_AUTO_DETECT_SITE_CheckedChanged(sender As Object, e As EventArgs) Handles CH_AUTO_DETECT_SITE.CheckedChanged
OPT_REDDIT.Enabled = Not CH_AUTO_DETECT_SITE.Checked
OPT_TWITTER.Enabled = Not CH_AUTO_DETECT_SITE.Checked
CH_IS_CHANNEL.Enabled = Not CH_AUTO_DETECT_SITE.Checked
End Sub
Private Function CreateUsersByList() As Boolean
Try
@@ -278,6 +275,8 @@ CloseForm:
Dim uu$
Dim tmpUser As UserInfo
Dim s As Sites
Dim sObj() As Object
Dim _IsChannel As Boolean = CH_IS_CHANNEL.Checked
Dim Added% = 0
Dim Skipped% = 0
Dim uid%
@@ -290,10 +289,14 @@ CloseForm:
For i% = 0 To u.Count - 1
uu = u(i)
If CH_AUTO_DETECT_SITE.Checked Then s = GetSiteByText(uu)
If CH_AUTO_DETECT_SITE.Checked Then
sObj = GetSiteByText(uu)
s = sObj(0)
_IsChannel = CBool(sObj(1))
End If
If Not s = Sites.Undefined Then
tmpUser = New UserInfo(uu, s)
tmpUser = New UserInfo(uu, s) With {.IsChannel = _IsChannel}
uid = -1
If Settings.UsersList.Count > 0 Then uid = Settings.UsersList.IndexOf(tmpUser)
If uid < 0 And Not UsersForCreate.Contains(tmpUser) Then

178
SCrawler/MainFrame.Designer.vb generated
View File

@@ -71,6 +71,7 @@ Partial Class MainFrame
Me.LIST_PROFILES = New System.Windows.Forms.ListView()
Me.USER_CONTEXT = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.BTT_CONTEXT_DOWN = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_DOWN_LIMITED = 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_FAV = New System.Windows.Forms.ToolStripMenuItem()
@@ -82,7 +83,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()
Me.BTT_CONTEXT_READY = 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()
@@ -114,7 +115,7 @@ Partial Class MainFrame
'CONTEXT_SEP_1
'
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(192, 6)
CONTEXT_SEP_1.Size = New System.Drawing.Size(218, 6)
'
'MENU_SETTINGS
'
@@ -158,22 +159,22 @@ Partial Class MainFrame
'CONTEXT_SEP_2
'
CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
CONTEXT_SEP_2.Size = New System.Drawing.Size(192, 6)
CONTEXT_SEP_2.Size = New System.Drawing.Size(218, 6)
'
'CONTEXT_SEP_3
'
CONTEXT_SEP_3.Name = "CONTEXT_SEP_3"
CONTEXT_SEP_3.Size = New System.Drawing.Size(192, 6)
CONTEXT_SEP_3.Size = New System.Drawing.Size(218, 6)
'
'CONTEXT_SEP_4
'
CONTEXT_SEP_4.Name = "CONTEXT_SEP_4"
CONTEXT_SEP_4.Size = New System.Drawing.Size(192, 6)
CONTEXT_SEP_4.Size = New System.Drawing.Size(218, 6)
'
'CONTEXT_SEP_5
'
CONTEXT_SEP_5.Name = "CONTEXT_SEP_5"
CONTEXT_SEP_5.Size = New System.Drawing.Size(192, 6)
CONTEXT_SEP_5.Size = New System.Drawing.Size(218, 6)
'
'SEP_4
'
@@ -422,101 +423,107 @@ Partial Class MainFrame
'
'USER_CONTEXT
'
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.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_READY, 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, 342)
Me.USER_CONTEXT.Size = New System.Drawing.Size(222, 364)
'
'BTT_CONTEXT_DOWN
'
Me.BTT_CONTEXT_DOWN.Image = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_CONTEXT_DOWN.Name = "BTT_CONTEXT_DOWN"
Me.BTT_CONTEXT_DOWN.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_DOWN.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_DOWN.Text = "Download data"
'
'BTT_CONTEXT_EDIT
'
Me.BTT_CONTEXT_EDIT.Image = Global.SCrawler.My.Resources.Resources.PencilPic_01_16
Me.BTT_CONTEXT_EDIT.Name = "BTT_CONTEXT_EDIT"
Me.BTT_CONTEXT_EDIT.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_EDIT.Text = "Edit user information"
'
'BTT_CONTEXT_DELETE
'
Me.BTT_CONTEXT_DELETE.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_CONTEXT_DELETE.Name = "BTT_CONTEXT_DELETE"
Me.BTT_CONTEXT_DELETE.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_DELETE.Text = "Delete user / collection"
'
'BTT_CONTEXT_FAV
'
Me.BTT_CONTEXT_FAV.Image = Global.SCrawler.My.Resources.Resources.StarPic_24
Me.BTT_CONTEXT_FAV.Name = "BTT_CONTEXT_FAV"
Me.BTT_CONTEXT_FAV.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_FAV.Text = "Change favorite"
'
'BTT_CONTEXT_TEMP
'
Me.BTT_CONTEXT_TEMP.Image = CType(resources.GetObject("BTT_CONTEXT_TEMP.Image"), System.Drawing.Image)
Me.BTT_CONTEXT_TEMP.Name = "BTT_CONTEXT_TEMP"
Me.BTT_CONTEXT_TEMP.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_TEMP.Text = "Change temporary"
'
'BTT_CONTEXT_GROUPS
'
Me.BTT_CONTEXT_GROUPS.Name = "BTT_CONTEXT_GROUPS"
Me.BTT_CONTEXT_GROUPS.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_GROUPS.Text = "Change labels"
'
'BTT_CONTEXT_ADD_TO_COL
'
Me.BTT_CONTEXT_ADD_TO_COL.Image = Global.SCrawler.My.Resources.Resources.DBPic_32
Me.BTT_CONTEXT_ADD_TO_COL.Name = "BTT_CONTEXT_ADD_TO_COL"
Me.BTT_CONTEXT_ADD_TO_COL.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_ADD_TO_COL.Text = "Add to collection"
'
'BTT_CONTEXT_COL_MERGE
'
Me.BTT_CONTEXT_COL_MERGE.Name = "BTT_CONTEXT_COL_MERGE"
Me.BTT_CONTEXT_COL_MERGE.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_COL_MERGE.Text = "Merge collection files"
'
'BTT_CHANGE_IMAGE
'
Me.BTT_CHANGE_IMAGE.Image = Global.SCrawler.My.Resources.Resources.PicturePic_32
Me.BTT_CHANGE_IMAGE.Name = "BTT_CHANGE_IMAGE"
Me.BTT_CHANGE_IMAGE.Size = New System.Drawing.Size(195, 22)
Me.BTT_CHANGE_IMAGE.Text = "Change image"
'
'BTT_CONTEXT_OPEN_PATH
'
Me.BTT_CONTEXT_OPEN_PATH.Image = Global.SCrawler.My.Resources.Resources.Folder_32
Me.BTT_CONTEXT_OPEN_PATH.Name = "BTT_CONTEXT_OPEN_PATH"
Me.BTT_CONTEXT_OPEN_PATH.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_OPEN_PATH.Text = "Open contains folder"
'
'BTT_CONTEXT_OPEN_SITE
'
Me.BTT_CONTEXT_OPEN_SITE.Image = Global.SCrawler.My.Resources.Resources.GlobeBlue_32
Me.BTT_CONTEXT_OPEN_SITE.Name = "BTT_CONTEXT_OPEN_SITE"
Me.BTT_CONTEXT_OPEN_SITE.Size = New System.Drawing.Size(195, 22)
Me.BTT_CONTEXT_OPEN_SITE.Text = "Open site"
'
'BTT_CONTEXT_INFO
'
Me.BTT_CONTEXT_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_CONTEXT_INFO.Name = "BTT_CONTEXT_INFO"
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.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_DOWN_LIMITED.Text = "Download data limited"
Me.BTT_CONTEXT_DOWN_LIMITED.ToolTipText = "Download top ... posts"
'
'BTT_CONTEXT_EDIT
'
Me.BTT_CONTEXT_EDIT.Image = Global.SCrawler.My.Resources.Resources.PencilPic_01_16
Me.BTT_CONTEXT_EDIT.Name = "BTT_CONTEXT_EDIT"
Me.BTT_CONTEXT_EDIT.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_EDIT.Text = "Edit user information"
'
'BTT_CONTEXT_DELETE
'
Me.BTT_CONTEXT_DELETE.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_CONTEXT_DELETE.Name = "BTT_CONTEXT_DELETE"
Me.BTT_CONTEXT_DELETE.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_DELETE.Text = "Delete user / collection"
'
'BTT_CONTEXT_FAV
'
Me.BTT_CONTEXT_FAV.Image = Global.SCrawler.My.Resources.Resources.StarPic_24
Me.BTT_CONTEXT_FAV.Name = "BTT_CONTEXT_FAV"
Me.BTT_CONTEXT_FAV.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_FAV.Text = "Change favorite"
'
'BTT_CONTEXT_TEMP
'
Me.BTT_CONTEXT_TEMP.Image = CType(resources.GetObject("BTT_CONTEXT_TEMP.Image"), System.Drawing.Image)
Me.BTT_CONTEXT_TEMP.Name = "BTT_CONTEXT_TEMP"
Me.BTT_CONTEXT_TEMP.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_TEMP.Text = "Change temporary"
'
'BTT_CONTEXT_GROUPS
'
Me.BTT_CONTEXT_GROUPS.Name = "BTT_CONTEXT_GROUPS"
Me.BTT_CONTEXT_GROUPS.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_GROUPS.Text = "Change labels"
'
'BTT_CONTEXT_ADD_TO_COL
'
Me.BTT_CONTEXT_ADD_TO_COL.Image = Global.SCrawler.My.Resources.Resources.DBPic_32
Me.BTT_CONTEXT_ADD_TO_COL.Name = "BTT_CONTEXT_ADD_TO_COL"
Me.BTT_CONTEXT_ADD_TO_COL.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_ADD_TO_COL.Text = "Add to collection"
'
'BTT_CONTEXT_COL_MERGE
'
Me.BTT_CONTEXT_COL_MERGE.Name = "BTT_CONTEXT_COL_MERGE"
Me.BTT_CONTEXT_COL_MERGE.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_COL_MERGE.Text = "Merge collection files"
'
'BTT_CHANGE_IMAGE
'
Me.BTT_CHANGE_IMAGE.Image = Global.SCrawler.My.Resources.Resources.PicturePic_32
Me.BTT_CHANGE_IMAGE.Name = "BTT_CHANGE_IMAGE"
Me.BTT_CHANGE_IMAGE.Size = New System.Drawing.Size(221, 22)
Me.BTT_CHANGE_IMAGE.Text = "Change image"
'
'BTT_CONTEXT_OPEN_PATH
'
Me.BTT_CONTEXT_OPEN_PATH.Image = Global.SCrawler.My.Resources.Resources.Folder_32
Me.BTT_CONTEXT_OPEN_PATH.Name = "BTT_CONTEXT_OPEN_PATH"
Me.BTT_CONTEXT_OPEN_PATH.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_OPEN_PATH.Text = "Open contains folder"
'
'BTT_CONTEXT_OPEN_SITE
'
Me.BTT_CONTEXT_OPEN_SITE.Image = Global.SCrawler.My.Resources.Resources.GlobeBlue_32
Me.BTT_CONTEXT_OPEN_SITE.Name = "BTT_CONTEXT_OPEN_SITE"
Me.BTT_CONTEXT_OPEN_SITE.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_OPEN_SITE.Text = "Open site"
'
'BTT_CONTEXT_INFO
'
Me.BTT_CONTEXT_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_CONTEXT_INFO.Name = "BTT_CONTEXT_INFO"
Me.BTT_CONTEXT_INFO.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_INFO.Text = "Information"
'
'BTT_CONTEXT_READY
'
Me.BTT_CONTEXT_READY.Name = "BTT_CONTEXT_READY"
Me.BTT_CONTEXT_READY.Size = New System.Drawing.Size(221, 22)
Me.BTT_CONTEXT_READY.Text = "Change ready for download"
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -586,4 +593,5 @@ Partial Class MainFrame
Private WithEvents BTT_CONTEXT_GROUPS As ToolStripMenuItem
Private WithEvents BTT_VERSION_INFO As ToolStripButton
Private WithEvents BTT_CONTEXT_DOWN_LIMITED As ToolStripMenuItem
Private WithEvents BTT_CONTEXT_READY As ToolStripMenuItem
End Class

18
SCrawler/MainFrame.vb
View File

@@ -250,7 +250,7 @@ CloseResume:
.DownloadVideos = f.DownloadVideos
.FriendlyName = f.UserFriendly
.Description = f.UserDescr
.Labels.ListAddList(f.UserLabels, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
.Self.Labels.ListAddList(f.UserLabels, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
.UpdateUserInformation()
End With
UserListUpdate(Settings.Users(Settings.Users.Count - 1), True)
@@ -485,6 +485,16 @@ CloseResume:
End Sub)
End If
End Sub
Private Sub BTT_CONTEXT_READY_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_READY.Click
Dim users As List(Of IUserData) = GetSelectedUserArray()
If AskForMassReplace(users, "Ready for download") Then
Dim r As Boolean = MsgBoxE({"What state do you want to set for selected users", "Select ready state"}, vbQuestion,,, {"Not Ready", "Ready"}).Index
users.ForEach(Sub(u)
u.ReadyForDownload = r
u.UpdateUserInformation()
End Sub)
End If
End Sub
Private Sub BTT_CONTEXT_GROUPS_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_GROUPS.Click
Try
Dim users As List(Of IUserData) = GetSelectedUserArray()
@@ -502,7 +512,7 @@ CloseResume:
If .Count > 0 Then .Collections.ForEach(Sub(uu) uu.Labels.ListAddList(f.LabelsList, lp))
End With
Else
u.Labels.ListAddList(f.LabelsList, lp)
u.Self.Labels.ListAddList(f.LabelsList, lp)
End If
u.UpdateUserInformation()
End Sub)
@@ -601,7 +611,7 @@ CloseResume:
End Sub
Private Sub BTT_CONTEXT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_INFO.Click
Dim user As IUserData = GetSelectedUser()
If Not user Is Nothing Then MsgBoxE(DirectCast(user, UserDataBase).GetUserInformation())
If Not user Is Nothing Then MsgBoxE(DirectCast(user.Self, UserDataBase).GetUserInformation())
End Sub
Private Sub USER_CONTEXT_VisibleChanged(sender As Object, e As EventArgs) Handles USER_CONTEXT.VisibleChanged
Try
@@ -690,7 +700,7 @@ CloseResume:
On Error Resume Next
If user.IsCollection Then
If USER_CONTEXT.Visible Then USER_CONTEXT.Hide()
MsgBoxE("This is collection!{vbNewLine}Edit collections does not allowed!", vbExclamation)
MsgBoxE($"This is collection!{vbNewLine}Edit collections does not allowed!", vbExclamation)
Else
Using f As New UserCreatorForm(user)
f.ShowDialog()

4
SCrawler/MainMod.vb
View File

@@ -163,9 +163,9 @@ Friend Module MainMod
Friend Sub ImageHandler(ByVal User As IUserData, ByVal Add As Boolean)
Try
If Add Then
AddHandler User.OnPictureUpdated, AddressOf MainFrame.User_OnPictureUpdated
AddHandler User.Self.OnPictureUpdated, AddressOf MainFrame.User_OnPictureUpdated
Else
RemoveHandler User.OnPictureUpdated, AddressOf MainFrame.User_OnPictureUpdated
RemoveHandler User.Self.OnPictureUpdated, AddressOf MainFrame.User_OnPictureUpdated
End If
Catch ex As Exception
End Try

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.3")>
<Assembly: AssemblyFileVersion("1.0.0.3")>
<Assembly: AssemblyVersion("1.0.0.4")>
<Assembly: AssemblyFileVersion("1.0.0.4")>
<Assembly: NeutralResourcesLanguage("en")>

2
SCrawler/SCrawler.vbproj
View File

@@ -14,6 +14,7 @@
<TargetFrameworkVersion>v4.6.1</TargetFrameworkVersion>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<Deterministic>true</Deterministic>
<IsWebBootstrapper>false</IsWebBootstrapper>
<PublishUrl>publish\</PublishUrl>
<Install>true</Install>
<InstallFrom>Disk</InstallFrom>
@@ -26,7 +27,6 @@
<MapFileExtensions>true</MapFileExtensions>
<ApplicationRevision>0</ApplicationRevision>
<ApplicationVersion>1.0.0.%2a</ApplicationVersion>
<IsWebBootstrapper>false</IsWebBootstrapper>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
</PropertyGroup>

20
SCrawler/SettingsCLS.vb
View File

@@ -106,17 +106,26 @@ Friend Class SettingsCLS : Implements IDisposable
If x.Count > 0 Then x.ForEach(Sub(xx) UsersList.Add(xx))
End Using
Dim PNC As Func(Of UserInfo, Boolean) = Function(u) Not u.IncludedInCollection
Dim NeedUpdate As Boolean = False
If UsersList.Count > 0 Then
Dim cUsers As List(Of UserInfo) = UsersList.Where(Function(u) u.IncludedInCollection).ToList
If cUsers.ListExists Then
Dim d As New Dictionary(Of SFile, List(Of UserInfo))
cUsers = cUsers.ListForEachCopy(Of List(Of UserInfo))(Function(ByVal f As UserInfo, ByVal f_indx As Integer) As UserInfo
If Not d.ContainsKey(f.File.CutPath(2).Path) Then
d.Add(f.File.CutPath(2).Path, New List(Of UserInfo) From {f})
Dim m% = IIf(f.Merged, 1, 2)
If SFile.GetPath(f.File.CutPath(m - 1).Path).Exists(SFO.Path, False) Then
Dim fp As SFile = SFile.GetPath(f.File.CutPath(m).Path)
If Not d.ContainsKey(fp) Then
d.Add(fp, New List(Of UserInfo) From {f})
Else
d(f.File.CutPath(2).Path).Add(f)
d(f.File.CutPath(m).Path).Add(f)
End If
Return f
Else
NeedUpdate = True
UsersList.Remove(f)
Return Nothing
End If
End Function, True)
Dim v%
If d.Count > 0 Then
@@ -138,8 +147,8 @@ Friend Class SettingsCLS : Implements IDisposable
t.Clear()
Dim du As List(Of UserInfo) = (From u As IUserData In Users
Where Not u.IsCollection AndAlso Not u.FileExists
Select DirectCast(u, UserDataBase).User).ToList
If Not du Is Nothing AndAlso du.Count > 0 Then du.ForEach(Sub(u) UsersList.Remove(u)) : du.Clear()
Select DirectCast(u.Self, UserDataBase).User).ToList
If du.ListExists Then du.ForEach(Sub(u) UsersList.Remove(u)) : du.Clear()
Users.ListDisposeRemoveAll(Function(ByVal u As IUserData) As Boolean
If u.IsCollection Then
With DirectCast(u, UserDataBind)
@@ -158,6 +167,7 @@ Friend Class SettingsCLS : Implements IDisposable
End If
End Function)
End If
If NeedUpdate Then UpdateUsersList()
End If
If Users.Count > 0 Then
Labels.ToList.ListAddList(Users.SelectMany(Function(u) u.Labels), LAP.NotContainsOnly)

2
SCrawler/TDownloader.vb
View File

@@ -132,7 +132,7 @@ Friend Class TDownloader : Implements IDisposable
End Try
End Sub
Private Function GetUserFromMainCollection(ByVal User As IUserData) As IUserData
Dim uSimple As Predicate(Of IUserData) = Function(u) u.Equals(DirectCast(User, UserDataBase))
Dim uSimple As Predicate(Of IUserData) = Function(u) u.Equals(DirectCast(User.Self, UserDataBase))
Dim uCol As Predicate(Of IUserData) = Function(ByVal u As IUserData) As Boolean
If u.IsCollection Then
Return DirectCast(u, UserDataBind).Collections.Exists(uSimple)