Compare commits

..

2 Commits

Author SHA1 Message Date
Andy
d34414359c 2023.6.9.0
YT.MediaItem: fixed opening paths to downloaded playlists and channels
API.InternalSettingsForm: add members distinct
API.Mastodon: create personal EditorExchangeOptions class with some Twitter members disabled
API.Twitter: add 'DownloadModels'; update algo
Make progress more informative
2023-06-09 21:44:00 +03:00
Andy
e51debc027 2023.6.8.0
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
2023-06-08 17:27:19 +03:00
22 changed files with 482 additions and 207 deletions

View File

@@ -1,3 +1,24 @@
# 2023.6.9.0
*2023-06-09*
- Fixed
- YouTube: opening paths to downloaded playlists and channels
- Twitter: make the algorithm faster
- Make progress more informative
# 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*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.0 KiB

After

Width:  |  Height:  |  Size: 9.9 KiB

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

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
BTT_DOWN_AGAIN.Visible = False
SEP_DOWN_AGAIN.Visible = False
End If
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 = .File.Extension.StringToUpper
End If
Else
LBL_INFO.Text = Container.File.Extension.StringToUpper
If .Bitrate > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Bitrate}k"
Else
LBL_INFO.Text = .File.Extension.StringToUpper
End If
End If
Else
If Container.Bitrate > 0 Then
LBL_INFO.Text = $"{Container.File.Extension.StringToUpper}{d}{Container.Bitrate}k"
Else
LBL_INFO.Text = Container.File.Extension.StringToUpper
End If
End If
End With
UpdateMediaIcon()
End Sub
#End Region
@@ -375,7 +380,7 @@ Namespace DownloadObjects.STDownloader
m.Show()
End If
Else
If MyContainer.File.Exists(SFO.Path, False) Then MyContainer.File.Open(SFO.Path,, EDP.ShowMainMsg) Else m.Show()
If MyContainer.File.Exists(SFO.Path, False) Then GlobalOpenPath(MyContainer.File, EDP.ShowMainMsg) Else m.Show()
End If
End If
OnDoubleClick(e)

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.9.0")>
<Assembly: AssemblyFileVersion("2023.6.9.0")>
<Assembly: NeutralResourcesLanguage("en")>

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}

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.9.0")>
<Assembly: AssemblyFileVersion("2023.6.9.0")>
<Assembly: NeutralResourcesLanguage("en")>

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

View File

@@ -154,7 +154,8 @@ Namespace API.Base
Dim tmpObj As Object
members = GetObjectMembers(MyObject, Function(m) (m.MemberType = MemberTypes.Field Or m.MemberType = MemberTypes.Property) AndAlso
Not m.GetCustomAttribute(Of PSettingAttribute) Is Nothing)
Not m.GetCustomAttribute(Of PSettingAttribute) Is Nothing,, True,
New FComparer(Of MemberInfo)(Function(mm1, mm2) mm1.Name = mm2.Name))
providersMembersSettings = GetObjectMembers(MySettingsInstance, providersPredicate)
providersMembersObj = GetObjectMembers(MyObject, providersPredicate)

View File

@@ -0,0 +1,22 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Namespace API.Mastodon
Friend Class EditorExchangeOptions : Inherits Twitter.EditorExchangeOptions
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelMedia As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelProfile As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelSearch As Boolean
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
End Sub
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
End Sub
End Class
End Namespace

View File

@@ -139,9 +139,9 @@ Namespace API.Mastodon
#End Region
#Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse (Not TypeOf Options Is Twitter.EditorExchangeOptions OrElse
Not DirectCast(Options, Twitter.EditorExchangeOptions).SiteKey = MastodonSiteKey) Then _
Options = New Twitter.EditorExchangeOptions(Me) With {.SiteKey = MastodonSiteKey}
If Options Is Nothing OrElse (Not TypeOf Options Is EditorExchangeOptions OrElse
Not DirectCast(Options, EditorExchangeOptions).SiteKey = MastodonSiteKey) Then _
Options = New EditorExchangeOptions(Me) With {.SiteKey = MastodonSiteKey}
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If

