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

2022.9.16.0

Browse Source 
Removed some compatible functions
Fixed Settings.GetUser bug
Design improvements
Changed UserMediD comparer
FeedVideo design updated, incorrect time position fixed, bugs fixed
Fixed getting Reddit channel video thumbnail
This commit is contained in:
Andy
2022-09-16 19:41:24 +03:00
parent 9567b0a367
commit 92be0994ae
16 changed files with 204 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
Changelog.md
View File

@@ -1,3 +1,12 @@
# 2022.9.16.0
*2022-09-16*
- Fixed
- Failed to get video thumbnail for channel video post
- Incorrect rendering of the 'Feed' table when the number of columns is more than one
- Minor design bugs
# 2022.9.13.0
*2022-09-13*

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

@@ -1213,6 +1213,16 @@ BlockNullPicture:
Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If
End Function
Public Overrides Function GetHashCode() As Integer
Dim hcStr$
If Not CollectionName.IsEmptyString Then
hcStr = CollectionName
Else
hcStr = IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If
If hcStr.IsEmptyString Then hcStr = LVIKey
Return hcStr.GetHashCode
End Function
#Region "Buttons actions"
Private Sub BTT_CONTEXT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click
Downloader.Add(Me)

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

@@ -164,6 +164,8 @@ Namespace API.Reddit
End If
If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount
End If
If SaveToCache AndAlso Not Responser.Decoders.Contains(SymbolsConverter.Converters.HTML) Then _
Responser.Decoders.Add(SymbolsConverter.Converters.HTML)
DownloadDataChannel(String.Empty, Token)
If ChannelInfo Is Nothing Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
Else
@@ -371,9 +373,10 @@ Namespace API.Reddit
ElseIf Not s.Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
tmpUrl = s.Value({"media", "reddit_video"}, "fallback_url")
If SaveToCache Then
tmpUrl = s.Value("thumbnail")
'tmpUrl = s.Value("thumbnail")
tmpUrl = GetVideoRedditPreview(s)
If Not tmpUrl.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel, False), LNC)
_TotalPostsDownloaded += 1
End If
ElseIf UseM3U8 AndAlso Not s.Value({"media", "reddit_video"}, "hls_url").IsEmptyString Then
@@ -471,6 +474,38 @@ Namespace API.Reddit
Return False
End Try
End Function
Private Function GetVideoRedditPreview(ByVal Node As EContainer) As String
Try
If Not Node Is Nothing Then
Dim n As EContainer = Node.ItemF({"preview", "images", 0})
Dim DestNode$() = Nothing
If If(n?.Count, 0) > 0 Then
If If(n("resolutions")?.Count, 0) > 0 Then
DestNode = {"resolutions"}
ElseIf If(n({"variants", "nsfw", "resolutions"})?.Count, 0) > 0 Then
DestNode = {"variants", "nsfw", "resolutions"}
End If
If Not DestNode Is Nothing Then
With n(DestNode)
Dim sl As List(Of Sizes) = .Select(Function(e) New Sizes(e.Value("width"), e.Value("url"))).
ListWithRemove(Function(ss) ss.HasError Or ss.Data.IsEmptyString)
If sl.ListExists Then
Dim s As Sizes
sl.Sort()
s = sl.First
sl.Clear()
Return s.Data
End If
End With
End If
End If
End If
Return String.Empty
Catch ex As Exception
ProcessException(ex, Nothing, "reddit video preview parsing error", False)
Return String.Empty
End Try
End Function
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Try
ThrowAny(Token)
@@ -593,12 +628,13 @@ Namespace API.Reddit
#End Region
#Region "Structure creator"
Protected Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As UserMedia
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False,
Optional ByVal ReplacePreview As Boolean = True) As UserMedia
If _URL.IsEmptyString And t = UTypes.Picture Then Return Nothing
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}}
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = UrlToFile(m.URL) Else m.File = Nothing
If m.URL.Contains("preview") Then m.URL = $"https://i.redd.it/{m.File.File}"
If ReplacePreview And m.URL.Contains("preview") Then m.URL = $"https://i.redd.it/{m.File.File}"
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel), Nothing) Else m.Post.Date = Nothing
Return m
End Function

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 652 B

