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

2023.6.8.0

Browse Source 
YT.Music: append artist name to music playlist output path
YT.MediaItem: fixed opening paths to downloaded playlists and channels
YT.YouTubeMediaContainerBase: save thumbnail path for playlist and channel
UserDataBase: remove old line of code
API.Twitter: fixed profile not fully downloaded
SiteEditorForm: corrected form size for small monitors
This commit is contained in:
Andy
2023-06-08 17:27:19 +03:00
parent 938042ea9e
commit e51debc027
11 changed files with 272 additions and 141 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
Changelog.md
View File

@@ -1,3 +1,15 @@
# 2023.6.8.0
*2023-06-08*
- Added
- YouTube: append artist name to music playlist output path
- YouTube: save thumbnail path for playlist and channel
- Fixed
- YouTube: opening paths to downloaded playlists and channels
- Twitter: profile not fully downloaded
- Corrected form size for small monitors (Issue #136)
# 2023.6.5.0
*2023-06-05*

8
SCrawler.YouTube/Controls/MusicPlaylistsForm.vb
View File

@@ -81,6 +81,14 @@ Namespace API.YouTube.Controls
If Not .UserTitle.IsEmptyString Then
Text = .UserTitle
If .ObjectType = Base.YouTubeMediaType.PlayList Then
If Not .PlaylistTitle.IsEmptyString AndAlso Not .PlaylistTitle = .UserTitle Then
Text &= $" - { .PlaylistTitle}"
ElseIf Not .Title.IsEmptyString AndAlso Not .Title = .UserTitle Then
Text &= $" - { .Title}"
End If
End If
If Not TXT_OUTPUT_PATH.IsEmptyString AndAlso Not TXT_OUTPUT_PATH.Text.Contains(.UserTitle) Then TXT_OUTPUT_PATH.Text = $"{TXT_OUTPUT_PATH.Text.TrimEnd("\")}\{ .UserTitle}\"
ElseIf Not .PlaylistTitle.IsEmptyString Then
Text = .PlaylistTitle
End If

35
SCrawler.YouTube/Downloader/MediaItem.vb
View File

@@ -115,31 +115,36 @@ Namespace DownloadObjects.STDownloader
Me.New
Const d$ = " " & ChrW(183) & " "
MyContainer = Container
MyContainer.Progress = MyProgress
If MyContainer.HasElements Then FileOption = SFO.Path Else FileOption = SFO.File
If Not MyContainer.SiteKey = YouTubeSiteKey Then
With MyContainer
.Progress = MyProgress
If .HasElements Then FileOption = SFO.Path Else FileOption = SFO.File
If .DownloadState = Plugin.UserMediaStates.Downloaded AndAlso
(.ObjectType = Base.YouTubeMediaType.Channel Or .ObjectType = Base.YouTubeMediaType.PlayList) AndAlso FileOption = SFO.File AndAlso
Not .File.Exists AndAlso .File.Exists(SFO.Path, False) Then FileOption = SFO.Path
If Not .SiteKey = YouTubeSiteKey Then
BTT_DOWN_AGAIN.Visible = False
SEP_DOWN_AGAIN.Visible = False
End If
ICON_SITE.Image = MyContainer.SiteIcon
LBL_TIME.Text = AConvert(Of String)(Container.Duration, TimeToStringProvider, String.Empty)
LBL_TITLE.Text = Container.ToString(True)
If Not Container.SiteKey = YouTubeSiteKey And Container.ContentType = Plugin.UserMediaTypes.Picture Then
LBL_INFO.Text = Container.File.Extension.StringToUpper
ElseIf Not Container.IsMusic Then
If Container.Height > 0 Then
LBL_INFO.Text = $"{Container.File.Extension.StringToUpper}{d}{Container.Height}p"
ICON_SITE.Image = .SiteIcon
LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty)
LBL_TITLE.Text = .ToString(True)
If Not .SiteKey = YouTubeSiteKey And .ContentType = Plugin.UserMediaTypes.Picture Then
LBL_INFO.Text = .File.Extension.StringToUpper
ElseIf Not .IsMusic Then
If .Height > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Height}p"
Else
LBL_INFO.Text = Container.File.Extension.StringToUpper
LBL_INFO.Text = .File.Extension.StringToUpper
End If
Else
If Container.Bitrate > 0 Then
LBL_INFO.Text = $"{Container.File.Extension.StringToUpper}{d}{Container.Bitrate}k"
If .Bitrate > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Bitrate}k"
Else
LBL_INFO.Text = Container.File.Extension.StringToUpper
LBL_INFO.Text = .File.Extension.StringToUpper
End If
End If
End With
UpdateMediaIcon()
End Sub
#End Region