View File

@@ -7,6 +7,7 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Imports DModels = SCrawler.API.Twitter.UserData.DownloadModels
Namespace API.Twitter
Friend Class EditorExchangeOptions
Private Const DefaultOffset As Integer = 100
@@ -23,6 +24,18 @@ Namespace API.Twitter
ToolTip:="Existing files will be checked for duplicates and duplicates removed." & vbCr &
"Works only on the first activation 'Use MD5 comparison'.", LeftOffset:=DefaultOffset)>
Friend Property RemoveExistingDuplicates As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Media'",
ToolTip:="Download the data using the 'https://twitter.com/UserName/media' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelMedia As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Profile'",
ToolTip:="Download the data using the 'https://twitter.com/UserName' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelProfile As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Search'",
ToolTip:="Download the data using the 'https://twitter.com/search?q=from:UserName+include:nativeretweets' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelSearch As Boolean = False
Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings)
GifsDownload = s.GifsDownload.Value
@@ -44,6 +57,14 @@ Namespace API.Twitter
GifsPrefix = u.GifsPrefix
UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates
If Not TypeOf u Is Mastodon.UserData Then
Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel)
If dm.ListExists Then
DownloadModelMedia = dm.Contains(DModels.Media)
DownloadModelProfile = dm.Contains(DModels.Profile)
DownloadModelSearch = dm.Contains(DModels.Search)
End If
End If
MySettings = u.HOST.Source
End Sub
End Class

View File