85
SCrawler/Download/DownloadFeedForm.vb
View File

@@ -44,6 +44,7 @@ Namespace DownloadObjects
Private Sub DownloadFeedForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
LastWinState = WindowState
With MyRange
.AutoToolTip = True
.ButtonKey(RCI.Previous) = Keys.F3
@@ -91,7 +92,7 @@ Namespace DownloadObjects
Dim p% = IIf(DataColumns = 1, 100, 50)
For i = 0 To DataColumns - 1 : .ColumnStyles.Add(New ColumnStyle(SizeType.Percent, p)) : Next
.ColumnCount = .ColumnStyles.Count
For i = 0 To DataRows - 1 : .RowStyles.Add(New RowStyle(SizeType.Absolute, 0)) : Next
For i = 0 To DataRows : .RowStyles.Add(New RowStyle(SizeType.Absolute, 0)) : Next
.RowCount = .RowStyles.Count
.HorizontalScroll.Visible = False
End With
@@ -177,8 +178,8 @@ Namespace DownloadObjects
Friend ReadOnly Row As Integer
Friend ReadOnly Column As Integer
Friend Sub New(ByVal RowsCount As Integer, ByVal ColumnsCount As Integer)
Me.RowsCount = RowsCount - 1
Me.ColumnsCount = ColumnsCount - 1
Me.RowsCount = RowsCount
Me.ColumnsCount = ColumnsCount
Row = 0
Column = 0
End Sub
@@ -190,86 +191,71 @@ Namespace DownloadObjects
Friend Function [Next]() As TPCELL
Dim r% = Row
Dim c% = Column + 1
If Not c.ValueBetween(0, ColumnsCount) Then c = 0 : r += 1
If Not c.ValueBetween(0, ColumnsCount - 1) Then c = 0 : r += 1
Return New TPCELL(RowsCount, ColumnsCount, r, c)
End Function
End Structure
Private RefillInProgress As Boolean = False
Private Sub MyRange_IndexChanged(ByVal Sender As IRangeSwitcherProvider, ByVal e As EventArgs) Handles MyRange.IndexChanged
Try
If Sender.CurrentIndex >= 0 Then
If Not RefillInProgress AndAlso Sender.CurrentIndex >= 0 Then
RefillInProgress = True
AllowTopScroll = False
ScrollSuspended = True
Dim d As List(Of Integer) = MyRange.Indexes(Sender.CurrentIndex, EDP.ReturnValue).ListIfNothing
Dim d As List(Of UserMediaD) = MyRange.Current
Dim d2 As List(Of UserMediaD)
Dim i%
If d.Count > 0 Then
If d.ListExists Then
ClearTable()
If Sender.CurrentIndex > 0 And FeedEndless Then
i = MyRange.Indexes(Sender.CurrentIndex - 1, EDP.ReturnValue).DefaultIfEmpty(-1).Last
If i.ValueBetween(0, DataList.Count - 1) Then
If d.Count = 0 Then d.Add(i) Else d.Insert(0, i)
End If
d2 = DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).Item(Sender.CurrentIndex - 1).ListTake(-2, DataColumns, EDP.ReturnValue).ListIfNothing
If d2.Count > 0 Then d.InsertRange(0, d2) : d2.Clear()
End If
Dim w% = GetWidth()
Dim hp% = PaddingE.GetOf({TP_DATA}).Vertical(2)
Dim p As New TPCELL(DataRows, DataColumns)
Dim fmList As New List(Of FeedMedia)
Dim rhd As New Dictionary(Of Integer, List(Of Integer))
For Each i In d
If i.ValueBetween(0, DataList.Count - 1) Then fmList.Add(New FeedMedia(DataList(i), w))
Next
d.ForEach(Sub(de) fmList.Add(New FeedMedia(de, w)))
If fmList.Count > 0 Then fmList.ListDisposeRemoveAll(Function(fm) fm Is Nothing OrElse fm.HasError)
If fmList.Count > 0 Then
For i = 0 To fmList.Count - 1
If Not rhd.ContainsKey(p.Row) Then rhd.Add(p.Row, New List(Of Integer))
rhd(p.Row).Add(fmList(i).Height)
p = p.Next
Next
p = New TPCELL(DataRows, DataColumns)
ControlInvoke(TP_DATA, Sub()
With TP_DATA
With .RowStyles
For i = 0 To .Count - 1
With .Item(i) : .SizeType = SizeType.Absolute : .Height = 0 : End With
Next
End With
.AutoScroll = False
.AutoScroll = True
End With
End Sub)
For i = 0 To fmList.Count - 1
ControlInvoke(TP_DATA, Sub()
With TP_DATA
With .RowStyles(p.Row) : .SizeType = SizeType.Absolute : .Height = rhd(p.Row).Max : End With
.Controls.Add(fmList(i), p.Column, p.Row)
End With
End Sub)
ControlInvoke(TP_DATA, Sub() TP_DATA.Controls.Add(fmList(i), p.Column, p.Row))
p = p.Next
Next
End If
ResizeGrid()
fmList.Clear()
rhd.ListForEach(Sub(kv, ii) kv.Value.Clear())
rhd.Clear()
d.Clear()
End If
RefillInProgress = False
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[DownloadObjects.DownloadFeedForm.Range.IndexChanged({Sender.CurrentIndex})]")
RefillInProgress = False
Finally
ControlInvoke(TP_DATA, Sub()
With TP_DATA.VerticalScroll
If Offset = 1 Then .Value = 0 Else .Value = .Maximum
End With
End Sub)
ScrollSuspended = False
DataPopulated = True
If Not RefillInProgress Then
ControlInvoke(TP_DATA, Sub()
With TP_DATA.VerticalScroll
If Offset = 1 Then .Value = 0 Else .Value = .Maximum
End With
End Sub)
ScrollSuspended = False
DataPopulated = True
End If
End Try
End Sub
#End Region
#Region "Size"
Private LastWinState As FormWindowState = FormWindowState.Normal
Private Function GetWidth() As Integer
Return (TP_DATA.Width - PaddingE.GetOf({Me, TP_DATA}).Horizontal(2)) / DataColumns
End Function
Private Sub DownloadFeedForm_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd
ResizeGrid()
End Sub
Private Sub DownloadFeedForm_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
If Not LastWinState = WindowState And Not If(MyDefs?.Initializing, True) Then LastWinState = WindowState : ResizeGrid()
End Sub
Private Sub ResizeGrid()
ControlInvoke(TP_DATA, Sub()
With TP_DATA
If .Controls.Count > 0 Then
@@ -282,9 +268,10 @@ Namespace DownloadObjects
If Not rh.ContainsKey(p.Row) Then rh.Add(p.Row, New List(Of Integer))
rh(p.Row).Add(cnt.Height)
Next
For i% = 0 To .RowStyles.Count - 1 : .RowStyles(i).Height = 0 : Next
If rh.Count > 0 Then
For Each kv In rh
With .RowStyles(kv.Key) : .SizeType = SizeType.Absolute : .Height = kv.Value.Max : End With
.RowStyles(kv.Key).Height = kv.Value.Max
kv.Value.Clear()
Next
End If

2
SCrawler/Download/FeedMedia.vb
View File

@@ -131,7 +131,6 @@ Namespace DownloadObjects
End With
End If
If Not MyVideo Is Nothing Then info &= $" ({MyVideo.VideoLength})"
LBL_INFO.Text = info
'TT_MAIN.SetToolTip(LBL_INFO, Information)
s = New Size(Width, h + TP_MAIN.RowStyles(0).Height + PaddingE.GetOf({TP_MAIN}).Vertical(2))
@@ -219,6 +218,7 @@ Namespace DownloadObjects
If Not Silent Then MsgBoxE({"File deleted", msgTitle})
LBL_INFO.Height = 0
If Not MyPicture Is Nothing Then MyPicture.Size = New Size(0, 0)
If Not MyVideo Is Nothing Then MyVideo.MinimumSize = New Size(0, 0) : MyVideo.Size = New Size(0, 0)
Height = 0
Return True
End If

43
SCrawler/Download/FeedVideo.Designer.vb generated
View File

@@ -24,13 +24,14 @@ Namespace DownloadObjects
Private Sub InitializeComponent()
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_BUTTONS As System.Windows.Forms.TableLayoutPanel
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(FeedVideo))
Me.MyVideo = New LibVLCSharp.WinForms.VideoView()
Me.TR_POSITION = New System.Windows.Forms.TrackBar()
Me.TR_VOLUME = New System.Windows.Forms.TrackBar()
Me.LBL_TIME = New System.Windows.Forms.Label()
Me.BTT_PLAY = New System.Windows.Forms.Button()
Me.BTT_PAUSE = New System.Windows.Forms.Button()
Me.BTT_STOP = New System.Windows.Forms.Button()
Me.TR_VOLUME = New System.Windows.Forms.TrackBar()
Me.LBL_TIME = New System.Windows.Forms.Label()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_BUTTONS = New System.Windows.Forms.TableLayoutPanel()
TP_MAIN.SuspendLayout()
@@ -99,6 +100,24 @@ Namespace DownloadObjects
TP_BUTTONS.Size = New System.Drawing.Size(178, 26)
TP_BUTTONS.TabIndex = 2
'
'TR_VOLUME
'
Me.TR_VOLUME.Dock = System.Windows.Forms.DockStyle.Fill
Me.TR_VOLUME.Location = New System.Drawing.Point(81, 3)
Me.TR_VOLUME.Name = "TR_VOLUME"
Me.TR_VOLUME.Size = New System.Drawing.Size(94, 20)
Me.TR_VOLUME.TabIndex = 3
'
'LBL_TIME
'
Me.LBL_TIME.AutoSize = True
Me.LBL_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_TIME.Location = New System.Drawing.Point(78, 0)
Me.LBL_TIME.Name = "LBL_TIME"
Me.LBL_TIME.Size = New System.Drawing.Size(1, 26)
Me.LBL_TIME.TabIndex = 4
Me.LBL_TIME.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
'
'BTT_PLAY
'
Me.BTT_PLAY.BackgroundImage = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
@@ -125,7 +144,7 @@ Namespace DownloadObjects
'
'BTT_STOP
'
Me.BTT_STOP.BackgroundImage = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_STOP.BackgroundImage = CType(resources.GetObject("BTT_STOP.BackgroundImage"), System.Drawing.Image)
Me.BTT_STOP.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Zoom
Me.BTT_STOP.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_STOP.Location = New System.Drawing.Point(51, 1)
@@ -135,24 +154,6 @@ Namespace DownloadObjects
Me.BTT_STOP.TabIndex = 2
Me.BTT_STOP.UseVisualStyleBackColor = True
'
'TR_VOLUME
'
Me.TR_VOLUME.Dock = System.Windows.Forms.DockStyle.Fill
Me.TR_VOLUME.Location = New System.Drawing.Point(81, 3)
Me.TR_VOLUME.Name = "TR_VOLUME"
Me.TR_VOLUME.Size = New System.Drawing.Size(94, 20)
Me.TR_VOLUME.TabIndex = 3
'
'LBL_TIME
'
Me.LBL_TIME.AutoSize = True
Me.LBL_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_TIME.Location = New System.Drawing.Point(78, 0)
Me.LBL_TIME.Name = "LBL_TIME"
Me.LBL_TIME.Size = New System.Drawing.Size(1, 26)
Me.LBL_TIME.TabIndex = 4
Me.LBL_TIME.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
'
'FeedVideo
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)