4
SCrawler.YouTube/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("2023.6.5.0")>
<Assembly: AssemblyFileVersion("2023.6.5.0")>
<Assembly: AssemblyVersion("2023.6.8.0")>
<Assembly: AssemblyFileVersion("2023.6.8.0")>
<Assembly: NeutralResourcesLanguage("en")>

13
SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb
View File

@@ -1040,6 +1040,14 @@ Namespace API.YouTube.Objects
End Sub
#End Region
#Region "Save"
Private Function GetThumbnails() As IEnumerable(Of SFile)
If HasElements Then
Return ListAddList(Of SFile)(New List(Of SFile)({ThumbnailFile}),
Elements.SelectMany(Function(ee As YouTubeMediaContainerBase) ee.GetThumbnails))
Else
Return {ThumbnailFile}
End If
End Function
Public Overridable Sub Save() Implements IDownloadableMedia.Save
Try
Dim fSettings As SFile = FileSettings
@@ -1068,6 +1076,11 @@ Namespace API.YouTube.Objects
Else
If CachePath.Exists(SFO.Path, False) Then CachePath.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.None)
CachePath = Nothing
If ThumbnailFile.IsEmptyString And HasElements Then
With ListAddList(Nothing, GetThumbnails, LAP.NotContainsOnly).ListWithRemove(Function(tf) tf.IsEmptyString)
If .ListExists Then _ThumbnailFile = .FirstOrDefault(Function(tf) tf.Exists)
End With
End If
End If
Using x As New XmlFile With {.AllowSameNames = True}

4
SCrawler.YouTubeDownloader/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("2023.6.5.0")>
<Assembly: AssemblyFileVersion("2023.6.5.0")>
<Assembly: AssemblyVersion("2023.6.8.0")>
<Assembly: AssemblyFileVersion("2023.6.8.0")>
<Assembly: NeutralResourcesLanguage("en")>

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

@@ -1038,7 +1038,6 @@ BlockNullPicture:
_ContentList.Clear()
CreatedByChannel = False
End If
If Not UserExists Then ReadyForDownload = False
UpdateUserInformation()
If _CollectionButtonsExists AndAlso _EnvirChanged Then UpdateButtonsColor()
ElseIf _ForceSaveUserInfo Then

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