@@ -18,11 +18,21 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase
#Region "XML names"
Private Const Name_FirstDownloadComplete As String = "FirstDownloadComplete"
Private Const Name_DownloadModel As String = "DownloadModel"
Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
#End Region
#Region "Declarations"
Friend Enum DownloadModels As Integer
Undefined = 0
Media = 1
Profile = 2
Search = 5
End Enum
Private FirstDownloadComplete As Boolean = False
Friend Property DownloadModel As DownloadModels = DownloadModels.Undefined
Friend Property GifsDownload As Boolean = True
Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty
@@ -53,6 +63,10 @@ Namespace API.Twitter
GifsPrefix = .GifsPrefix
UseMD5Comparison = .UseMD5Comparison
RemoveExistingDuplicates = .RemoveExistingDuplicates
DownloadModel = DownloadModels.Undefined
If .DownloadModelMedia Then DownloadModel += DownloadModels.Media
If .DownloadModelProfile Then DownloadModel += DownloadModels.Profile
If .DownloadModelSearch Then DownloadModel += DownloadModels.Search
End With
End If
End Sub
@@ -62,25 +76,48 @@ Namespace API.Twitter
_DataNames = New List(Of String)
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
GifsDownload = Container.Value(Name_GifsDownload).FromXML(Of Boolean)(True)
GifsSpecialFolder = Container.Value(Name_GifsSpecialFolder)
If Not Container.Contains(Name_GifsPrefix) Then
GifsPrefix = "GIF_"
With Container
If Loading Then
If .Contains(Name_FirstDownloadComplete) Then
FirstDownloadComplete = .Value(Name_FirstDownloadComplete).FromXML(Of Boolean)(False)
DownloadModel = .Value(Name_DownloadModel).FromXML(Of Integer)(DownloadModels.Undefined)
Else
FirstDownloadComplete = DownloadedVideos(True) + DownloadedPictures(True) > 0
If .Contains(Name_DownloadModel) Then
DownloadModel = .Value(Name_DownloadModel).FromXML(Of Integer)(DownloadModels.Undefined)
Else
If FirstDownloadComplete Then
If ParseUserMediaOnly Then
DownloadModel = DownloadModels.Media
Else
DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search
End If
Else
DownloadModel = DownloadModels.Undefined
End If
End If
End If
GifsDownload = .Value(Name_GifsDownload).FromXML(Of Boolean)(True)
GifsSpecialFolder = .Value(Name_GifsSpecialFolder)
If Not .Contains(Name_GifsPrefix) Then
GifsPrefix = "GIF_"
Else
GifsPrefix = .Value(Name_GifsPrefix)
End If
UseMD5Comparison = .Value(Name_UseMD5Comparison).FromXML(Of Boolean)(False)
RemoveExistingDuplicates = .Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
Else
GifsPrefix = Container.Value(Name_GifsPrefix)
.Add(Name_FirstDownloadComplete, FirstDownloadComplete.BoolToInteger)
.Add(Name_DownloadModel, CInt(DownloadModel))
.Add(Name_GifsDownload, GifsDownload.BoolToInteger)
.Add(Name_GifsSpecialFolder, GifsSpecialFolder)
.Add(Name_GifsPrefix, GifsPrefix)
.Add(Name_UseMD5Comparison, UseMD5Comparison.BoolToInteger)
.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
End If
UseMD5Comparison = Container.Value(Name_UseMD5Comparison).FromXML(Of Boolean)(False)
RemoveExistingDuplicates = Container.Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
StartMD5Checked = Container.Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
Else
Container.Add(Name_GifsDownload, GifsDownload.BoolToInteger)
Container.Add(Name_GifsSpecialFolder, GifsSpecialFolder)
Container.Add(Name_GifsPrefix, GifsPrefix)
Container.Add(Name_UseMD5Comparison, UseMD5Comparison.BoolToInteger)
Container.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
Container.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
End If
End With
End Sub
#End Region
#Region "Download functions"
@@ -97,118 +134,190 @@ 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
ThrowAny(Token)
Dim timelineFiles As List(Of SFile) = SFile.GetFiles(f, "*.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
'parse files
For i = 0 To timelineFiles.Count - 1
j = JsonDocument.Parse(timelineFiles(i).GetText)
If Not j Is Nothing Then
If i = 0 Then
Dim resValue$ = j.Value({"data", "user", "result"}, "__typename").StringTrim.StringToLower
If resValue.IsEmptyString Then
UserExists = False
j.Dispose()
Exit Sub
ElseIf resValue = "userunavailable" Then
UserSuspended = True
j.Dispose()
Exit Sub
Else
With j({"data", "user", "result"})
If .ListExists Then
If ID.IsEmptyString Then
ID = .Value("rest_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
With .Item({"legacy"})
If .ListExists Then
If .Value("screen_name").StringToLower = Name.ToLower Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim __imgFile As SFile = UrlFile(img, True)
If Not __imgFile.Name.IsEmptyString Then
If __imgFile.Extension.IsEmptyString Then __imgFile.Extension = "jpg"
__imgFile.Path = MyFile.CutPath.Path
If Not __imgFile.Exists Then GetWebFile(img, __imgFile, EDP.None)
If __imgFile.Exists Then IconBannerDownloaded = True
End If
End If
End Sub
Dim icon$ = .Value("profile_image_url_https")
If Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
If DownloadIconBanner Then
__getImage.Invoke(.Value("profile_banner_url"))
__getImage.Invoke(icon)
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(dir, "*.txt",, EDP.ReturnValue)
If timelineFiles.ListExists Then
ResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2))
'rename files
For i = 0 To timelineFiles.Count - 1 : timelineFiles(i) = RenameGdlFile(timelineFiles(i), i) : Next
'parse files
For i = 0 To timelineFiles.Count - 1
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
j.Dispose()
Exit Sub
ElseIf resValue = "userunavailable" Then
UserSuspended = True
j.Dispose()
Exit Sub
Else
With j({"data", "user", "result"})
If .ListExists Then
If ID.IsEmptyString Then
ID = .Value("rest_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
With .Item({"legacy"})
If .ListExists Then
If .Value("screen_name").StringToLower = Name.ToLower Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim __imgFile As SFile = UrlFile(img, True)
If Not __imgFile.Name.IsEmptyString Then
If __imgFile.Extension.IsEmptyString Then __imgFile.Extension = "jpg"
__imgFile.Path = MyFile.CutPath.Path
If Not __imgFile.Exists Then GetWebFile(img, __imgFile, EDP.None)
If __imgFile.Exists Then IconBannerDownloaded = True
End If
End If
End Sub
Dim icon$ = .Value("profile_image_url_https")
If Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
If DownloadIconBanner Then
__getImage.Invoke(.Value("profile_banner_url"))
__getImage.Invoke(icon)
End If
End If
End If
End With
End If
End If
End With
End With
End If
End If
End With
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")
Else
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
'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
End Select
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
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)
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
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
End With
End If
j.Dispose()
j.Dispose()
End If
Next
timelineFiles.Clear()
End If
Next
End If
Next
dirs.Clear()
End If
ThrowAny(Token)
If Not FirstDownloadComplete Then
_ForceSaveUserInfo = True
If DownloadModel = DownloadModels.Undefined Then
If ParseUserMediaOnly Then
DownloadModel = DownloadModels.Media
Else
DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search
End If
End If
End If
FirstDownloadComplete = True
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 +358,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 +464,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
@@ -384,7 +495,7 @@ Namespace API.Twitter
End If
command &= URL
'#If DEBUG Then
' Debug.WriteLine(command)
'Debug.WriteLine(command)
'#End If
batch.Execute(command)
End Using
@@ -395,27 +506,59 @@ 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 confCache As CacheKeeper = Cache.NewInstance(Of BatchFileExchanger)
Dim conf As SFile = $"{confCache.RootDirectory.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)
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)
'#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
Dim outList As New List(Of SFile)
Dim rootDir As CacheKeeper = Cache.NewInstance
Dim dir As SFile
Dim dm As List(Of DownloadModels) = EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing
Dim process As Boolean
Dim bProcess As Boolean = DownloadModel = DownloadModels.Undefined Or Not FirstDownloadComplete
Using tgdl As New TwitterGDL(Nothing, Token) With {
.TempPostsList = _TempPostsList,
.AutoClear = True,
.AutoReset = True,
.CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}",
.FileExchanger = confCache
}
tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = False
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()
Select Case i
Case 0 : command &= $"https://twitter.com/{Name}/media" : process = bProcess Or dm.Contains(DownloadModels.Media)
Case 1 : command &= $"https://twitter.com/{Name}" : process = bProcess Or dm.Contains(DownloadModels.Profile)
Case 2 : command &= $"https://twitter.com/search?q=from:{Name}+include:nativeretweets" : process = bProcess Or dm.Contains(DownloadModels.Search)
Case Else : process = False
End Select
'#If DEBUG Then
'Debug.WriteLine(command)
'#End If
ThrowAny(Token)
If process Then tgdl.Execute(command)
ThrowAny(Token)
Next
End Using
dm.Clear()
Return outList
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{ToStringForLog()}: GetTimelineFromGalleryDL({command})")
ProcessException(ex, Token, $"{ToStringForLog()}: GetTimelineFromGalleryDL({command})")
Return Nothing
End Try
End Function
Private Function GdlGetIdFilterString() As String

