diff --git a/Changelog.md b/Changelog.md index 8cfe317..5f04ba3 100644 --- a/Changelog.md +++ b/Changelog.md @@ -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 diff --git a/README.md b/README.md index ae1f18e..37373a9 100644 --- a/README.md +++ b/README.md @@ -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)** diff --git a/SCrawler/API/Base/UserDataBase.vb b/SCrawler/API/Base/UserDataBase.vb index 06f1d6d..24bdc7e 100644 --- a/SCrawler/API/Base/UserDataBase.vb +++ b/SCrawler/API/Base/UserDataBase.vb @@ -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: ''' 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 @@ -597,7 +603,7 @@ BlockNullPicture: If _TempMediaList.Count > 0 Then If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UserMedia.Types.GIF Or m.Type = UserMedia.Types.Picture) If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UserMedia.Types.Video Or - m.Type = UserMedia.Types.VideoPre Or m.Type = UserMedia.Types.m3u8) + m.Type = UserMedia.Types.VideoPre Or m.Type = UserMedia.Types.m3u8) End If ReparseVideo(Token) @@ -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 - Return CompareTo(DirectCast(Obj, UserDataBase)) + 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 - Return Equals(DirectCast(Obj, UserDataBase)) + 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 ''' 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? diff --git a/SCrawler/API/Reddit/Channel.vb b/SCrawler/API/Reddit/Channel.vb index 665937c..b0527d6 100644 --- a/SCrawler/API/Reddit/Channel.vb +++ b/SCrawler/API/Reddit/Channel.vb @@ -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,23 +385,26 @@ 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 - Using d As New UserData(CUser, False, False) With { - .Progress = p, - .SaveToCache = True, - .SkipExistsUsers = SkipExists, - .ChannelInfo = Me - } - d.SetLimit(Me) - d.DownloadData(Token) - Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly) - Posts.Sort() - LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate) - Token.ThrowIfCancellationRequested() - End Using + If Not Instance Is Nothing Then + Instance.DownloadData(Token) + Else + Using d As New UserData(CUser, False, False) With { + .Progress = p, + .SaveToCache = True, + .SkipExistsUsers = SkipExists, + .ChannelInfo = Me + } + d.SetLimit(Me) + d.DownloadData(Token) + Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly) + Posts.Sort() + LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate) + 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 diff --git a/SCrawler/API/Reddit/UserData.vb b/SCrawler/API/Reddit/UserData.vb index 9a8700c..360ae1c 100644 --- a/SCrawler/API/Reddit/UserData.vb +++ b/SCrawler/API/Reddit/UserData.vb @@ -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 diff --git a/SCrawler/API/UserDataBind.vb b/SCrawler/API/UserDataBind.vb index 26314ce..8a65e54 100644 --- a/SCrawler/API/UserDataBind.vb +++ b/SCrawler/API/UserDataBind.vb @@ -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 ''' 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() diff --git a/SCrawler/DownloadedInfoForm.vb b/SCrawler/DownloadedInfoForm.vb index 8214bae..4f909d2 100644 --- a/SCrawler/DownloadedInfoForm.vb +++ b/SCrawler/DownloadedInfoForm.vb @@ -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 diff --git a/SCrawler/Editors/UserCreatorForm.Designer.vb b/SCrawler/Editors/UserCreatorForm.Designer.vb index f3809d0..a59dac7 100644 --- a/SCrawler/Editors/UserCreatorForm.Designer.vb +++ b/SCrawler/Editors/UserCreatorForm.Designer.vb @@ -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 \ No newline at end of file diff --git a/SCrawler/Editors/UserCreatorForm.vb b/SCrawler/Editors/UserCreatorForm.vb index cabcbcc..6c012f4 100644 --- a/SCrawler/Editors/UserCreatorForm.vb +++ b/SCrawler/Editors/UserCreatorForm.vb @@ -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 - End If - End If + 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 - 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 diff --git a/SCrawler/MainFrame.Designer.vb b/SCrawler/MainFrame.Designer.vb index 639a248..9fe1e33 100644 --- a/SCrawler/MainFrame.Designer.vb +++ b/SCrawler/MainFrame.Designer.vb @@ -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 diff --git a/SCrawler/MainFrame.vb b/SCrawler/MainFrame.vb index 4361170..286d8b8 100644 --- a/SCrawler/MainFrame.vb +++ b/SCrawler/MainFrame.vb @@ -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() diff --git a/SCrawler/MainMod.vb b/SCrawler/MainMod.vb index 8af08f8..0fcc186 100644 --- a/SCrawler/MainMod.vb +++ b/SCrawler/MainMod.vb @@ -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 diff --git a/SCrawler/My Project/AssemblyInfo.vb b/SCrawler/My Project/AssemblyInfo.vb index 368b9d5..070c958 100644 --- a/SCrawler/My Project/AssemblyInfo.vb +++ b/SCrawler/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler/SCrawler.vbproj b/SCrawler/SCrawler.vbproj index f2b28a6..e7855c1 100644 --- a/SCrawler/SCrawler.vbproj +++ b/SCrawler/SCrawler.vbproj @@ -14,6 +14,7 @@ v4.6.1 true true + false publish\ true Disk @@ -26,7 +27,6 @@ true 0 1.0.0.%2a - false false true diff --git a/SCrawler/SettingsCLS.vb b/SCrawler/SettingsCLS.vb index 2c590d4..8fb8f8f 100644 --- a/SCrawler/SettingsCLS.vb +++ b/SCrawler/SettingsCLS.vb @@ -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(m).Path).Add(f) + End If + Return f Else - d(f.File.CutPath(2).Path).Add(f) + NeedUpdate = True + UsersList.Remove(f) + Return Nothing End If - Return f 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) diff --git a/SCrawler/TDownloader.vb b/SCrawler/TDownloader.vb index 8fb3778..72719fd 100644 --- a/SCrawler/TDownloader.vb +++ b/SCrawler/TDownloader.vb @@ -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)