14
SCrawler/Download/FeedVideo.resx
View File

@@ -123,4 +123,18 @@
<metadata name="TP_BUTTONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="BTT_STOP.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAGLSURBVFhH7Vc7TsNAEPUNaDhAxAl8EaT0UKRFoqdNTcsp
qHIEHyGn4CNAiihwu7w3mTFrZeI466Ch4Emv8O7Mm9nd8X6qsWjbtgaXYAOmPWQfbWp1mw6ILcA16AUc
In0WKnM84DwDu9F+vb6kzcN9eru6TM8XZ+npvOqRbeyjDW3NTzVmKjsOcJiDGwpQ7P3meifgIdInS4Ra
c5UfBgw55eL4uXp0RzuW9KWG6VFbw/iAAUcuxh93t65oCalluoyh4fpAB9dcpv2UwY1ZEoyxWxNolILj
lHkCp2C2HI2G3QINsu4smilrfojUzgrzpx7wIf/5vmovhafFGJrA2oJzh5PMPAeyFJ4Wmc1CzQS4dcoG
4hmTpfC0SMbSBJZd8XEX84zJUnhaJGNpAg0TkI+h4iuFp0UylsXtEvAMjaXwtIz/Cfy9BCKLMPw3DN+I
YrdiPQ/iDiMCHxHHcf9mhIa4CwmBxtgrGYGOuEupAQZx13IDDOMeJgY4xD3NcsB5yuP0uFEPAWK/8Dyv
qm/Ki638CNApKAAAAABJRU5ErkJggg==
</value>
</data>
</root>