View File

@@ -24,6 +24,7 @@ Namespace DownloadObjects
Private WithEvents BTT_STOP As Button
Private WithEvents BTT_OPEN As Button
Private ReadOnly PR_MAIN As ProgressBar
Private ReadOnly PR_PRE As ProgressBar
Private ReadOnly LBL_INFO As Label
Private ReadOnly Icon As PictureBox
#End Region
@@ -39,6 +40,7 @@ Namespace DownloadObjects
TP_MAIN.ColumnCount = 1
TP_CONTROLS = New TableLayoutPanel With {.Margin = New Padding(0), .Dock = DockStyle.Fill}
PR_MAIN = New ProgressBar With {.Dock = DockStyle.Fill}
PR_PRE = New ProgressBar With {.Dock = DockStyle.Fill}
LBL_INFO = New Label With {.Text = String.Empty, .Dock = DockStyle.Fill}
Icon = New PictureBox With {
.SizeMode = PictureBoxSizeMode.Zoom,
@@ -66,7 +68,8 @@ Namespace DownloadObjects
With TP_CONTROLS
.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 30))
.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 30))
.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 150))
.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 75))
.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 75)) '150
.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100))
.ColumnCount = .ColumnStyles.Count
.RowStyles.Add(New RowStyle(SizeType.Percent, 100))
@@ -74,8 +77,9 @@ Namespace DownloadObjects
With .Controls
If Not img Is Nothing Then .Add(Icon, 0, 0)
.Add(BTT_STOP, 1, 0)
.Add(PR_MAIN, 2, 0)
.Add(LBL_INFO, 3, 0)
.Add(PR_PRE, 2, 0)
.Add(PR_MAIN, 3, 0)
.Add(LBL_INFO, 4, 0)
End With
End With
TP_MAIN.Controls.Add(TP_CONTROLS, 0, 0)
@@ -90,7 +94,8 @@ Namespace DownloadObjects
.Add(New ColumnStyle(SizeType.Absolute, 30))
.Add(New ColumnStyle(SizeType.Absolute, 30))
.Add(New ColumnStyle(SizeType.Absolute, 30))
.Add(New ColumnStyle(SizeType.Percent, 100))
.Add(New ColumnStyle(SizeType.Percent, 50))
.Add(New ColumnStyle(SizeType.Percent, 50)) '100
End With
.ColumnCount = .ColumnStyles.Count
.RowStyles.Add(New RowStyle(SizeType.Percent, 50))
@@ -100,7 +105,8 @@ Namespace DownloadObjects
.Add(BTT_START, 1, 0)
.Add(BTT_STOP, 2, 0)
.Add(BTT_OPEN, 3, 0)
.Add(PR_MAIN, 4, 0)
.Add(PR_PRE, 4, 0)
.Add(PR_MAIN, 5, 0)
End With
End With
With TP_MAIN
@@ -115,7 +121,7 @@ Namespace DownloadObjects
End If
With Job
.Progress = New MyProgressExt(PR_MAIN, LBL_INFO) With {.ResetProgressOnMaximumChanges = False}
.Progress = New MyProgressExt(PR_MAIN, PR_PRE, LBL_INFO) With {.ResetProgressOnMaximumChanges = False}
With DirectCast(.Progress, MyProgressExt)
AddHandler .ProgressChanged, AddressOf JobProgress_ProgressChanged
AddHandler .MaximumChanged, AddressOf JobProgress_MaximumChanged
@@ -197,7 +203,7 @@ Namespace DownloadObjects
End Sub
Private Sub JobProgress_Progress0Changed(ByVal Sender As Object, ByVal e As ProgressEventArgs)
If Not Job.Type = Download.SavedPosts Then
MainProgress.Value0 = DirectCast(Sender, MyProgressExt).Value0
MainProgress.Value0 = DirectCast(Job.Progress, MyProgressExt).Value0
MainProgress.Perform0(0)
End If
End Sub

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

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

