Skip to content

Commit

Permalink
3.0.0.6
Browse files Browse the repository at this point in the history 
Added GoTo Start/End channels buttons
Fixed saved Reddit posts downloading
Fixed Reddit accessibility check
Disabled main progress bar progress when downloading saved posts
Added Date and Time for Stories and Tagged Photos
  • Loading branch information
@AAndyProgram
AAndyProgram committed Apr 4, 2022
1 parent 11a590f commit 9a301eb
Show file tree
Hide file tree
Showing 10 changed files with 66 additions and 26 deletions.
11 changes: 11 additions & 0 deletions Changelog.md
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,14 @@
# 3.0.0.6

- Added
- ```GoTo Start``` channels button
- ```GoTo End``` channels button
- Fixed
- In some cases, saved Reddit posts didn't fully download
- Incorrect Reddit accessibility check algorithm
- Incorrect behavior of the main progress bar when downloading saved posts
- (Issue #25) Date and Time not added for Stories and Tagged Photos

# 3.0.0.5

- Added
Expand Down
27 changes: 17 additions & 10 deletions SCrawler/API/Base/DownDetector.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,25 +33,32 @@ Namespace API.Base
Friend Shared Function GetData(ByVal Site As String) As List(Of Data)
Try
Dim l As List(Of Data) = Nothing
Dim l2 As List(Of Data) = Nothing
Using w As New WebClient
Dim r$ = w.DownloadString($"https://downdetector.co.uk/status/{Site}/")
If Not r.IsEmptyString Then
l = FNF.RegexFields(Of Data)(r, {Params}, {1, 2})
If l.ListExists(2) Then
Dim lDate As Date = l(0).Date
Dim i%
Dim indx% = -1
For i = 1 To l.Count - 1
If l(i).Date < lDate Then indx = i : Exit For Else lDate = l(i).Date
Next
If indx >= 0 Then
For i = indx To 0 Step -1 : l.RemoveAt(i) : Next
End If
l.Sort()
l2 = New List(Of Data)
Dim d As Data
Dim eDates As New List(Of Date)
Dim MaxValue As Func(Of Date, Integer) = Function(dd) (From ddd In l Where ddd.Date = dd Select ddd.Value).DefaultIfEmpty(0).Max
For i% = 0 To l.Count - 1
If Not eDates.Contains(l(i).Date) Then
d = l(i)
d.Value = MaxValue(d.Date)
l2.Add(d)
eDates.Add(d.Date)
End If
Next
eDates.Clear()
l.Clear()
l2.Sort()
End If
End If
End Using
Return l
Return l2
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[DownDetector.GetData({Site})]")
End Try
Expand Down
30 changes: 26 additions & 4 deletions SCrawler/API/Instagram/UserData.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -390,11 +390,30 @@ Namespace API.Instagram
CreateMedia(node)
End If
End Sub
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing)
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing)
Try
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
If elem.Contains("taken_at") Then
Return elem.Value("taken_at")
ElseIf elem.Contains("imported_taken_at") Then
Return elem.Value("imported_taken_at")
Else
Dim ev$ = elem.Value("device_timestamp")
If Not ev.IsEmptyString Then
If ev.Length > 10 Then
Return elem.Value("device_timestamp").Substring(0, 10)
Else
Return ev
End If
Else
Return String.Empty
End If
End If
End Function
If n.Count > 0 Then
Dim l As New List(Of Sizes)
Dim d As EContainer
Expand All @@ -408,14 +427,15 @@ Namespace API.Instagram
Case 1
If n.Contains(img) Then
t = n.Value("media_type").FromXML(Of Integer)(-1)
DateObj = mDate(n)
If t >= 0 Then
With n.ItemF({img, "candidates"}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, Nothing, SpecialFolder), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
l.Clear()
End If
End If
Expand All @@ -424,22 +444,24 @@ Namespace API.Instagram
End If
Case 2
If n.Contains(vid) Then
DateObj = mDate(n)
With n.ItemF({vid}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, Nothing, SpecialFolder), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
l.Clear()
End If
End If
End With
End If
Case 8
DateObj = mDate(n)
With n("carousel_media").XmlIfNothing
If .Count > 0 Then
For Each d In .Self : ObtainMedia2(d, PostID, SpecialFolder) : Next
For Each d In .Self : ObtainMedia2(d, PostID, SpecialFolder, DateObj) : Next
End If
End With
End Select
Expand Down
3 changes: 0 additions & 3 deletions SCrawler/API/Reddit/Channel.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,6 @@ Namespace API.Reddit
Return Posts(Index)
End Get
End Property
Private ReadOnly Property Range As RangeSwitcher(Of UserPost)
Friend Property ViewMode As View = View.New Implements IRedditView.ViewMode
Friend Property ViewPeriod As Period = Period.All Implements IRedditView.ViewPeriod
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
Expand Down Expand Up @@ -219,7 +218,6 @@ Namespace API.Reddit
Posts = New List(Of UserPost)
PostsLatest = New List(Of UserPost)
PostsNames = New List(Of String)
Range = New RangeSwitcher(Of UserPost)(Me)
CountOfAddedUsers = New List(Of Integer)
CountOfLoadedPostsPerSession = New List(Of Integer)
ChannelExistentUserNames = New List(Of String)
Expand Down Expand Up @@ -410,7 +408,6 @@ Namespace API.Reddit
PostsNames.Clear()
CountOfAddedUsers.Clear()
CountOfLoadedPostsPerSession.Clear()
Range.Dispose()
ChannelExistentUserNames.Clear()
CachePath.Delete(SFO.Path, SFODelete.None, EDP.SendInLog)
End If
Expand Down
5 changes: 4 additions & 1 deletion SCrawler/API/Reddit/SiteSettings.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,10 @@ Namespace API.Reddit
Case Download.Channel : Return New UserData With {.SaveToCache = False, .SkipExistsUsers = False, .AutoGetLimits = True}
Case Download.SavedPosts
Dim u As New UserData With {.IsSavedPosts = True}
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
DirectCast(u, UserDataBase).User = New UserInfo With {
.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty)),
.IsChannel = True
}
Return u
End Select
Return Nothing
Expand Down
2 changes: 1 addition & 1 deletion SCrawler/API/Reddit/UserData.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -340,7 +340,7 @@ Namespace API.Reddit
If s.Contains("created") Then PostDate = s("created").Value Else PostDate = String.Empty
_UserID = s.Value("author")