40
SCrawler/Download/FeedVideo.vb
View File

@@ -10,6 +10,7 @@ Imports LibVLCSharp
Imports System.ComponentModel
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Imports VLCState = LibVLCSharp.Shared.VLCState
Namespace DownloadObjects
<ToolboxItem(False), DesignTimeVisible(False)>
Public Class FeedVideo
@@ -21,11 +22,16 @@ Namespace DownloadObjects
Private ReadOnly TimeChangeLabel As Action = Sub()
If MediaPlayer.Time >= 0 Then
Dim t As TimeSpan = TimeSpan.FromMilliseconds(MediaPlayer.Time)
LBL_TIME.Text = $"{VideoLength}/{t}"
If Not VideoLength.HasValue Then
VideoLength = TimeSpan.FromMilliseconds(MediaPlayer.Length)
VideoLengthStr = VideoLength.Value.ToStringTime(FeedVideoLengthProvider)
End If
LBL_TIME.Text = $"{t.ToStringTime(FeedVideoLengthProvider)}/{VideoLengthStr}"
End If
End Sub
Private ReadOnly MyImage As ImageRenderer
Friend ReadOnly VideoLength As TimeSpan
Private VideoLength As TimeSpan?
Private VideoLengthStr As String
Public Sub New()
InitializeComponent()
End Sub
@@ -38,7 +44,6 @@ Namespace DownloadObjects
MediaPlayer = New [Shared].MediaPlayer(New [Shared].Media(New [Shared].LibVLC(enableDebugLogs:=debugLogs), New Uri(File.ToString)))
MyVideo.MediaPlayer = MediaPlayer
TR_VOLUME.Value = MediaPlayer.Volume / 10
If MediaPlayer.Length >= 0 Then VideoLength = TimeSpan.FromMilliseconds(MediaPlayer.Length)
If Settings.UseM3U8 Then
Dim f As SFile = $"{Settings.CachePath.PathWithSeparator}FeedSnapshots\{File.GetHashCode}.png"
If Not f.Exists Then f = FFMPEG.TakeSnapshot(File, f, Settings.FfmpegFile, TimeSpan.FromSeconds(1))
@@ -50,19 +55,30 @@ Namespace DownloadObjects
End If
End If
End If
UpdateButtons()
End Sub
Private Sub FeedVideo_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MediaPlayer Is Nothing Then MediaPlayer.Dispose()
If Not MyImage Is Nothing Then MyImage.Dispose()
End Sub
Private Sub BTT_PLAY_Click(sender As Object, e As EventArgs) Handles BTT_PLAY.Click
Try : MediaPlayer.Play() : Catch : End Try
Try
Select Case MediaPlayer.State
Case VLCState.NothingSpecial, VLCState.Stopped, VLCState.Paused : MediaPlayer.Play()
Case VLCState.Ended : MediaPlayer.Stop() : MediaPlayer.Play()
End Select
Catch
Finally
UpdateButtons()
End Try
End Sub
Private Sub BTT_PAUSE_Click(sender As Object, e As EventArgs) Handles BTT_PAUSE.Click
Try : MediaPlayer.Pause() : Catch : End Try
UpdateButtons()
End Sub
Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click
Try : MediaPlayer.Stop() : Catch : End Try
UpdateButtons()
End Sub
Private Sub MediaPlayer_TimeChanged(sender As Object, e As [Shared].MediaPlayerTimeChangedEventArgs) Handles MediaPlayer.TimeChanged
If TR_POSITION.InvokeRequired Then TR_POSITION.Invoke(TimeChange) Else TimeChange.Invoke
@@ -77,6 +93,22 @@ Namespace DownloadObjects
Private Sub MediaPlayer_Stopped(sender As Object, e As EventArgs) Handles MediaPlayer.Stopped
Dim a As Action = Sub() TR_POSITION.Value = TR_POSITION.Maximum
If TR_POSITION.InvokeRequired Then TR_POSITION.Invoke(a) Else a.Invoke
UpdateButtons()
End Sub
Private Sub UpdateButtons() Handles MediaPlayer.Playing, MediaPlayer.Paused, MediaPlayer.Opening
Try
Dim _play As Boolean = False, _pause As Boolean = False, _stop As Boolean = False
Select Case MediaPlayer.State
Case VLCState.NothingSpecial, VLCState.Stopped : _play = True
Case VLCState.Paused : _play = True : _stop = True
Case VLCState.Ended : _play = True
Case VLCState.Playing : _pause = True : _stop = True
End Select
ControlInvoke(BTT_PLAY, Sub() BTT_PLAY.Enabled = _play)
ControlInvoke(BTT_PAUSE, Sub() BTT_PAUSE.Enabled = _pause)
ControlInvoke(BTT_STOP, Sub() BTT_STOP.Enabled = _stop)
Catch
End Try
End Sub
End Class
End Namespace