View File

@@ -92,6 +92,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_DONATE = New System.Windows.Forms.ToolStripButton()
Me.Toolbar_BOTTOM = New System.Windows.Forms.StatusStrip()
Me.BTT_PR_INFO = New System.Windows.Forms.ToolStripStatusLabel()
Me.PR_PRE = New System.Windows.Forms.ToolStripProgressBar()
Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_JOBS_COUNT = New System.Windows.Forms.ToolStripStatusLabel()
Me.LBL_STATUS = New System.Windows.Forms.ToolStripStatusLabel()
@@ -122,10 +123,10 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_SILENT_MODE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_FEED_SHOW = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CHANNELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_DOWNLOADER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_DOWNLOADER = 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()
@@ -633,7 +634,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'
'Toolbar_BOTTOM
'
Me.Toolbar_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_PR_INFO, Me.PR_MAIN, Me.LBL_JOBS_COUNT, Me.LBL_STATUS})
Me.Toolbar_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_PR_INFO, Me.PR_PRE, Me.PR_MAIN, Me.LBL_JOBS_COUNT, Me.LBL_STATUS})
Me.Toolbar_BOTTOM.Location = New System.Drawing.Point(0, 439)
Me.Toolbar_BOTTOM.Name = "Toolbar_BOTTOM"
Me.Toolbar_BOTTOM.Size = New System.Drawing.Size(934, 22)
@@ -647,6 +648,12 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_PR_INFO.Padding = New System.Windows.Forms.Padding(0, 0, 3, 0)
Me.BTT_PR_INFO.Size = New System.Drawing.Size(19, 17)
'
'PR_PRE
'
Me.PR_PRE.Name = "PR_PRE"
Me.PR_PRE.Size = New System.Drawing.Size(100, 16)
Me.PR_PRE.Visible = False
'
'PR_MAIN
'
Me.PR_MAIN.Name = "PR_MAIN"
@@ -865,6 +872,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_CHANNELS.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_CHANNELS.Text = "Channels"
'
'BTT_TRAY_DOWNLOADER
'
Me.BTT_TRAY_DOWNLOADER.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_TRAY_DOWNLOADER.Name = "BTT_TRAY_DOWNLOADER"
Me.BTT_TRAY_DOWNLOADER.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_DOWNLOADER.Text = "Downloader"
'
'BTT_TRAY_SHOW_HIDE
'
Me.BTT_TRAY_SHOW_HIDE.Image = Global.SCrawler.My.Resources.Resources.ApplicationPic_16
@@ -893,13 +907,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_CLOSE_NO_SCRIPT.ToolTipText = "Close the program without executing the script"
Me.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = False
'
'BTT_TRAY_DOWNLOADER
'
Me.BTT_TRAY_DOWNLOADER.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_TRAY_DOWNLOADER.Name = "BTT_TRAY_DOWNLOADER"
Me.BTT_TRAY_DOWNLOADER.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_DOWNLOADER.Text = "Downloader"
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -1005,4 +1012,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Friend WithEvents MENU_DOWN_ALL As ToolStripDropDownButton
Private WithEvents BTT_TRAY_CHANNELS As ToolStripMenuItem
Private WithEvents BTT_TRAY_DOWNLOADER As ToolStripMenuItem
Private WithEvents PR_PRE As ToolStripProgressBar
End Class

