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

2024.5.4.0

Browse Source 
YT
remove dots from the end of the file name; add a setting to remove specific characters

SCrawler
API.Instagram: simplify the 'Connection closed' error
API.Reddit: update token refresh request; add 'BearerTokenUseCurl' hidden property
API.Threads: fix frong header name ('dnt'); update 'UpdateCredentials' function
AutoDownloader: change 'IndexOutOfRangeException' to 'Exception' in the 'Download' function
TDownloader: fix 'FilesUpdatePendingUsers' function (freeze)
UserSearchForm: add 'FriendlyName' to search results
This commit is contained in:
Andy
2024-05-04 07:04:26 +03:00
parent 7d9255c916
commit ec2266f1bf
14 changed files with 109 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
Changelog.md
View File

@@ -1,3 +1,18 @@
# 2024.5.4.0
*2024-05-04*
- Added
- YouTube (standalone app): setting to remove specific characters (`Defaults` - `Remove characters`)
- Instagram: simplify the `Connection closed` error
- Users search: add 'FriendlyName' to search results
- Fixed
- YouTube (standalone app): incorrect download processing when the file name ends with a dot (Issue #188)
- The program is freezes when editing users in some cases
- Sites
- Reddit: token update error
- Threads: unable to obtain credentials (ID)
# 2024.4.26.0
*2024-04-26*

3
SCrawler.YouTube/Base/YouTubeSettings.vb
View File

@@ -243,6 +243,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program description"),
Description("Add some additional info to the program info if you need")>
Friend ReadOnly Property ProgramDescription As XMLValue(Of String)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"),
Description("Remove specific characters from a file name")>
Friend ReadOnly Property FileRemoveCharacters As XMLValue(Of String)
#End Region
#Region "Defaults ChannelsDownload"
<Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"),

6
SCrawler.YouTube/Declarations.vb
View File

@@ -59,8 +59,10 @@ Namespace API.YouTube
Friend Function CleanFileName(ByVal f As SFile) As SFile
If Not f.IsEmptyString And Not f.Name.IsEmptyString Then
Dim ff As SFile = f
ff.Name = ff.Name.StringRemoveWinForbiddenSymbols
If Not ff.Name.IsEmptyString Then ff.Name = ff.Name.Replace("%", String.Empty)
ff.Name = ff.Name.StringRemoveWinForbiddenSymbols.StringTrim
ff.Name = ff.Name.StringTrimEnd(".")
If Not ff.Name.IsEmptyString And Not MyYouTubeSettings.FileRemoveCharacters.IsEmptyString Then _
ff.Name = ff.Name.StringReplaceSymbols(MyYouTubeSettings.FileRemoveCharacters.Value.AsList.ListCast(Of String).ToArray, String.Empty, EDP.ReturnValue)
If ff.Name.IsEmptyString Then ff.Name = "file"
Return ff
Else

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

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

3
SCrawler/API/Instagram/UserData.vb
View File

@@ -1269,6 +1269,9 @@ NextPageBlock:
ElseIf Responser.StatusCode = 560 Or Responser.StatusCode = HttpStatusCode.InternalServerError Then '560, 500
MySiteSettings.SkipUntilNextSession = True
Err5xx = Responser.StatusCode
ElseIf Responser.StatusCode = -1 And Responser.Status = -1 Then
MySiteSettings.SkipUntilNextSession = True
Err5xx = Responser.StatusCode
Else
MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}/{CInt(Responser.Status)}]: {ToString()} [{s}]"
DisableSection(s)

50
SCrawler/API/Reddit/SiteSettings.vb
View File