17
SCrawler/Download/TDownloader.vb
View File

@@ -27,13 +27,22 @@ Namespace DownloadObjects
Friend ReadOnly User As IUserData
Friend ReadOnly Data As UserMedia
Friend ReadOnly [Date] As Date
Friend Sub New(ByVal Data As UserMedia, ByVal User As IUserData)
Private ReadOnly Session As Integer
Friend Sub New(ByVal Data As UserMedia, ByVal User As IUserData, ByVal Session As Integer)
Me.Data = Data
Me.User = User
[Date] = Now
Me.Session = Session
End Sub
Private Function CompareTo(ByVal Other As UserMediaD) As Integer Implements IComparable(Of UserMediaD).CompareTo
Return [Date].Ticks.CompareTo(Other.Date.Ticks) * -1
'Return [Date].Ticks.CompareTo(Other.Date.Ticks) * -1
Return GetCompareValue(Me).CompareTo(GetCompareValue(Other)) * -1
End Function
Private Function GetCompareValue(ByVal m As UserMediaD) As Double
Dim v# = m.Session * 10000
If Not m.User Is Nothing Then v += m.User.GetHashCode
'v += m.[Date].Ticks
Return v
End Function
Private Overloads Function Equals(ByVal Other As UserMediaD) As Boolean Implements IEquatable(Of UserMediaD).Equals
Return Data.File = Other.Data.File
@@ -214,12 +223,14 @@ Namespace DownloadObjects
#Region "Thread"
Private CheckerThread As Thread
Private MissingPostsDetected As Boolean = False
Private Session As Integer = 0
Private Sub [Start]()
If Not AutoDownloaderWorking AndAlso MyProgressForm.ReadyToOpen AndAlso Pool.LongCount(Function(p) p.Count > 0) > 1 Then MyProgressForm.Show() : MainFrameObj.Focus()
If Not If(CheckerThread?.IsAlive, False) Then
MainProgress.Visible = True
If Not AutoDownloaderWorking AndAlso InfoForm.ReadyToOpen Then InfoForm.Show() : MainFrameObj.Focus()
MissingPostsDetected = False
Session += 1
CheckerThread = New Thread(New ThreadStart(AddressOf JobsChecker))
CheckerThread.SetApartmentState(ApartmentState.MTA)
CheckerThread.Start()
@@ -342,7 +353,7 @@ Namespace DownloadObjects
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
If Not Downloaded.Contains(.Self) Then Downloaded.Add(Settings.GetUser(.Self))
With DirectCast(.Self, UserDataBase)
If .LatestData.Count > 0 Then Files.ListAddList(.LatestData.Select(Function(d) New UserMediaD(d, .Self)), FilesLP)
If .LatestData.Count > 0 Then Files.ListAddList(.LatestData.Select(Function(d) New UserMediaD(d, .Self, Session)), FilesLP)
End With
dcc = True
End If