View File

@@ -58,7 +58,7 @@ Public Class MainFrame
YouTube.MyCache = Settings.Cache
YouTube.MyYouTubeSettings = New YouTube.YTSettings_Internal
UpdateYouTubeSettings()
MainProgress = New MyProgressExt(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS, "Downloading profiles' data") With {
MainProgress = New MyProgressExt(Toolbar_BOTTOM, PR_MAIN, PR_PRE, LBL_STATUS, "Downloading profiles' data") With {
.ResetProgressOnMaximumChanges = False, .Visible = False}
Downloader = New TDownloader
InfoForm = New DownloadedInfoForm

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.9.0")>
<Assembly: AssemblyFileVersion("2023.6.9.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -114,62 +114,71 @@ Friend Class MyProgressExt : Inherits MyProgress
End If
End RaiseEvent
End Event
Private WithEvents PR_PRE As MyProgress
Private Sub PR_PRE_ProgressChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Handles PR_PRE.ProgressChanged
RaiseEvent Progress0Changed(Sender, e)
End Sub
Private Sub PR_PRE_MaximumChanged(ByVal Sender As Object, ByVal e As ProgressEventArgs) Handles PR_PRE.MaximumChanged
RaiseEvent Maximum0Changed(Sender, e)
End Sub
Friend Sub New()
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Friend Sub New(ByRef StatusStrip As StatusStrip, ByRef ProgressBar As ToolStripProgressBar, ByRef Label As ToolStripStatusLabel,
Friend Sub New(ByRef StatusStrip As StatusStrip, ByRef ProgressBar As ToolStripProgressBar, ByRef ProgressBarPre As ToolStripProgressBar, ByRef Label As ToolStripStatusLabel,
Optional ByVal Information As String = Nothing)
MyBase.New(StatusStrip, ProgressBar, Label, Information)
PR_PRE = New MyProgress(StatusStrip, ProgressBarPre, Nothing) With {.PerformMod = 10, .ResetProgressOnMaximumChanges = False}
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Friend Sub New(ByRef ProgressBar As ProgressBar, ByRef Label As Label, Optional ByVal Information As String = Nothing)
Friend Sub New(ByRef ProgressBar As ProgressBar, ByRef ProgressBarPre As ProgressBar, ByRef Label As Label, Optional ByVal Information As String = Nothing)
MyBase.New(ProgressBar, Label, Information)
PR_PRE = New MyProgress(ProgressBarPre, Nothing) With {.PerformMod = 10, .ResetProgressOnMaximumChanges = False}
_Progress0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
_Maximum0ChangedEventHandlers = New List(Of EventHandler(Of ProgressEventArgs))
End Sub
Private _Maximum0 As Double = 0
Friend Property Maximum0 As Double
Get
Return _Maximum0
Return PR_PRE.Maximum
End Get
Set(ByVal v As Double)
Dim b As Boolean = Not _Maximum0 = v
_Maximum0 = v
If ResetProgressOnMaximumChanges Then Value0 = 0
If b Then RaiseEvent Maximum0Changed(Me, Nothing)
PR_PRE.Maximum = v
End Set
End Property
Friend Property Value0 As Double
Get
Return PR_PRE.Value
End Get
Set(ByVal v As Double)
PR_PRE.Value = v
End Set
End Property
Friend Property Value0 As Double = 0
Friend Sub Perform0(Optional ByVal Value As Double = 1)
Value0 += Value
If Perform(0, 10, False, False) Then RaiseEvent Progress0Changed(Me, Nothing)
PR_PRE.Perform(Value)
End Sub
Public Overloads Overrides Sub Perform(Optional ByVal Value As Double = 1)
If Perform(Value, PerformMod, True, True) Then OnProgressChanged()
End Sub
Public Overloads Function Perform(ByVal Value As Double, ByVal pm As Integer, ByVal SetText As Boolean, ByVal InvokeProgressChangeHandler As Boolean) As Boolean
Me.Value += Value
If Me.Value < 0 Then Me.Value = 0
Dim v# = Me.Value + Value0
Dim m# = Maximum + Maximum0
If pm = 0 OrElse (v Mod pm) = 0 OrElse v = m Then PerformImpl(GetPercentage(v, m), SetText, InvokeProgressChangeHandler) : Return True
Return False
End Function
Public Overrides Sub Done()
Value0 = Maximum0
PR_PRE.Done()
MyBase.Done()
End Sub
Public Overrides Sub Reset()
MyBase.Reset()
Value0 = 0
Maximum0 = 0
PR_PRE.Done()
End Sub
Public Overrides Property Visible(Optional ByVal ProgressBar As Boolean = True, Optional ByVal Label As Boolean = True) As Boolean
Get
Return MyBase.Visible(ProgressBar, Label)
End Get
Set(ByVal _Visible As Boolean)
MyBase.Visible(ProgressBar, Label) = _Visible
PR_PRE.Visible(ProgressBar, Label) = _Visible
End Set
End Property
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then
_Progress0ChangedEventHandlers.Clear()
_Maximum0ChangedEventHandlers.Clear()
PR_PRE.Dispose()
End If
MyBase.Dispose(disposing)
End Sub

View File

@@ -8,7 +8,7 @@
' but WITHOUT ANY WARRANTY
Imports System.Runtime.CompilerServices
Namespace Plugin.Attributes
Public Enum SettingAddress : Both : Settings : User : End Enum
Public Enum SettingAddress : Both : Settings : User : None : End Enum
Public Class PSettingAttribute : Inherits Attribute
Public Number As Integer = 0
Friend ReadOnly Name As String

View File

@@ -178,6 +178,7 @@
<Compile Include="API\LPSG\UserData.vb" />
<Compile Include="API\Mastodon\Credentials.vb" />
<Compile Include="API\Mastodon\Declarations.vb" />
<Compile Include="API\Mastodon\EditorExchangeOptions.vb" />
<Compile Include="API\Mastodon\MastodonDomains.vb" />
<Compile Include="API\Mastodon\SettingsForm.Designer.vb">
<DependentUpon>SettingsForm.vb</DependentUpon>