@@ -10,6 +10,7 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
@@ -34,6 +35,8 @@ Namespace API.Reddit
"You can find different tokens in the responses. Make sure that bearer token belongs to Reddit and not RedGifs." & vbCr &
"There is not need to add a token if you are not using cookies to download the timeline.", IsAuth:=True)>
Friend ReadOnly Property BearerToken As PropertyValue
<PropertyOption(ControlText:="Use 'cUrl' to get a token", IsAuth:=True), PXML, PClonable, HiddenControl>
Private ReadOnly Property BearerTokenUseCurl As PropertyValue
#Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token",
AllowNull:=False, LeftOffset:=120, IsAuth:=True), PXML, PClonable>
@@ -82,6 +85,7 @@ Namespace API.Reddit
ApiClientID = New PropertyValue(String.Empty, GetType(String))
ApiClientSecret = New PropertyValue(String.Empty, GetType(String))
BearerToken = New PropertyValue(token, GetType(String), Sub(v) Responser.Headers.Add(DeclaredNames.Header_Authorization, v))
BearerTokenUseCurl = New PropertyValue(True)
TokenUpdateInterval = New PropertyValue(60 * 12)
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
BearerTokenDateUpdate = New PropertyValue(Now.AddYears(-1))
@@ -269,29 +273,51 @@ Namespace API.Reddit
result = False
Dim r$ = String.Empty
Dim c% = 0
Dim _found As Boolean
Dim useCurl As Boolean = Settings.CurlFile.Exists And CBool(BearerTokenUseCurl.Value)
Dim curlUsed As Boolean = useCurl
Do
c += 1
Using resp As New Responser With {
.Method = "POST",
.ProcessExceptionDecision = Function(status, obj, ee) If(status.StatusCode = 429, EDP.ReturnValue, ee)
.ProcessExceptionDecision = Function(ByVal status As IResponserStatus, ByVal nullArg As Object, ByVal currErr As ErrorsDescriber) As ErrorsDescriber
If status.StatusCode = 429 Then
useCurl = False
Return EDP.ReturnValue
ElseIf status.StatusCode = Net.HttpStatusCode.Forbidden And Not useCurl And Settings.CurlFile.Exists Then
useCurl = True
Return EDP.ReturnValue
Else
Return currErr
End If
End Function
}
With resp
With .PayLoadValues
.Add("grant_type", "password")
.Add("username", UserName)
.Add("password", Password)
End With
.CredentialsUserName = ClientID
.CredentialsPassword = ClientSecret
.PreAuthenticate = True
If useCurl Then
If Settings.CurlFile.Exists Then
curlUsed = True
.Mode = Responser.Modes.Curl
.CurlPath = Settings.CurlFile
.CurlArgumentsLeft = $"-d ""grant_type=password&username={UserName}&password={Password}"" --user ""{ClientID}:{ClientSecret}"""
Else
Throw New ArgumentNullException("cUrl file", "The path to the cUrl file is not specified")
End If
Else
.Mode = Responser.Modes.Default
With .PayLoadValues
.Add("grant_type", "password")
.Add("username", UserName)
.Add("password", Password)
End With
.CredentialsUserName = ClientID
.CredentialsPassword = ClientSecret
.PreAuthenticate = True
End If
End With
r = resp.GetResponse("https://www.reddit.com/api/v1/access_token",, EDP.ThrowException)
End Using
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
_found = True
Dim newToken$ = j.Value("access_token")
If Not newToken.IsEmptyString Then
BearerToken.Value = $"Bearer {newToken}"
@@ -302,7 +328,7 @@ Namespace API.Reddit
End If
End Using
End If
Loop While c < 5 And Not _found
Loop While c < 5 And Not result
End If
Return result
Catch ex As Exception

7
SCrawler/API/ThreadsNet/SiteSettings.vb
View File

@@ -40,10 +40,10 @@ Namespace API.ThreadsNet
Friend ReadOnly Property HH_ASBD_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True, IsAuth:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), ControlNumber(30), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue
Friend ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list, AllowNull:=True, IsAuth:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list), ControlNumber(40), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER_EXT As PropertyValue
Friend ReadOnly Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version, AllowNull:=True, IsAuth:=True, LeftOffset:=135,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version), ControlNumber(50), PClonable, PXML(OnlyForChecked:=True)>
Friend ReadOnly Property HH_PLATFORM_VER As PropertyValue
@@ -127,9 +127,10 @@ Namespace API.ThreadsNet
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "cors"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "same-origin"))
.Add("Sec-Fetch-User", "?1")
.Add("dht", 1)
.Add("dnt", 1)
.Add("drp", 1)
.Add(Instagram.UserData.GQL_HEADER_FB_FRINDLY_NAME, "BarcelonaProfileThreadsTabRefetchableQuery")
.Remove("dht")
End With
.CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll

16
SCrawler/API/ThreadsNet/UserData.vb
View File