@@ -97,22 +97,73 @@ Namespace API.Twitter
Dim URL$ = String.Empty
Dim tCache As CacheKeeper = Nothing
Try
Const entry$ = "entry"
Dim PostID$ = String.Empty
Dim PostDate$, tmpUserId$
Dim j As EContainer
Dim nn As EContainer
Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False
Dim i%
Dim dirIndx% = -1
Dim timelineNode As Predicate(Of EContainer) = Function(ee) ee.Value("type").StringToLower = "timelineaddentries"
Dim pinNode As Predicate(Of EContainer) = Function(ee) ee.Value("type").StringToLower = "timelinepinentry"
Dim entriesNode As Predicate(Of EContainer) = Function(ee) ee.Name = "entries" Or ee.Name = entry
Dim sourceIdPredicate As Predicate(Of EContainer) = Function(ee) ee.Name = "source_user_id_str" Or ee.Name = "source_user_id"
Dim p As Predicate(Of EContainer)
Dim pIndx%
Dim isOneNode As Boolean, isPins As Boolean, ExistsDetected As Boolean, userInfoParsed As Boolean = False
Dim j As EContainer, rootNode As EContainer, tmpNode As EContainer, nn As EContainer = Nothing
Dim __parseContainer As Func(Of EContainer, Boolean) =
Function(ByVal ee As EContainer) As Boolean
If dirIndx <= 1 Then
nn = ee({"content", "itemContent", "tweet_results", "result", "legacy"})
Else
nn = ee
End If
If Not nn.ListExists Then nn = ee({"content", "itemContent", "tweet_results", "result", "tweet", "legacy"})
If nn.ListExists Then
PostID = nn.Value("id_str").IfNullOrEmpty(nn.Value("id"))
'Date Pattern:
'Sat Jan 01 01:10:15 +0000 2000
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
Select Case CheckDatesLimit(PostDate, Declarations.DateProvider)
Case DateResult.Skip, DateResult.Exit : Return False
End Select
If Not _TempPostsList.Contains(PostID) Then
_TempPostsList.Add(PostID)
ElseIf isPins Then
Return False
Else
ExistsDetected = True
Return False
End If
tmpUserId = nn({"retweeted_status_result", "result", "legacy", "user_id_str"}).XmlIfNothingValue
If tmpUserId.IsEmptyString Then tmpUserId = nn.ItemF({"extended_entities", "media", 0, sourceIdPredicate}).XmlIfNothingValue.
IfNullOrEmpty(nn.Value("user_id")).IfNullOrEmpty(nn.Value("user_id_str")).IfNullOrEmpty("/")
If Not ParseUserMediaOnly OrElse (Not ID.IsEmptyString AndAlso tmpUserId = ID) Then ObtainMedia(nn, PostID, PostDate)
End If
Return True
End Function
tCache = New CacheKeeper($"{DownloadContentDefault_GetRootDir()}\_tCache\")
If tCache.RootDirectory.Exists(SFO.Path, False) Then tCache.RootDirectory.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.ReturnValue)
tCache.Validate()
Dim f As SFile = GetTimelineFromGalleryDL(tCache.RootDirectory, Token)
If Not f.IsEmptyString Then
Dim dirs As List(Of SFile) = GetTimelineFromGalleryDL(tCache, Token)
If dirs.ListExists Then
For Each dir As SFile In dirs
dirIndx += 1
ExistsDetected = False
If Not dir.IsEmptyString Then
ThrowAny(Token)
Dim timelineFiles As List(Of SFile) = SFile.GetFiles(f, "*.txt",, EDP.ReturnValue)
Dim timelineFiles As List(Of SFile) = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue)
If timelineFiles.ListExists Then
Dim i%
ResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2))
'rename files
For i = 0 To timelineFiles.Count - 1 : timelineFiles(i) = RenameGdlFile(timelineFiles(i), i) : Next
@@ -121,6 +172,8 @@ Namespace API.Twitter
j = JsonDocument.Parse(timelineFiles(i).GetText)
If Not j Is Nothing Then
If i = 0 Then
If Not userInfoParsed Then
userInfoParsed = True
Dim resValue$ = j.Value({"data", "user", "result"}, "__typename").StringTrim.StringToLower
If resValue.IsEmptyString Then
UserExists = False
@@ -165,50 +218,56 @@ Namespace API.Twitter
End If
End With
End If
End If
Else
With j({"globalObjects", "tweets"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each nn In .Self
ProgressPre.Perform()
If nn.Count > 0 Then
PostID = nn.Value("id")
'Date Pattern:
'Sat Jan 01 01:10:15 +0000 2000
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
Select Case CheckDatesLimit(PostDate, Declarations.DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
For pIndx = 0 To IIf(dirIndx < 2, 1, 0)
Select Case dirIndx
Case 0, 1
rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"})
If rootNode.ListExists Then
p = If(pIndx = 0, pinNode, timelineNode)
isPins = pIndx = 0
rootNode = rootNode.Find(p, False)
If rootNode.ListExists Then rootNode = rootNode.Find(entriesNode, False)
End If
Case Else
isPins = False
rootNode = j({"globalObjects", "tweets"})
End Select
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
If rootNode.ListExists Then
With rootNode
isOneNode = dirIndx < 2 AndAlso .Name = entry
ProgressPre.ChangeMax(If(isOneNode, 1, .Count))
If isOneNode Then
ProgressPre.Perform()
If Not __parseContainer(.Self) Then Exit For
Else
ExistsDetected = True
Continue For
End If
tmpUserId = nn.ItemF({"extended_entities", "media", 0, "source_user_id"}).
XmlIfNothingValue.IfNullOrEmpty(nn.Value("user_id")).IfNullOrEmpty("/")
If Not ParseUserMediaOnly OrElse (Not ID.IsEmptyString AndAlso tmpUserId = ID) Then _
ObtainMedia(nn, PostID, PostDate)
End If
For Each tmpNode In .Self
ProgressPre.Perform()
If Not __parseContainer(tmpNode) Then Exit For
Next
End If
End With
End If
Next
'TODO: Twitter: is this line needed?
If ExistsDetected And i = 1 Then Exit For Else ExistsDetected = False
End If
j.Dispose()
End If
Next
timelineFiles.Clear()
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
Finally
If Not tCache Is Nothing Then tCache.Dispose()
If _TempPostsList.Count > 0 Then _TempPostsList.Sort()
End Try
End Sub
Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken)
@@ -249,8 +308,10 @@ Namespace API.Twitter
#End Region
#Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown)
Dim s As EContainer = e.ItemF({"extended_entities", "media"})
If s Is Nothing OrElse s.Count = 0 Then s = e.ItemF({"retweeted_status", "extended_entities", "media"})
Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
If If(s?.Count, 0) > 0 Then
Dim mUrl$
For Each m As EContainer In s
@@ -353,7 +414,7 @@ Namespace API.Twitter
Friend Sub New(ByVal Dir As SFile, ByVal _Token As CancellationToken)
MyBase.New
Commands.Clear()
ChangeDirectory(Dir)
If Not Dir.IsEmptyString Then ChangeDirectory(Dir)
Token = _Token
End Sub
Protected Overrides Async Function Validate(ByVal Value As String) As Task
@@ -395,25 +456,40 @@ Namespace API.Twitter
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{ToStringForLog()}: GetDataFromGalleryDL({command})")
End Try
End Function
Private Function GetTimelineFromGalleryDL(ByVal Cache As CacheKeeper, ByVal Token As CancellationToken) As SFile
Private Function GetTimelineFromGalleryDL(ByVal Cache As CacheKeeper, ByVal Token As CancellationToken) As List(Of SFile)
Dim command$ = String.Empty
Try
Dim conf As SFile = $"{Cache.NewPath.PathWithSeparator}TwitterGdlConfig.conf"
Dim confText$ = "{""extractor"":{""cookies"": """ & MySettings.CookiesNetscapeFile.ToString.Replace("\", "/") &
""",""cookies-update"": false,""twitter"":{""cards"": false,""conversations"": false,""pinned"": false,""quoted"": false,""replies"": true,""retweets"": true,""strategy"": null,""text-tweets"": false,""twitpic"": false,""unique"": true,""users"": ""timeline"",""videos"": true}}}"
""",""cookies-update"": false,""twitter"":{""cards"": false,""conversations"": true,""pinned"": false,""quoted"": false,""replies"": true,""retweets"": true,""strategy"": null,""text-tweets"": false,""twitpic"": false,""unique"": true,""users"": ""timeline"",""videos"": true}}}"
If conf.Exists(SFO.Path, True, EDP.ThrowException) Then TextSaver.SaveTextToFile(confText, conf)
If Not conf.Exists Then Throw New IO.FileNotFoundException("Can't find Twitter GDL config file", conf)
Dim outList As New List(Of SFile)
Dim rootDir As CacheKeeper = Cache.NewInstance
Dim dir As SFile
Using tgdl As New TwitterGDL(Nothing, Token) With {.TempPostsList = _TempPostsList, .AutoClear = True, .AutoReset = True}
For i As Byte = 0 To 2
dir = rootDir.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException)
outList.Add(dir)
tgdl.ChangeDirectory(dir)
command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages "
command &= GdlGetIdFilterString()
command &= $"https://twitter.com/search?q=from:{Name}+include:nativeretweets"
Dim dir As SFile = Cache.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException)
Select Case i
Case 0 : command &= $"https://twitter.com/{Name}/media"
Case 1 : command &= $"https://twitter.com/{Name}"
Case 2 : command &= $"https://twitter.com/search?q=from:{Name}+include:nativeretweets"
End Select
'#If DEBUG Then
'Debug.WriteLine(command)
'#End If
Using tgdl As New TwitterGDL(dir, Token) With {.TempPostsList = _TempPostsList} : tgdl.Execute(command) : End Using
Return dir
tgdl.Execute(command)
Next
End Using
Return outList
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{ToStringForLog()}: GetTimelineFromGalleryDL({command})")
End Try