If SkipExistsUsers AndAlso _ExistsUsersNames.Count > 0 AndAlso
If Not IsSavedPosts AndAlso SkipExistsUsers AndAlso _ExistsUsersNames.Count > 0 AndAlso
Not _UserID.IsEmptyString AndAlso _ExistsUsersNames.Contains(_UserID) Then
If Not IsSavedPosts AndAlso Not ChannelInfo Is Nothing Then _
ChannelInfo.ChannelExistentUserNames.ListAddValue(_UserID, LNC)
Expand Down
4 changes: 3 additions & 1 deletion SCrawler/Channels/ChannelViewForm.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -201,11 +201,12 @@ Friend Class ChannelViewForm : Implements IChannelLimits
MyRange = New RangeSwitcher(Of UserPost) With {.Selector = SelectorExpression}
With MyRange
.Limit = ImagesInRow * ImagesRows
.InsertButtons(ToolbarTOP, {RButton.Previous, RButton.Next}, 5)
.InsertButtons(ToolbarTOP,, 5)
.SetButtonKey(RButton.Previous, Keys.F2)
.SetButtonKey(RButton.Next, Keys.F3)
.BindForm(Me)
.LabelNumbersProvider = CProvider
.LabelShowAbsolutIndexes = False
.UpdateControls()
End With
AddHandler Settings.ChannelsImagesColumns.OnValueChanged, AddressOf ImagesCountChanged
Expand All @@ -215,6 +216,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
MyDefs.MyViewInitialize(Me, Settings.Design)
RefillChannels(Settings.LatestSelectedChannel.Value)
ChangeComboIndex(0)
MyRange.LabelText = String.Empty
CMB_CHANNELS_ActionOnCheckedChange(CMB_CHANNELS.Checked)
With LIST_POSTS
Dim s As Size = GetImageSize()
Expand Down
2 changes: 1 addition & 1 deletion SCrawler/Download/DownloadProgress.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -156,7 +156,7 @@ Namespace DownloadObjects
RaiseEvent OnTotalCountChange()
End Sub
Private Sub JobProgress_OnProgressChange(ByVal Source As IMyProgress, ByVal Index As Integer)
MainProgress.Perform()
If Not Job.Type = Download.SavedPosts Then MainProgress.Perform()
End Sub
#End Region
#Region "IDisposable Support"
Expand Down
4 changes: 1 addition & 3 deletions SCrawler/Download/TDownloader.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -254,9 +254,7 @@ Namespace DownloadObjects
Dim SiteChecked As Boolean = False
Do While _Job.Count > 0
_Job.ThrowIfCancellationRequested()
If Not SiteChecked Then
If Not _Job.Available Then Exit Sub Else SiteChecked = True : Continue Do
End If
If Not SiteChecked Then _Job.Available() : SiteChecked = True : Continue Do
UpdateJobsLabel()
DownloadData(_Job, _Job.Token)
_Job.ThrowIfCancellationRequested()
Expand Down
4 changes: 2 additions & 2 deletions SCrawler/My Project/AssemblyInfo.vb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>

<Assembly: AssemblyVersion("3.0.0.5")>
<Assembly: AssemblyFileVersion("3.0.0.5")>
<Assembly: AssemblyVersion("3.0.0.6")>
<Assembly: AssemblyFileVersion("3.0.0.6")>
<Assembly: NeutralResourcesLanguage("en")>

0 comments on commit 9a301eb

Please sign in to comment.