@@ -164,16 +164,28 @@ Namespace API.ThreadsNet
.Method = "GET"
.Referer = URL
With .Headers
.Remove(GQL_HEADER_FB_LSD)
.Clear()
.Add("dnt", 1)
.Add("drp", 1)
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.threads.net"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.threads.net"))
.Add("Sec-Ch-Ua-Model", "")
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile, "?0"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform, """Windows"""))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, "document"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "none"))
.Add("Upgrade-Insecure-Requests", 1)
.Add("Sec-Fetch-User", "?1")
.Add(IGS.Header_Browser, MySettings.HH_BROWSER.Value)
.Add(IGS.Header_BrowserExt, MySettings.HH_BROWSER_EXT.Value)
End With
End With
WaitTimer()
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
ParseTokens(r, 0)
If ID.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""props"":\{""user_id"":""(\d+)""\},", 1, EDP.ReturnValue))
If ID.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""props"":\{""user_id"":""(\d+)""", 1, EDP.ReturnValue))
End If
Return Valid
Catch ex As Exception

16
SCrawler/Download/Automation/AutoDownloader.vb
View File

@@ -572,7 +572,19 @@ Namespace DownloadObjects
With Downloader
.AutoDownloaderWorking = True
If .Downloaded.Count > 0 Then .Downloaded.RemoveAll(Function(u) Keys.Contains(u.Key)) : .InvokeDownloadsChangeEvent()
Do : Try : doRound += 1 : .AddRange(users, True) : Exit Do : Catch iex As IndexOutOfRangeException : Thread.Sleep(200) : End Try : Loop While doRound < doLim
Do
Try
doRound += 1
.AddRange(users, True)
Exit Do
Catch iex As Exception
If doRound = doLim Then
Throw iex
Else
Thread.Sleep(200)
End If
End Try
Loop While doRound <= doLim
While .Working Or .Count > 0 : notify.Invoke() : Thread.Sleep(200) : End While
.AutoDownloaderWorking = False
notify.Invoke
@@ -586,7 +598,7 @@ Namespace DownloadObjects
End With
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[AutoDownloader.Download]")
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[AutoDownloader.Download({Name})]")
Finally
Keys.Clear()
LastDownloadDate = Now

2
SCrawler/Download/Feed/FeedSpecialCollection.vb
View File

@@ -236,7 +236,7 @@ Namespace DownloadObjects
Friend Sub UpdateUsers(ByVal InitialUser As UserInfo, ByVal NewUser As UserInfo)
Try
Load()
If Count > 0 Then
If Count > 0 AndAlso Not UserInfo.ExactEquals(InitialUser, NewUser) Then
Feeds.ForEach(Sub(f) f.UpdateUsers(InitialUser, NewUser))
If Downloader.Files.Count > 0 Then
PendingUsersToUpdate.Add(New KeyValuePair(Of UserInfo, UserInfo)(InitialUser, NewUser))

10
SCrawler/Download/TDownloader.vb
View File

@@ -191,9 +191,9 @@ Namespace DownloadObjects
End Sub
Private _FilesUpdating As Boolean = False
Friend Sub FilesUpdatePendingUsers()
_FilesUpdating = True
Try
If Files.Count > 0 Then
_FilesUpdating = True
With Settings.Feeds
Dim pUsers As List(Of KeyValuePair(Of UserInfo, UserInfo))
Dim pendingUser As KeyValuePair(Of UserInfo, UserInfo)
@@ -214,19 +214,21 @@ Namespace DownloadObjects
Next
End If
End With
If changed Then FilesSave()
If changed Then _FilesUpdating = False : FilesSave()
Next
pUsers.Clear()
End While
End With
_FilesUpdating = False
End If
Catch aex As ArgumentOutOfRangeException
_FilesUpdating = False
Catch iex As IndexOutOfRangeException
_FilesUpdating = False
Catch ex As Exception
_FilesUpdating = False
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[TDownloader.FilesUpdatePendingUsers]")
MainFrameObj.UpdateLogButton()
Finally
_FilesUpdating = False
End Try
End Sub
Friend Sub ClearSessions()

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

1
SCrawler/UserSearchForm.vb
View File

@@ -31,6 +31,7 @@ Friend Class UserSearchForm
Else
If User.IncludedInCollection Then Text &= $"[{User.CollectionName}] "
Text &= $"[{User.Site}] [{User.Name}]"
If Not User.FriendlyName.IsEmptyString Then Text &= $" ({User.FriendlyName})"
End If
End Sub
Private Function CompareTo(ByVal Other As SearchResult) As Integer Implements IComparable(Of SearchResult).CompareTo