1
SCrawler/MainMod.vb
View File

@@ -95,6 +95,7 @@ Friend Module MainMod
Friend MyProgressForm As ActiveDownloadingProgress
Friend MainFrameObj As MainFrameObjects
Friend ReadOnly ParsersDataDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Friend ReadOnly FeedVideoLengthProvider As New ADateTime("hh\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
Friend ReadOnly LogConnector As New LogHost
#Region "File name operations"
Friend FileDateAppenderProvider As IFormatProvider

4
SCrawler/My Project/AssemblyInfo.vb
View File

@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2022.9.13.0")>
<Assembly: AssemblyFileVersion("2022.9.13.0")>
<Assembly: AssemblyVersion("2022.9.16.0")>
<Assembly: AssemblyFileVersion("2022.9.16.0")>
<Assembly: NeutralResourcesLanguage("en")>

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

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

3
SCrawler/My Project/Resources.resx
View File

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

1
SCrawler/SCrawler.vbproj
View File

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

35
SCrawler/SettingsCLS.vb
View File

@@ -77,9 +77,7 @@ Friend Class SettingsCLS : Implements IDisposable
FastProfilesLoading = New XMLValue(Of Boolean)("FastProfilesLoading", False, MyXML)
MaxLargeImageHeight = New XMLValue(Of Integer)("MaxLargeImageHeight", 150, MyXML)
MaxLargeImageHeight.ReplaceByValue("MaxLargeImageHeigh",, MyXML)
MaxSmallImageHeight = New XMLValue(Of Integer)("MaxSmallImageHeight", 15, MyXML)
MaxSmallImageHeight.ReplaceByValue("MaxSmallImageHeigh",, MyXML)
DownloadOpenInfo = New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenInfo", "OpenAgain", False, False, MyXML)
DownloadOpenProgress = New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenProgress", "OpenAgain", False, False, MyXML)
DownloadsCompleteCommand = New XMLValueAttribute(Of String, Boolean)("DownloadsCompleteCommand", "Use",,, MyXML)
@@ -344,46 +342,23 @@ Friend Class SettingsCLS : Implements IDisposable
End Try
End Sub
Friend Overloads Function GetUser(ByVal User As IUserData, Optional ByVal GetCollection As Boolean = False) As IUserData
If Users.Count > 0 Then
Dim uSimple As Predicate(Of IUserData) = Function(u) u.Equals(DirectCast(User, 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)
Else
Return False
End If
End Function
Dim uu As Predicate(Of IUserData)
If User.IncludedInCollection Then uu = uCol Else uu = uSimple
Dim i% = Users.FindIndex(uu)
If i >= 0 Then
If Users(i).IsCollection Then
With DirectCast(Users(i), UserDataBind)
i = .Collections.FindIndex(uSimple)
If i >= 0 Then Return If(GetCollection, Users(i), .Collections(i))
End With
Else
Return Users(i)
End If
End If
End If
Return Nothing
Return GetUser(If(User?.Key, String.Empty), GetCollection)
End Function
Friend Overloads Function GetUser(ByVal UserKey As String, Optional ByVal GetCollection As Boolean = False) As IUserData
If Users.Count > 0 Then
If Users.Count > 0 And Not UserKey.IsEmptyString Then
Dim finder As Predicate(Of IUserData) = Function(u) u.Key = UserKey
Dim i%, ii%
For i = 0 To Users.Count - 1
With Users(i)
If .IsCollection Then
If finder.Invoke(.Self) Then
Return .Self
ElseIf .IsCollection Then
With DirectCast(.Self, UserDataBind)
If .Count > 0 Then
ii = .Collections.FindIndex(finder)
If ii >= 0 Then Return If(GetCollection, .Self, .Collections(ii))
End If
End With
Else
If finder.Invoke(.Self) Then Return .Self
End If
End With
Next