6
SCrawler/Editors/SiteEditorForm.Designer.vb generated
View File

@@ -54,7 +54,7 @@ Namespace Editors
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(544, 218)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(544, 243)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -84,7 +84,7 @@ Namespace Editors
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(544, 218)
Me.TP_MAIN.Size = New System.Drawing.Size(544, 243)
Me.TP_MAIN.TabIndex = 0
'
'TXT_PATH
@@ -135,7 +135,7 @@ Namespace Editors
Me.TP_SITE_PROPS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_SITE_PROPS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_SITE_PROPS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_SITE_PROPS.Size = New System.Drawing.Size(538, 78)
Me.TP_SITE_PROPS.Size = New System.Drawing.Size(538, 103)
Me.TP_SITE_PROPS.TabIndex = 5
'
'TXT_PATH_SAVED_POSTS

18
SCrawler/Editors/SiteEditorForm.vb
View File

@@ -90,6 +90,11 @@ Namespace Editors
End If
If .PropList.Count > 0 Then
With TP_SITE_PROPS
With .RowStyles : .RemoveAt(.Count - 1) : End With
.RowCount -= 1
End With
Dim laAdded As Boolean = False
Dim loAdded As Boolean = False
Dim pArr() As Boolean
@@ -134,6 +139,19 @@ Namespace Editors
CH_GET_USER_MEDIA_ONLY.Padding = New PaddingE(CH_GET_USER_MEDIA_ONLY.Padding) With {.Left = offset}
If c > 0 Or h <> 0 Then
Dim ss As New Size(Size.Width, Size.Height + h + c)
Dim minScrh% = Screen.AllScreens.Min(Function(scr) scr.WorkingArea.Height)
If ss.Height >= minScrh - 20 Then
ss.Height = minScrh - 40
With TP_SITE_PROPS
.AutoScroll = True
Dim p As Padding = .Padding
p.Right = 3
.Padding = p
.PerformLayout()
End With
End If
MinimumSize = ss
Size = ss
MaximumSize = ss

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