Merge branch 'Hex-Dragon:main' into Server
This commit is contained in:
tangge233
@@ -1,4 +1,5 @@
|
||||
Imports System.IO.Compression
|
||||
Imports System.Globalization
|
||||
Imports System.IO.Compression
|
||||
Imports System.Runtime.CompilerServices
|
||||
Imports System.Security.Cryptography
|
||||
Imports System.Security.Principal
|
||||
@@ -11,12 +12,13 @@ Public Module ModBase
|
||||
#Region "声明"
|
||||
|
||||
'下列版本信息由更新器自动修改
|
||||
Public Const VersionBaseName As String = "2.8.6" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.8.6." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const VersionBaseName As String = "2.8.7" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.8.7." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
|
||||
#If BETA Then
|
||||
Public Const VersionCode As Integer = 336 'Release
|
||||
#Else
|
||||
Public Const VersionCode As Integer = 335 'Snapshot
|
||||
Public Const VersionCode As Integer = 337 'Snapshot
|
||||
#End If
|
||||
'自动生成的版本信息
|
||||
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
|
||||
@@ -64,7 +66,7 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public ApplicationOpenTime As Date = Date.Now
|
||||
''' <summary>
|
||||
''' 设备唯一标识符。
|
||||
''' 识别码。
|
||||
''' </summary>
|
||||
Public UniqueAddress As String = SecretGetUniqueAddress()
|
||||
''' <summary>
|
||||
@@ -1240,9 +1242,15 @@ Re:
|
||||
Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
|
||||
If Not Directory.Exists(Path) Then Return 0
|
||||
Dim DeletedCount As Integer = 0
|
||||
Dim Temp As String()
|
||||
Temp = Directory.GetFiles(Path)
|
||||
For Each FilePath As String In Temp
|
||||
Dim Files As String()
|
||||
Try
|
||||
Files = Directory.GetFiles(Path)
|
||||
Catch ex As DirectoryNotFoundException '#4549
|
||||
Log(ex, $"疑似为孤立符号链接，尝试直接删除（{Path}）", LogLevel.Developer)
|
||||
Directory.Delete(Path)
|
||||
Return 0
|
||||
End Try
|
||||
For Each FilePath As String In Files
|
||||
Dim RetriedFile As Boolean = False
|
||||
RetryFile:
|
||||
Try
|
||||
@@ -1261,8 +1269,7 @@ RetryFile:
|
||||
End If
|
||||
End Try
|
||||
Next
|
||||
Temp = Directory.GetDirectories(Path)
|
||||
For Each str As String In Temp
|
||||
For Each str As String In Directory.GetDirectories(Path)
|
||||
DeleteDirectory(str, IgnoreIssue)
|
||||
Next
|
||||
Dim RetriedDir As Boolean = False
|
||||
@@ -1444,14 +1451,14 @@ RetryDir:
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 获取 Json 对象。
|
||||
''' 获取 JSON 对象。
|
||||
''' </summary>
|
||||
Public Function GetJson(Data As String)
|
||||
Try
|
||||
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
|
||||
Catch ex As Exception
|
||||
Dim Length As Integer = If(Data, "").Length
|
||||
Throw New Exception("格式化 json 对象失败：" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data))
|
||||
Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data))
|
||||
End Try
|
||||
End Function
|
||||
|
||||
@@ -1855,6 +1862,13 @@ RetryDir:
|
||||
Return NewProcess.ExitCode
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 判断当前系统语言是否为中文。
|
||||
''' </summary>
|
||||
Public Function IsSystemLanguageChinese() As Boolean
|
||||
Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
|
||||
End Function
|
||||
|
||||
Private Uuid As Integer = 1
|
||||
Private UuidLock As Object
|
||||
''' <summary>
|
||||
@@ -2660,7 +2674,11 @@ Retry:
|
||||
End Sub
|
||||
Public Function CanFeedback(ShowHint As Boolean) As Boolean
|
||||
If False.Equals(PageSetupSystem.IsLauncherNewest) Then
|
||||
If ShowHint Then MyMsgBox("你的 PCL 不是最新版，因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈")
|
||||
If ShowHint Then
|
||||
If MyMsgBox($"你的 PCL 不是最新版，因此无法提交反馈。{vbCrLf}请在更新后，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
|
||||
UpdateCheckByButton()
|
||||
End If
|
||||
End If
|
||||
Return False
|
||||
Else
|
||||
Return True
|
||||
|
||||
@@ -91,17 +91,18 @@
|
||||
_State = value
|
||||
Log("[Loader] 加载器 " & Name & " 状态改变：" & GetStringFromEnum(value))
|
||||
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
|
||||
RunInUi(Sub()
|
||||
Select Case value
|
||||
Case LoadState.Loading
|
||||
LoadingState = MyLoading.MyLoadingState.Run
|
||||
Case LoadState.Failed
|
||||
LoadingState = MyLoading.MyLoadingState.Error
|
||||
Case Else
|
||||
LoadingState = MyLoading.MyLoadingState.Stop
|
||||
End Select
|
||||
RaiseEvent OnStateChangedUi(Me, value, OldState)
|
||||
End Sub)
|
||||
RunInUi(
|
||||
Sub()
|
||||
Select Case value
|
||||
Case LoadState.Loading
|
||||
LoadingState = MyLoading.MyLoadingState.Run
|
||||
Case LoadState.Failed
|
||||
LoadingState = MyLoading.MyLoadingState.Error
|
||||
Case Else
|
||||
LoadingState = MyLoading.MyLoadingState.Stop
|
||||
End Select
|
||||
RaiseEvent OnStateChangedUi(Me, value, OldState)
|
||||
End Sub)
|
||||
If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState))
|
||||
End Set
|
||||
End Property
|
||||
@@ -566,7 +567,7 @@ Restart:
|
||||
End Class
|
||||
|
||||
'任务栏进度条
|
||||
Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
|
||||
Public LoaderTaskbar As New SynchronizedCollection(Of LoaderBase)
|
||||
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
|
||||
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
|
||||
|
||||
@@ -582,14 +583,14 @@ Restart:
|
||||
'检查任务是否完成，若完成则移除
|
||||
'外显任务是否已经全部完成
|
||||
Dim IsAllDownloadTaskCompleted As Boolean = True
|
||||
For Each Loader In LoaderTaskbar
|
||||
For Each Loader In LoaderTaskbar.ToList()
|
||||
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
|
||||
Next
|
||||
'若单个任务已中止或全部任务已完成，则刷新并移除
|
||||
For Each Task In LoaderTaskbar.ToList()
|
||||
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
|
||||
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
|
||||
LoaderTaskbar.TryTake(Task)
|
||||
LoaderTaskbar.Remove(Task)
|
||||
Log($"[Taskbar] {Task.Name} 已移出任务列表")
|
||||
End If
|
||||
Next
|
||||
|
||||
@@ -329,7 +329,7 @@ Retry:
|
||||
''' <summary>
|
||||
''' 同时发送多个网络请求并要求返回内容。
|
||||
''' </summary>
|
||||
Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing)
|
||||
Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True)
|
||||
Dim Threads As New List(Of Thread)
|
||||
Dim RequestResult = Nothing
|
||||
Dim RequestEx As Exception = Nothing
|
||||
@@ -338,7 +338,7 @@ Retry:
|
||||
Dim th As New Thread(
|
||||
Sub()
|
||||
Try
|
||||
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
|
||||
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers, MakeLog)
|
||||
Catch ex As Exception
|
||||
FailCount += 1
|
||||
RequestEx = ex
|
||||
@@ -1232,7 +1232,7 @@ SourceBreak:
|
||||
'根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
|
||||
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
|
||||
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
|
||||
(ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源
|
||||
((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403、429，所以不应因此禁用下载源
|
||||
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
|
||||
Info.Source.FailCount > NetTaskThreadLimit + 2 Then
|
||||
Dim IsThisFail As Boolean = False
|
||||
@@ -1344,7 +1344,7 @@ Retry:
|
||||
If Check.ActualSize = -1 Then
|
||||
Check.ActualSize = FileSize
|
||||
ElseIf Check.ActualSize <> FileSize Then
|
||||
Throw New Exception("文件大小不一致：任务要求为 " & Check.ActualSize & " B，网络获取结果为 " & FileSize & "B")
|
||||
Throw New Exception($"文件大小不一致：任务要求为 {Check.ActualSize} B，网络获取结果为 {FileSize}B")
|
||||
End If
|
||||
End If
|
||||
'检查文件
|
||||
@@ -1654,6 +1654,9 @@ NextElement:
|
||||
'复制已存在的文件
|
||||
For Each FileToken In ExistFiles
|
||||
Dim File As NetFile = FileToken.Key
|
||||
SyncLock LockState
|
||||
If File.State > NetState.WaitForCopy Then Exit Sub
|
||||
End SyncLock
|
||||
Dim LocalPath As String = FileToken.Value
|
||||
Dim RetryCount As Integer = 0
|
||||
Retry:
|
||||
@@ -1882,7 +1885,7 @@ Retry:
|
||||
For Each File As NetFile In WaitingFiles
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
|
||||
Dim NewThread = File.TryBeginThread()
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests
|
||||
Next
|
||||
'为进行中的文件追加线程
|
||||
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增
|
||||
@@ -1902,7 +1905,7 @@ Retry:
|
||||
'新增线程
|
||||
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程，不再新增
|
||||
Dim NewThread = File.TryBeginThread()
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests
|
||||
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests
|
||||
Next
|
||||
End While
|
||||
Catch ex As Exception
|
||||
@@ -2000,7 +2003,7 @@ Retry:
|
||||
''' 是否有正在进行中、需要在下载管理页面显示的下载任务？
|
||||
''' </summary>
|
||||
Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
|
||||
For Each Task In LoaderTaskbar
|
||||
For Each Task In LoaderTaskbar.ToList()
|
||||
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
|
||||
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
|
||||
Return True
|
||||
|
||||
@@ -66,8 +66,20 @@ Public Class MyBitmap
|
||||
Else
|
||||
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
|
||||
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
|
||||
Pic = New System.Drawing.Bitmap(InputStream)
|
||||
InputStream.Dispose()
|
||||
'判断是否为 WebP 文件头
|
||||
Dim Header(1) As Byte
|
||||
InputStream.Read(Header, 0, 2)
|
||||
InputStream.Seek(0, SeekOrigin.Begin)
|
||||
If Header(0) = 82 AndAlso Header(1) = 73 Then
|
||||
'读取 WebP
|
||||
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
|
||||
Dim FileBytes(InputStream.Length - 1) As Byte
|
||||
InputStream.Read(FileBytes, 0, FileBytes.Length)
|
||||
Dim Decoder As New Imazen.WebP.SimpleDecoder()
|
||||
Pic = Decoder.DecodeFromBytes(FileBytes, FileBytes.Length)
|
||||
Else
|
||||
Pic = New System.Drawing.Bitmap(InputStream)
|
||||
End If
|
||||
End Using
|
||||
End If
|
||||
Catch ex As Exception
|
||||
|
||||
@@ -247,7 +247,13 @@
|
||||
Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
|
||||
LastUpdate = Data("dateReleased") '#1194
|
||||
DownloadCount = Data("downloadCount")
|
||||
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
|
||||
If Data("logo").Count > 0 Then
|
||||
If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
|
||||
LogoUrl = Data("logo")("url")
|
||||
Else
|
||||
LogoUrl = Data("logo")("thumbnailUrl")
|
||||
End If
|
||||
End If
|
||||
'FileIndexes / GameVersions / ModLoaders
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
|
||||
@@ -417,7 +423,7 @@
|
||||
Json("DownloadCount") = DownloadCount
|
||||
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
|
||||
Json("Tags") = New JArray(Tags)
|
||||
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
|
||||
If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
|
||||
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
|
||||
Json("CacheTime") = Date.Now '用于检查缓存时间
|
||||
Return Json
|
||||
@@ -536,7 +542,7 @@
|
||||
Return NewItem
|
||||
End Function
|
||||
Public Function GetControlLogo() As String
|
||||
If LogoUrl Is Nothing Then
|
||||
If String.IsNullOrEmpty(LogoUrl) Then
|
||||
Return PathImage & "Icons/NoIcon.png"
|
||||
Else
|
||||
Return LogoUrl
|
||||
@@ -944,30 +950,30 @@ Retry:
|
||||
Dim CurseForgeFailed As Boolean = False
|
||||
If CurseForgeUrl IsNot Nothing Then
|
||||
CurseForgeThread = RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'获取工程列表
|
||||
Log("[Comp] 开始从 CurseForge 获取工程列表：" & CurseForgeUrl)
|
||||
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("data")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
RawResults.AddRange(ProjectList)
|
||||
End SyncLock
|
||||
Storage.CurseForgeOffset += ProjectList.Count
|
||||
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 CurseForge 获取工程列表失败")
|
||||
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
|
||||
[Error] = ex
|
||||
CurseForgeFailed = True
|
||||
End Try
|
||||
End Sub, "CurseForge Project Request")
|
||||
Sub()
|
||||
Try
|
||||
'获取工程列表
|
||||
Log("[Comp] 开始从 CurseForge 获取工程列表：" & CurseForgeUrl)
|
||||
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("data")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
RawResults.AddRange(ProjectList)
|
||||
End SyncLock
|
||||
Storage.CurseForgeOffset += ProjectList.Count
|
||||
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 CurseForge 获取工程列表失败")
|
||||
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
|
||||
[Error] = ex
|
||||
CurseForgeFailed = True
|
||||
End Try
|
||||
End Sub, "CurseForge Project Request")
|
||||
End If
|
||||
|
||||
'启动 Modrinth 线程
|
||||
@@ -975,32 +981,32 @@ Retry:
|
||||
Dim ModrinthFailed As Boolean = False
|
||||
If ModrinthUrl IsNot Nothing Then
|
||||
ModrinthThread = RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Log("[Comp] 开始从 Modrinth 获取工程列表：" & ModrinthUrl)
|
||||
Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("hits")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Sub()
|
||||
Try
|
||||
Log("[Comp] 开始从 Modrinth 获取工程列表：" & ModrinthUrl)
|
||||
Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("hits")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
For Each Project In ProjectList
|
||||
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件（#2458）
|
||||
RawResults.Add(Project)
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
For Each Project In ProjectList
|
||||
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件（#2458）
|
||||
RawResults.Add(Project)
|
||||
Next
|
||||
End SyncLock
|
||||
Storage.ModrinthOffset += ProjectList.Count
|
||||
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取工程列表失败")
|
||||
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
|
||||
[Error] = ex
|
||||
ModrinthFailed = True
|
||||
End Try
|
||||
End Sub, "Modrinth Project Request")
|
||||
End SyncLock
|
||||
Storage.ModrinthOffset += ProjectList.Count
|
||||
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取工程列表失败")
|
||||
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
|
||||
[Error] = ex
|
||||
ModrinthFailed = True
|
||||
End Try
|
||||
End Sub, "Modrinth Project Request")
|
||||
End If
|
||||
|
||||
'等待线程结束
|
||||
@@ -1470,7 +1476,7 @@ Retry:
|
||||
End If
|
||||
'更新前置 Mod 信息
|
||||
If Deps.Any Then
|
||||
For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
|
||||
For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
|
||||
For Each File In CompFilesCache(ProjectId)
|
||||
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
|
||||
File.Dependencies.Add(DepProject.Id)
|
||||
@@ -1490,10 +1496,11 @@ Retry:
|
||||
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
|
||||
Deps.Sort()
|
||||
If Not Deps.Any() Then Exit Sub
|
||||
Deps = Deps.Where(Function(dep)
|
||||
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
|
||||
Return CompProjectCache.ContainsKey(dep)
|
||||
End Function).ToList
|
||||
Deps = Deps.Where(
|
||||
Function(dep)
|
||||
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
|
||||
Return CompProjectCache.ContainsKey(dep)
|
||||
End Function).ToList
|
||||
'添加开头间隔
|
||||
Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
|
||||
'添加前置 Mod 列表
|
||||
|
||||
@@ -21,12 +21,7 @@
|
||||
End If
|
||||
'检查文件
|
||||
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
|
||||
If ReturnNothingOnFileUseable Then
|
||||
'是否跳过
|
||||
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
|
||||
If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
|
||||
If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
|
||||
End If
|
||||
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
|
||||
'返回下载信息
|
||||
Dim JarUrl As String = Version.JsonObject("downloads")("client")("url")
|
||||
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
|
||||
@@ -56,7 +51,7 @@
|
||||
''' <summary>
|
||||
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
|
||||
''' </summary>
|
||||
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase)
|
||||
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
|
||||
#Region "下载支持库文件"
|
||||
@@ -69,9 +64,9 @@
|
||||
#End Region
|
||||
|
||||
#Region "下载资源文件"
|
||||
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
|
||||
If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
|
||||
If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
|
||||
If ShouldIgnoreFileCheck(Version) Then
|
||||
Log("[Download] 已跳过所有 Assets 检查")
|
||||
Else
|
||||
Dim LoadersAssets As New List(Of LoaderBase)
|
||||
'获取资源文件索引地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
|
||||
@@ -121,7 +116,7 @@
|
||||
'获取资源文件地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
|
||||
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
|
||||
End Sub) With {.ProgressWeight = 3})
|
||||
'下载资源文件
|
||||
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
|
||||
@@ -1087,29 +1082,46 @@
|
||||
|
||||
''' <summary>
|
||||
''' 对可能涉及 Mod 镜像源的请求进行处理，返回字符串或 JObject。
|
||||
''' 调用 NetGetCodeByRequestOnce。
|
||||
''' 调用 NetGetCodeByRequest。
|
||||
''' </summary>
|
||||
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
|
||||
Dim McimUrl As String = DlSourceModGet(Url)
|
||||
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
|
||||
If McimUrl <> Url Then
|
||||
Select Case Setup.Get("ToolDownloadMod")
|
||||
'UNDONE: 受 #4811 影响
|
||||
Case 0
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
If ModeDebug Then
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Else
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
End If
|
||||
Case 1
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
|
||||
Case Else
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
Case Else
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
End Select
|
||||
End If
|
||||
Dim Exs As String = ""
|
||||
For Each Source In Urls
|
||||
Try
|
||||
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000,
|
||||
IsJson:=IsJson, UseBrowserUserAgent:=True)
|
||||
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, IsJson:=IsJson, UseBrowserUserAgent:=True)
|
||||
Catch ex As Exception
|
||||
Exs += ex.Message + vbCrLf
|
||||
End Try
|
||||
@@ -1119,28 +1131,46 @@
|
||||
|
||||
''' <summary>
|
||||
''' 对可能涉及 Mod 镜像源的请求进行处理。
|
||||
''' 调用 NetRequestOnce。
|
||||
''' 调用 NetRequest。
|
||||
''' </summary>
|
||||
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
|
||||
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
|
||||
Dim McimUrl As String = DlSourceModGet(Url)
|
||||
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
|
||||
If McimUrl <> Url Then
|
||||
Select Case Setup.Get("ToolDownloadMod")
|
||||
'UNDONE: 受 #4811 影响
|
||||
Case 0
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
If ModeDebug Then
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Else
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
End If
|
||||
Case 1
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
|
||||
Case Else
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
Case Else
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
|
||||
End Select
|
||||
End If
|
||||
Dim Exs As String = ""
|
||||
For Each Source In Urls
|
||||
Try
|
||||
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000, Headers:=Headers)
|
||||
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000)
|
||||
Catch ex As Exception
|
||||
Exs += ex.Message + vbCrLf
|
||||
End Try
|
||||
|
||||
@@ -4,6 +4,7 @@ Public Module ModLaunch
|
||||
|
||||
#Region "开始"
|
||||
|
||||
Public CurrentLaunchOptions As McLaunchOptions = Nothing
|
||||
Public Class McLaunchOptions
|
||||
''' <summary>
|
||||
''' 强制指定在启动后进入的服务器 IP。
|
||||
@@ -20,32 +21,34 @@ Public Module ModLaunch
|
||||
''' 默认值：Nothing。使用 McVersionCurrent。
|
||||
''' </summary>
|
||||
Public Version As McVersion = Nothing
|
||||
''' <summary>
|
||||
''' 额外的启动参数。
|
||||
''' </summary>
|
||||
Public ExtraArgs As New List(Of String)
|
||||
End Class
|
||||
''' <summary>
|
||||
''' 尝试启动 Minecraft。必须在 UI 线程调用。
|
||||
''' 返回是否实际开始了启动（如果没有，则一定弹出了错误提示）。
|
||||
''' </summary>
|
||||
Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
|
||||
Options = If(Options, New McLaunchOptions)
|
||||
CurrentLaunchOptions = If(Options, New McLaunchOptions)
|
||||
'预检查
|
||||
If Not RunInUi() Then
|
||||
Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
|
||||
End If
|
||||
If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
|
||||
If McLaunchLoader.State = LoadState.Loading Then
|
||||
Hint("已有游戏正在启动中！", HintType.Critical)
|
||||
Return False
|
||||
End If
|
||||
'强制切换需要启动的版本
|
||||
If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then
|
||||
McLaunchLog("在启动前切换到版本 " & Options.Version.Name)
|
||||
If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
|
||||
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
|
||||
'检查版本
|
||||
Options.Version.Load()
|
||||
If Options.Version.State = McVersionState.Error Then
|
||||
Hint("无法启动 Minecraft：" & Options.Version.Info, HintType.Critical)
|
||||
CurrentLaunchOptions.Version.Load()
|
||||
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
|
||||
Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Critical)
|
||||
Return False
|
||||
End If
|
||||
'切换版本
|
||||
McVersionCurrent = Options.Version
|
||||
McVersionCurrent = CurrentLaunchOptions.Version
|
||||
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
|
||||
FrmLaunchLeft.RefreshButtonsUI()
|
||||
FrmLaunchLeft.RefreshPage(False, False)
|
||||
@@ -95,7 +98,7 @@ Public Module ModLaunch
|
||||
McLaunchPrecheck()
|
||||
McLaunchLog("预检测已通过")
|
||||
Catch ex As Exception
|
||||
Hint(ex.Message, HintType.Critical)
|
||||
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
|
||||
Throw
|
||||
End Try
|
||||
'正式加载
|
||||
@@ -104,7 +107,7 @@ Public Module ModLaunch
|
||||
Dim Loaders As New List(Of LoaderBase) From {
|
||||
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
|
||||
McLoginLoader,
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False},
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
|
||||
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
|
||||
@@ -144,7 +147,7 @@ Public Module ModLaunch
|
||||
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish)
|
||||
Case LoadState.Aborted
|
||||
If AbortHint Is Nothing Then
|
||||
Hint(If(Loader.Input.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info)
|
||||
Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info)
|
||||
Else
|
||||
Hint(AbortHint, HintType.Finish)
|
||||
End If
|
||||
@@ -159,7 +162,7 @@ NextInner:
|
||||
If CurrentEx.Message.StartsWithF("$") Then
|
||||
'若有以 $ 开头的错误信息，则以此为准显示提示
|
||||
'若错误信息为 $$，则不提示
|
||||
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
Throw
|
||||
ElseIf CurrentEx.InnerException IsNot Nothing Then
|
||||
'检查下一级错误
|
||||
@@ -168,7 +171,9 @@ NextInner:
|
||||
Else
|
||||
'没有特殊处理过的错误信息
|
||||
McLaunchLog("错误：" & GetExceptionDetail(ex))
|
||||
Log(ex, If(Loader.Input.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
Log(ex,
|
||||
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox,
|
||||
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
@@ -211,36 +216,45 @@ NextInner:
|
||||
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info)
|
||||
'检查输入信息
|
||||
Dim CheckResult As String = ""
|
||||
RunInUiWait(Sub()
|
||||
Dim LoginInput As McLoginData = McLoginInput()
|
||||
CheckResult = McLoginAble(LoginInput)
|
||||
End Sub)
|
||||
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
|
||||
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
|
||||
#If BETA Then
|
||||
'求赞助
|
||||
RunInNewThread(Sub()
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1700, 1900, 2100, 2300, 2500
|
||||
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf &
|
||||
"如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
|
||||
"毕竟一个人开发也不容易（悲）……",
|
||||
"求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then
|
||||
OpenWebsite("https://afdian.com/a/LTCat")
|
||||
End If
|
||||
End Select
|
||||
End Sub, "Donate")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
|
||||
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf &
|
||||
"如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
|
||||
"毕竟一个人开发也不容易（悲）……",
|
||||
"求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then
|
||||
OpenWebsite("https://afdian.com/a/LTCat")
|
||||
End If
|
||||
End Select
|
||||
End Sub, "Donate")
|
||||
#End If
|
||||
'正版购买提示
|
||||
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 10, 35, 75, 125, 175, 225, 275, 325, 375, 425, 475, 550, 650, 750, 850, 950, 1050, 1150, 1250, 1350, 1450, 1600, 1800, 2000, 2200, 2400
|
||||
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦！" & vbCrLf &
|
||||
"如果觉得 Minecraft 还不错，也可以考虑购买正版支持一下，毕竟开发游戏也很不容易……" & vbCrLf &
|
||||
"在你登录一次正版账号后，就不会再出现这个提示了。",
|
||||
"考虑一下正版？", "购买正版游戏", "下次一定") = 1 Then
|
||||
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
|
||||
End If
|
||||
End Select
|
||||
If IsSystemLanguageChinese() Then
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 2, 5, 10, 15, 20, 40, 60, 80, 100, 125, 150, 175, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
|
||||
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦！" & vbCrLf &
|
||||
"如果觉得 Minecraft 还不错，可以购买正版支持一下，毕竟开发游戏也真的很不容易……" & vbCrLf & vbCrLf &
|
||||
"在你登录一次正版账号后，就不会再出现这个提示了！",
|
||||
"考虑一下正版？", "支持正版游戏！", "下次一定") = 1 Then
|
||||
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
|
||||
End If
|
||||
End Select
|
||||
ElseIf Setup.Get("LoginType") = McLoginType.Legacy Then
|
||||
Select Case MyMsgBox("你必须先登录正版账号，才能进行离线登录！", "正版验证", "购买正版", "试玩", "返回",
|
||||
Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
|
||||
Case 2
|
||||
Hint("游戏将以试玩模式启动！", HintType.Critical)
|
||||
CurrentLaunchOptions.ExtraArgs.Add("--demo")
|
||||
Case 3
|
||||
Throw New Exception("$$")
|
||||
End Select
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -487,58 +501,56 @@ NextInner:
|
||||
#Region "分方式登录模块"
|
||||
|
||||
'各个登录方式的主对象与输入构造
|
||||
Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000}
|
||||
Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart)
|
||||
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
|
||||
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
|
||||
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
|
||||
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
|
||||
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
|
||||
|
||||
'主加载函数，返回所有需要的登录信息
|
||||
Private McLoginMsRefreshTime As Long = 0 '上次刷新登录的时间
|
||||
Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
|
||||
Dim Input As McLoginMs = Data.Input
|
||||
Dim LogUsername As String = Input.UserName
|
||||
McLaunchLog("登录方式：正版（" & If(LogUsername = "", "尚未登录", LogUsername) & "）")
|
||||
Data.Progress = 0.05
|
||||
'检查是否已经登录完成
|
||||
If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then
|
||||
If Not Data.IsForceRestarting AndAlso '不要求强行重启
|
||||
Input.AccessToken <> "" AndAlso '已经登录过了
|
||||
(McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内
|
||||
Data.Output = New McLoginResult With
|
||||
{.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
|
||||
GoTo SkipLogin
|
||||
End If
|
||||
'尝试登录
|
||||
Dim OAuthTokens As String()
|
||||
Dim ClientId As String = ""
|
||||
If Input.OAuthRefreshToken = "" Then
|
||||
'无 RefreshToken
|
||||
Relogin:
|
||||
Dim OAuthCode As String = MsLoginStep1(Data)
|
||||
If OAuthCode = "Cancel" Then Exit Sub
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Data.Progress = 0.2
|
||||
OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId)
|
||||
OAuthTokens = MsLoginStep1New(Data)
|
||||
Else
|
||||
'有 RefreshToken
|
||||
OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True, ClientId)
|
||||
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken) '要求重新打开登录网页认证
|
||||
If OAuthTokens(0) = "Relogin" Then GoTo Relogin
|
||||
End If
|
||||
'要求重新打开登录网页认证
|
||||
If OAuthTokens(0) = "Cancel" Then Exit Sub
|
||||
If OAuthTokens(0) = "Relogin" Then GoTo Relogin
|
||||
Data.Progress = 0.35
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Data.Progress = 0.25
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim OAuthAccessToken As String = OAuthTokens(0)
|
||||
Dim OAuthRefreshToken As String = OAuthTokens(1)
|
||||
Dim XBLToken As String = MsLoginStep3(OAuthAccessToken)
|
||||
Data.Progress = 0.5
|
||||
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
|
||||
Data.Progress = 0.4
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim Tokens = MsLoginStep4(XBLToken)
|
||||
Data.Progress = 0.65
|
||||
Dim Tokens = MsLoginStep3(XBLToken)
|
||||
Data.Progress = 0.55
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim AccessToken As String = MsLoginStep5(Tokens)
|
||||
Data.Progress = 0.8
|
||||
Dim AccessToken As String = MsLoginStep4(Tokens)
|
||||
Data.Progress = 0.7
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
MsLoginStep6(AccessToken)
|
||||
Data.Progress = 0.9
|
||||
MsLoginStep5(AccessToken)
|
||||
Data.Progress = 0.85
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim Result = MsLoginStep7(AccessToken)
|
||||
Dim Result = MsLoginStep6(AccessToken)
|
||||
Data.Progress = 0.98
|
||||
'输出登录结果
|
||||
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
|
||||
Setup.Set("CacheMsAccess", AccessToken)
|
||||
@@ -550,11 +562,11 @@ Relogin:
|
||||
MsJson(Result(1)) = OAuthRefreshToken
|
||||
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
|
||||
Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)}
|
||||
'解锁主题
|
||||
SkipLogin:
|
||||
'结束
|
||||
McLoginMsRefreshTime = GetTimeTick()
|
||||
McLaunchLog("微软登录完成")
|
||||
SkipLogin:
|
||||
Setup.Set("HintBuy", True) '关闭正版购买提示
|
||||
Data.Progress = 0.98
|
||||
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示")
|
||||
End Sub
|
||||
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
|
||||
@@ -821,179 +833,61 @@ LoginFinish:
|
||||
End Try
|
||||
End Function
|
||||
|
||||
'微软登录步骤 1：打开网页认证，获取 OAuth Code
|
||||
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
|
||||
McLaunchLog("开始微软登录步骤 1")
|
||||
OpenWebsite(FormLoginOAuth.LoginUrl1)
|
||||
Dim Result As String =
|
||||
MyMsgBoxInput("等待网页登录",
|
||||
"登录完成后，网页会变得完全空白。把那个空白网页的网址复制到下面的框中就行！" & vbCrLf &
|
||||
"如果网络环境不佳，它可能一直加载不出来，那就只能试试用 VPN 或加速器了。",
|
||||
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
|
||||
HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
|
||||
If Result Is Nothing Then
|
||||
McLaunchLog("微软登录已在步骤 1 被取消")
|
||||
Throw New ThreadInterruptedException("$$")
|
||||
Else
|
||||
Return RegexSeek(Result, "(?<=code\=)[^&]+")
|
||||
End If
|
||||
End Function
|
||||
'微软登录步骤 1，原始登录：获取 DeviceCode 并开启登录网页
|
||||
Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String()
|
||||
'参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
|
||||
|
||||
'微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
|
||||
Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, ClientId As String, Optional ExpiresIn As String = "900") As String()
|
||||
McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）")
|
||||
'初始请求
|
||||
McLaunchLog("开始微软登录步骤 1/6（原始登录）")
|
||||
Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
|
||||
$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
|
||||
McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
|
||||
|
||||
Dim Request As String
|
||||
If IsRefresh Then
|
||||
Request = "grant_type=refresh_token" & "&" &
|
||||
"client_id=" & ClientId & "&" &
|
||||
"device_code=" & Code & "&" &
|
||||
"refresh_token=" & Uri.EscapeDataString(Code) & "&" &
|
||||
"scope=XboxLive.signin%20offline_access"
|
||||
Else
|
||||
Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
|
||||
"client_id=" & ClientId & "&" &
|
||||
"device_code=" & Code & "&" &
|
||||
"scope=XboxLive.signin%20offline_access"
|
||||
End If
|
||||
Dim Result As String
|
||||
Dim stopwatch As Stopwatch = Stopwatch.StartNew()
|
||||
|
||||
While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
|
||||
Try
|
||||
Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
|
||||
Catch ex As Exception
|
||||
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
|
||||
Return {"Relogin", ""}
|
||||
ElseIf ex.Message.Contains("authorization_declined") Then
|
||||
Hint("你拒绝了 PCL2 的访问权限申请，验证过程被中断！")
|
||||
Return {"Cancel", ""}
|
||||
ElseIf ex.Message.Contains("expired_token") Then
|
||||
Hint("Token 已过期，请尝试重新验证！")
|
||||
Exit While
|
||||
ElseIf ex.Message.Contains("AADSTS70016") Then
|
||||
Continue While
|
||||
Else
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
|
||||
If Result IsNot Nothing Then
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim AccessToken As String = ResultJson("access_token").ToString
|
||||
Dim RefreshToken As String = ResultJson("refresh_token").ToString
|
||||
Return {AccessToken, RefreshToken}
|
||||
End If
|
||||
|
||||
Thread.Sleep(1000)
|
||||
'弹窗
|
||||
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
While Converter.Result Is Nothing
|
||||
Thread.Sleep(100)
|
||||
End While
|
||||
|
||||
Hint("验证超时，请尝试重新验证！")
|
||||
Return {"Cancel", ""}
|
||||
|
||||
If TypeOf Converter.Result Is Exception Then
|
||||
Throw CType(Converter.Result, Exception)
|
||||
Else
|
||||
Return Converter.Result
|
||||
End If
|
||||
End Function
|
||||
|
||||
''微软登录步骤 1：获取 DeviceCode 并显示验证提示
|
||||
''https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
|
||||
'Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
|
||||
' McLaunchLog("开始微软登录步骤 1：获取验证信息")
|
||||
' Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
|
||||
' $"client_id={OAuthClientId}&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
|
||||
'微软登录步骤 1，刷新登录：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
|
||||
Private Function MsLoginStep1Refresh(Code As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 1/6（刷新登录）")
|
||||
|
||||
' '从这里开始直到步骤 2 结束都没有 Review
|
||||
' '参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
|
||||
' If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码（会自动复制到剪贴板）。" & vbCrLf &
|
||||
' "设备代码有时效性，若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") <> 1 Then
|
||||
' Return "Cancel"
|
||||
' End If
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST",
|
||||
$"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
|
||||
"application/x-www-form-urlencoded", 2)
|
||||
Catch ex As Exception
|
||||
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
|
||||
Return {"Relogin", ""}
|
||||
Else
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
|
||||
' Dim DeviceCode As String = PrepareJson("device_code")
|
||||
' Dim UserCode As String = PrepareJson("user_code")
|
||||
' Dim VerifyUri As String = PrepareJson("verification_uri")
|
||||
' 'ResultJson("expires_in")
|
||||
' ClipboardSet(UserCode)
|
||||
' OpenWebsite(VerifyUri)
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim AccessToken As String = ResultJson("access_token").ToString
|
||||
Dim RefreshToken As String = ResultJson("refresh_token").ToString
|
||||
Return {AccessToken, RefreshToken}
|
||||
End Function
|
||||
|
||||
' Dim MsgBoxValue As String = ""
|
||||
' While MsgBoxValue IsNot "1"
|
||||
' MsgBoxValue = MyMsgBox("本次验证的设备代码为：" & UserCode & vbCrLf & vbCrLf & "你也可以在任意设备上打开下列网址进行验证：" & vbCrLf & VerifyUri & vbCrLf & vbCrLf & "在验证完成后，你可以直接关闭这个弹窗，PCL2 会自动完成接下来的流程。", "正版验证", "关闭", "复制网址", "复制设备代码").ToString
|
||||
' If MsgBoxValue = "2" Then
|
||||
' ClipboardSet(VerifyUri)
|
||||
' Continue While
|
||||
' ElseIf MsgBoxValue = "3" Then
|
||||
' ClipboardSet(UserCode)
|
||||
' Continue While
|
||||
' ElseIf MsgBoxValue = "1" Then
|
||||
' Exit While
|
||||
' End If
|
||||
' End While
|
||||
|
||||
' Return DeviceCode
|
||||
'End Function
|
||||
|
||||
''微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
|
||||
'Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, Optional ExpiresIn As String = "900") As String()
|
||||
' McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）")
|
||||
|
||||
' Dim Request As String
|
||||
' If IsRefresh Then
|
||||
' Request = "grant_type=refresh_token" & "&" &
|
||||
' "client_id=" & OAuthClientId & "&" &
|
||||
' "device_code=" & Code & "&" &
|
||||
' "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
|
||||
' "scope=XboxLive.signin%20offline_access"
|
||||
' Else
|
||||
' Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
|
||||
' "client_id=" & OAuthClientId & "&" &
|
||||
' "device_code=" & Code & "&" &
|
||||
' "scope=XboxLive.signin%20offline_access"
|
||||
' End If
|
||||
' Dim Result As String
|
||||
' Dim stopwatch As Stopwatch = Stopwatch.StartNew()
|
||||
|
||||
' While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
|
||||
' Try
|
||||
' Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
|
||||
' Catch ex As Exception
|
||||
' If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
|
||||
' Return {"Relogin", ""}
|
||||
' ElseIf ex.Message.Contains("authorization_declined") Then
|
||||
' Hint("你拒绝了 PCL2 的访问权限申请，验证过程被中断！")
|
||||
' Return {"Cancel", ""}
|
||||
' ElseIf ex.Message.Contains("expired_token") Then
|
||||
' Hint("Token 已过期，请尝试重新验证！")
|
||||
' Exit While
|
||||
' ElseIf ex.Message.Contains("AADSTS70016") Then
|
||||
' Continue While
|
||||
' Else
|
||||
' Throw
|
||||
' End If
|
||||
' End Try
|
||||
|
||||
' If Result IsNot Nothing Then
|
||||
' Dim ResultJson As JObject = GetJson(Result)
|
||||
' Dim AccessToken As String = ResultJson("access_token").ToString
|
||||
' Dim RefreshToken As String = ResultJson("refresh_token").ToString
|
||||
' Return {AccessToken, RefreshToken}
|
||||
' End If
|
||||
|
||||
' Thread.Sleep(1000)
|
||||
' End While
|
||||
|
||||
' Hint("验证超时，请尝试重新验证！")
|
||||
' Return {"Cancel", ""}
|
||||
|
||||
'End Function
|
||||
|
||||
'微软登录步骤 3：从 OAuth AccessToken 获取 XBLToken
|
||||
Private Function MsLoginStep3(AccessToken As String) As String
|
||||
McLaunchLog("开始微软登录步骤 3")
|
||||
'微软登录步骤 2：从 OAuth AccessToken 获取 XBLToken
|
||||
Private Function MsLoginStep2(AccessToken As String) As String
|
||||
McLaunchLog("开始微软登录步骤 2/6")
|
||||
|
||||
Dim Request As String = "{
|
||||
""Properties"": {
|
||||
""AuthMethod"": ""RPS"",
|
||||
""SiteName"": ""user.auth.xboxlive.com"",
|
||||
""RpsTicket"": """ & AccessToken & """
|
||||
""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """
|
||||
},
|
||||
""RelyingParty"": ""http://auth.xboxlive.com"",
|
||||
""TokenType"": ""JWT""
|
||||
@@ -1004,9 +898,9 @@ LoginFinish:
|
||||
Dim XBLToken As String = ResultJson("Token").ToString
|
||||
Return XBLToken
|
||||
End Function
|
||||
'微软登录步骤 4：从 XBLToken 获取 {XSTSToken, UHS}
|
||||
Private Function MsLoginStep4(XBLToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 4")
|
||||
'微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
|
||||
Private Function MsLoginStep3(XBLToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 3/6")
|
||||
|
||||
Dim Request As String = "{
|
||||
""Properties"": {
|
||||
@@ -1056,9 +950,9 @@ LoginFinish:
|
||||
Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
|
||||
Return {XSTSToken, UHS}
|
||||
End Function
|
||||
'微软登录步骤 5：从 {XSTSToken, UHS} 获取 Minecraft AccessToken
|
||||
Private Function MsLoginStep5(Tokens As String()) As String
|
||||
McLaunchLog("开始微软登录步骤 5")
|
||||
'微软登录步骤 4：从 {XSTSToken, UHS} 获取 Minecraft AccessToken
|
||||
Private Function MsLoginStep4(Tokens As String()) As String
|
||||
McLaunchLog("开始微软登录步骤 4/6")
|
||||
|
||||
Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0)
|
||||
Dim Result As String
|
||||
@@ -1081,9 +975,9 @@ LoginFinish:
|
||||
Dim AccessToken As String = ResultJson("access_token").ToString
|
||||
Return AccessToken
|
||||
End Function
|
||||
'微软登录步骤 6：验证微软账号是否持有 MC，这也会刷新 XGP
|
||||
Private Sub MsLoginStep6(AccessToken As String)
|
||||
McLaunchLog("开始微软登录步骤 6")
|
||||
'微软登录步骤 5：验证微软账号是否持有 MC，这也会刷新 XGP
|
||||
Private Sub MsLoginStep5(AccessToken As String)
|
||||
McLaunchLog("开始微软登录步骤 5/6")
|
||||
|
||||
Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
|
||||
Try
|
||||
@@ -1100,9 +994,9 @@ LoginFinish:
|
||||
Throw
|
||||
End Try
|
||||
End Sub
|
||||
'微软登录步骤 7：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
|
||||
Private Function MsLoginStep7(AccessToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 7")
|
||||
'微软登录步骤 6：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
|
||||
Private Function MsLoginStep6(AccessToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 6/6")
|
||||
|
||||
Dim Result As String
|
||||
Try
|
||||
@@ -1447,8 +1341,12 @@ LoginFinish:
|
||||
Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""")
|
||||
'全屏
|
||||
If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
|
||||
'由 Option 传入的额外参数
|
||||
For Each Arg In CurrentLaunchOptions.ExtraArgs
|
||||
Arguments += " " & Arg.Trim
|
||||
Next
|
||||
'进服
|
||||
Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp)
|
||||
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
|
||||
If Server.Length > 0 Then
|
||||
If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then
|
||||
'QuickPlay
|
||||
@@ -2148,18 +2046,18 @@ IgnoreCustomSkin:
|
||||
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
|
||||
"echo 游戏已退出。" & vbCrLf &
|
||||
"pause"
|
||||
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
|
||||
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
|
||||
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
|
||||
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
|
||||
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
|
||||
McLaunchLog("导出启动脚本完成，强制结束启动过程")
|
||||
AbortHint = "导出启动脚本成功！"
|
||||
OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """")
|
||||
OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """")
|
||||
Loader.Parent.Abort()
|
||||
Exit Sub '导出脚本完成
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "输出启动脚本失败")
|
||||
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
|
||||
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
|
||||
End Try
|
||||
|
||||
'执行自定义命令
|
||||
|
||||
@@ -475,22 +475,27 @@ VersionSearchFinish:
|
||||
''' </summary>
|
||||
Public Property JsonText As String
|
||||
Get
|
||||
'快速检查 JSON 是否以 { 开头、} 结尾；忽略空白字符
|
||||
Dim FastJsonCheck =
|
||||
Function(Json As String) As Boolean
|
||||
Dim TrimedJson As String = Json.Trim()
|
||||
Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}")
|
||||
End Function
|
||||
If _JsonText Is Nothing Then
|
||||
If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件：" & Path & Name & ".json")
|
||||
If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件：{Path}{Name}.json")
|
||||
_JsonText = ReadFile(Path & Name & ".json")
|
||||
'如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试
|
||||
If _JsonText.Length = 0 Then
|
||||
If Not FastJsonCheck(_JsonText) Then
|
||||
If RunInUi() Then
|
||||
Log("[Minecraft] 版本 json 文件为空或读取失败，由于代码在主线程运行，将不再进行重试", LogLevel.Debug)
|
||||
Throw New Exception("版本 Json 文件为空或读取失败")
|
||||
Log("[Minecraft] 版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试", LogLevel.Debug)
|
||||
GetJson(_JsonText) '触发异常
|
||||
Else
|
||||
Log("[Minecraft] 版本 json 文件为空或读取失败，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug)
|
||||
Log("[Minecraft] 版本 JSON 文件为空或有误，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug)
|
||||
Thread.Sleep(2000)
|
||||
_JsonText = ReadFile(Path & Name & ".json")
|
||||
If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败")
|
||||
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
|
||||
End If
|
||||
End If
|
||||
If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误，内容为：" & _JsonText)
|
||||
End If
|
||||
Return _JsonText
|
||||
End Get
|
||||
@@ -562,11 +567,10 @@ Recheck:
|
||||
GoTo Recheck
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "合并版本依赖项 json 失败（" & If(InheritVersion, "null").ToString & "）")
|
||||
Log(ex, "合并版本依赖项 JSON 失败（" & If(InheritVersion, "null").ToString & "）")
|
||||
End Try
|
||||
Catch ex As Exception
|
||||
Log($"[Minecraft] 传入的版本 json 文件内容（共 {Text.Length} 字符，最多输出前 5000 字符）：{vbCrLf}{Text.Substring(0, 5000)}")
|
||||
Throw New Exception("版本 json 不规范（" & If(Name, "null") & "）", ex)
|
||||
Throw New Exception("初始化版本 JSON 时失败（" & If(Name, "null") & "）", ex)
|
||||
End Try
|
||||
Try
|
||||
'处理 JumpLoader
|
||||
@@ -1030,21 +1034,21 @@ ExitDataLoad:
|
||||
Public Function GetMcFoolName(Name As String) As String
|
||||
Name = Name.ToLower
|
||||
If Name.StartsWithF("2.0") Then
|
||||
Return "这个秘密计划了两年的更新将游戏推向了一个新高度！"
|
||||
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
|
||||
Return "我们加入了 20 亿个新的维度，让无限的想象变成了现实！"
|
||||
Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度！"
|
||||
ElseIf Name = "15w14a" Then
|
||||
Return "作为一款全年龄向的游戏，我们需要和平，需要爱与拥抱。"
|
||||
Return "2015 | 作为一款全年龄向的游戏，我们需要和平，需要爱与拥抱。"
|
||||
ElseIf Name = "1.rv-pre1" Then
|
||||
Return "是时候将现代科技带入 Minecraft 了！"
|
||||
Return "2016 | 是时候将现代科技带入 Minecraft 了！"
|
||||
ElseIf Name = "3d shareware v1.34" Then
|
||||
Return "我们从地下室的废墟里找到了这个开发于 1994 年的杰作！"
|
||||
Return "2019 | 我们从地下室的废墟里找到了这个开发于 1994 年的杰作！"
|
||||
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
|
||||
Return "2020 | 我们加入了 20 亿个新的维度，让无限的想象变成了现实！"
|
||||
ElseIf Name = "22w13oneblockatatime" Then
|
||||
Return "一次一个方块更新！迎接全新的挖掘、合成与骑乘玩法吧！"
|
||||
Return "2022 | 一次一个方块更新！迎接全新的挖掘、合成与骑乘玩法吧！"
|
||||
ElseIf Name = "23w13a_or_b" Then
|
||||
Return "研究表明：玩家喜欢作出选择——越多越好！"
|
||||
Return "2023 | 研究表明：玩家喜欢作出选择——越多越好！"
|
||||
ElseIf Name = "24w14potato" Then
|
||||
Return "毒马铃薯一直都被大家忽视和低估，于是我们超级加强了它！"
|
||||
Return "2024 | 毒马铃薯一直都被大家忽视和低估，于是我们超级加强了它！"
|
||||
Else
|
||||
Return ""
|
||||
End If
|
||||
@@ -1946,17 +1950,13 @@ OnLoaded:
|
||||
End Try
|
||||
If CoreJarOnly Then Return Result
|
||||
|
||||
'是否跳过校验
|
||||
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
|
||||
|
||||
'Library 文件
|
||||
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\", AllowUnsameFile:=IsSetupSkip))
|
||||
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\"))
|
||||
|
||||
'统一通行证文件
|
||||
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
|
||||
Dim TargetFile = PathAppdata & "nide8auth.jar"
|
||||
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取统一通行证下载信息")
|
||||
@@ -1966,14 +1966,13 @@ OnLoaded:
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取统一通行证下载信息失败")
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
|
||||
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Log("[Minecraft] 统一通行证需要更新：Hash - " & Checker.Hash, LogLevel.Developer)
|
||||
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
|
||||
End If
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
|
||||
If Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Log("[Minecraft] 统一通行证需要更新：Hash - " & Checker.Hash, LogLevel.Developer)
|
||||
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
@@ -1982,45 +1981,59 @@ OnLoaded:
|
||||
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
|
||||
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
|
||||
Dim TargetFile = PathAppdata & "authlib-injector.jar"
|
||||
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
|
||||
DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
|
||||
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Dim DownloadAddress As String = DownloadInfo("download_url")
|
||||
Log("[Minecraft] Authlib-Injector 需要更新：" & DownloadAddress, LogLevel.Developer)
|
||||
Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
|
||||
End If
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
|
||||
DownloadInfo = GetJson(NetGetCodeByDownload({
|
||||
"https://authlib-injector.yushi.moe/artifact/latest.json",
|
||||
"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
|
||||
}, IsJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
|
||||
If Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
|
||||
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
|
||||
Log("[Minecraft] Authlib-Injector 需要更新：" & DownloadAddress, LogLevel.Developer)
|
||||
Result.Add(New NetFile({
|
||||
DownloadAddress,
|
||||
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
|
||||
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
'跳过校验
|
||||
If ShouldIgnoreFileCheck(Version) Then
|
||||
Log("[Minecraft] 用户要求尽量忽略文件检查，这可能会保留有误的文件")
|
||||
Result = Result.Where(
|
||||
Function(f)
|
||||
If File.Exists(f.LocalPath) Then
|
||||
Log("[Minecraft] 跳过下载的支持库文件：" & f.LocalPath, LogLevel.Debug)
|
||||
Return False
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
End Function).ToList
|
||||
End If
|
||||
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。
|
||||
''' </summary>
|
||||
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing, Optional AllowUnsameFile As Boolean = False) As List(Of NetFile)
|
||||
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of NetFile)
|
||||
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
|
||||
Dim Result As New List(Of NetFile)
|
||||
'获取
|
||||
For Each Token As McLibToken In Libs
|
||||
'检查文件
|
||||
Dim Checker As FileChecker
|
||||
If AllowUnsameFile Then '只要文件存在则通过检查，用于放宽完整性校验的情况
|
||||
Checker = New FileChecker(MinSize:=1)
|
||||
Else
|
||||
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
|
||||
End If
|
||||
Dim Checker As New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
|
||||
If Checker.Check(Token.LocalPath) Is Nothing Then Continue For
|
||||
'文件不符合，添加下载
|
||||
Dim Urls As New List(Of String)
|
||||
@@ -2159,77 +2172,50 @@ OnLoaded:
|
||||
''' </summary>
|
||||
Public Size As Long
|
||||
''' <summary>
|
||||
''' 是否为 Virtual 资源文件。
|
||||
''' </summary>
|
||||
Public IsVirtual As Boolean
|
||||
''' <summary>
|
||||
''' 文件的 Hash 校验码。
|
||||
''' </summary>
|
||||
Public Hash As String
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return If(IsVirtual, "[Virtual] ", "") & GetString(Size) & " | " & LocalPath
|
||||
Return GetString(Size) & " | " & LocalPath
|
||||
End Function
|
||||
End Structure
|
||||
''' <summary>
|
||||
''' 获取 Minecraft 的资源文件列表。失败会抛出异常。
|
||||
''' </summary>
|
||||
''' <param name="Name">版本的资源名称，如“1.13.1”。</param>
|
||||
Private Function McAssetsListGet(Name As String) As List(Of McAssetsToken)
|
||||
Private Function McAssetsListGet(Version As McVersion) As List(Of McAssetsToken)
|
||||
Dim IndexName = McAssetsGetIndexName(Version)
|
||||
Try
|
||||
|
||||
'初始化
|
||||
If Not File.Exists(PathMcFolder & "assets\indexes\" & Name & ".json") Then Throw New FileNotFoundException("Assets 索引文件未找到", PathMcFolder & "assets\indexes\" & Name & ".json")
|
||||
McAssetsListGet = New List(Of McAssetsToken)
|
||||
Dim Json = GetJson(ReadFile(PathMcFolder & "assets\indexes\" & Name & ".json"))
|
||||
If Not File.Exists($"{PathMcFolder}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", PathMcFolder & "assets\indexes\" & IndexName & ".json")
|
||||
Dim Result As New List(Of McAssetsToken)
|
||||
Dim Json As JObject = GetJson(ReadFile($"{PathMcFolder}assets\indexes\{IndexName}.json"))
|
||||
|
||||
'确认 Virtual 与 Map 状态
|
||||
Dim IsVirtual As Boolean = False
|
||||
If Json("virtual") IsNot Nothing AndAlso Json("virtual").ToString Then IsVirtual = True
|
||||
If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToString Then
|
||||
IsVirtual = True
|
||||
'刷新 resources 文件夹符号链接（#2182）
|
||||
'Dim Info As FileSystemInfo = New FileInfo(PathMcFolder & "resources\pack.mcmeta")
|
||||
'If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
|
||||
If Not File.Exists(PathMcFolder & "resources\pack.mcmeta") Then
|
||||
Log("[Minecraft] 尝试刷新 resources 文件夹符号链接", LogLevel.Debug)
|
||||
Try
|
||||
DeleteDirectory(PathMcFolder & "resources\", True)
|
||||
Directory.CreateDirectory(PathMcFolder & "assets\virtual\legacy\")
|
||||
Dim Result = ShellAndGetOutput("cmd", $"/C mklink /D /J ""{PathMcFolder}resources"" ""{PathMcFolder}assets\virtual\legacy""")
|
||||
Log($"[Minecraft] 符号链接创建结果：{Result}")
|
||||
If Not Result.Contains("<<===>>") Then Throw New Exception($"非预期的结果（{Result}）")
|
||||
Catch ex As Exception
|
||||
Log(ex, "创建资源文件夹链接失败，游戏可能会没有声音", LogLevel.Msgbox)
|
||||
End Try
|
||||
'读取列表
|
||||
For Each File As JProperty In Json("objects").Children
|
||||
Dim LocalPath As String
|
||||
If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToObject(Of Boolean) Then
|
||||
'Remap
|
||||
LocalPath = Version.PathIndie & "resources\" & File.Name.Replace("/", "\")
|
||||
ElseIf Json("virtual") IsNot Nothing AndAlso Json("virtual").ToObject(Of Boolean) Then
|
||||
'Virtual
|
||||
LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\")
|
||||
Else
|
||||
'正常
|
||||
LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString
|
||||
End If
|
||||
End If
|
||||
|
||||
'加载列表
|
||||
If IsVirtual Then
|
||||
For Each File As JProperty In Json("objects").Children
|
||||
McAssetsListGet.Add(New McAssetsToken With {
|
||||
.IsVirtual = True,
|
||||
.LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\"),
|
||||
.SourcePath = File.Name,
|
||||
.Hash = File.Value("hash").ToString,
|
||||
.Size = File.Value("size").ToString
|
||||
})
|
||||
Next
|
||||
Else
|
||||
For Each File As JProperty In Json("objects").Children
|
||||
McAssetsListGet.Add(New McAssetsToken With {
|
||||
.IsVirtual = False,
|
||||
.LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString,
|
||||
.SourcePath = File.Name,
|
||||
.Hash = File.Value("hash").ToString,
|
||||
.Size = File.Value("size").ToString
|
||||
})
|
||||
Next
|
||||
End If
|
||||
Result.Add(New McAssetsToken With {
|
||||
.LocalPath = LocalPath,
|
||||
.SourcePath = File.Name,
|
||||
.Hash = File.Value("hash").ToString,
|
||||
.Size = File.Value("size").ToString
|
||||
})
|
||||
Next
|
||||
Return Result
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取资源文件列表失败：" & Name)
|
||||
Log(ex, "获取资源文件列表失败：" & IndexName)
|
||||
Throw
|
||||
End Try
|
||||
End Function
|
||||
@@ -2238,12 +2224,12 @@ OnLoaded:
|
||||
''' <summary>
|
||||
''' 获取版本缺失的资源文件所对应的 NetTaskFile。
|
||||
''' </summary>
|
||||
Public Function McAssetsFixList(IndexAddress As String, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
|
||||
Public Function McAssetsFixList(Version As McVersion, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
|
||||
Dim Result As New List(Of NetFile)
|
||||
|
||||
Dim AssetsList As List(Of McAssetsToken)
|
||||
Try
|
||||
AssetsList = McAssetsListGet(IndexAddress)
|
||||
AssetsList = McAssetsListGet(Version)
|
||||
Dim Token As McAssetsToken
|
||||
If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04
|
||||
For i = 0 To AssetsList.Count - 1
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
Imports System.IO.Compression
|
||||
|
||||
Public Module ModMod
|
||||
Private Const LocalModCacheVersion As Integer = 7
|
||||
|
||||
Public Class McMod
|
||||
|
||||
@@ -47,7 +48,7 @@ Public Module ModMod
|
||||
Get
|
||||
Load()
|
||||
If Not IsFileAvailable Then
|
||||
Return McModState.Unavaliable
|
||||
Return McModState.Unavailable
|
||||
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
|
||||
Return McModState.Disabled
|
||||
Else
|
||||
@@ -58,7 +59,7 @@ Public Module ModMod
|
||||
Public Enum McModState As Integer
|
||||
Fine = 0
|
||||
Disabled = 1
|
||||
Unavaliable = 2
|
||||
Unavailable = 2
|
||||
End Enum
|
||||
|
||||
#End Region
|
||||
@@ -814,7 +815,7 @@ Finished:
|
||||
|
||||
'等待 Mod 更新完成
|
||||
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
|
||||
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
|
||||
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表：" & Loader.Input)
|
||||
Try
|
||||
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
|
||||
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
|
||||
@@ -852,7 +853,7 @@ Finished:
|
||||
Dim Cache As New JObject
|
||||
Try
|
||||
Dim CacheContent As String = ReadFile(CachePath)
|
||||
If CacheContent <> "" Then
|
||||
If Not String.IsNullOrWhiteSpace(CacheContent) Then
|
||||
Cache = GetJson(CacheContent)
|
||||
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
|
||||
Log($"[Mod] 本地 Mod 信息缓存版本已过期，将弃用这些缓存信息", LogLevel.Debug)
|
||||
@@ -861,6 +862,7 @@ Finished:
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取本地 Mod 信息缓存失败，已重置")
|
||||
Cache = New JObject
|
||||
End Try
|
||||
Cache("version") = LocalModCacheVersion
|
||||
|
||||
@@ -886,7 +888,7 @@ Finished:
|
||||
End If
|
||||
ModList.Add(ModEntry)
|
||||
'读取 Comp 缓存
|
||||
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
|
||||
If ModEntry.State = McMod.McModState.Unavailable Then Continue For
|
||||
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
|
||||
If Cache.ContainsKey(CacheKey) Then
|
||||
ModEntry.FromJson(Cache(CacheKey))
|
||||
@@ -901,8 +903,8 @@ Finished:
|
||||
'排序
|
||||
ModList = Sort(ModList,
|
||||
Function(Left As McMod, Right As McMod) As Boolean
|
||||
If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then
|
||||
Return Left.State = McMod.McModState.Unavaliable
|
||||
If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
|
||||
Return Left.State = McMod.McModState.Unavailable
|
||||
Else
|
||||
Return Not Right.FileName.CompareTo(Left.FileName)
|
||||
End If
|
||||
@@ -924,7 +926,6 @@ Finished:
|
||||
End Try
|
||||
End Sub
|
||||
'联网加载 Mod 详情
|
||||
Private Const LocalModCacheVersion As Integer = 6
|
||||
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
|
||||
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
|
||||
Dim Mods As List(Of McMod) = Loader.Input.Key
|
||||
@@ -944,7 +945,7 @@ Finished:
|
||||
'McVersions = McVersions.Distinct().ToList()
|
||||
'开始网络获取
|
||||
Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}")
|
||||
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
|
||||
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
|
||||
Dim MainThread As Thread = Thread.CurrentThread
|
||||
'从 Modrinth 获取信息
|
||||
RunInNewThread(
|
||||
@@ -979,7 +980,6 @@ Finished:
|
||||
For Each ProjectJson In ModrinthProject
|
||||
Dim Project As New CompProject(ProjectJson)
|
||||
For Each Entry In ModrinthMapping(Project.Id)
|
||||
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片，如果可能，使用 CurseForge 的 Logo
|
||||
Entry.Comp = Project
|
||||
Next
|
||||
Next
|
||||
@@ -1005,9 +1005,9 @@ Finished:
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
|
||||
SucceedThreadCount += 1
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
|
||||
IsFailed = True
|
||||
Finally
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
@@ -1023,7 +1023,7 @@ Finished:
|
||||
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
|
||||
Next
|
||||
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
|
||||
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
|
||||
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
|
||||
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
|
||||
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
|
||||
If Not CurseForgeRaw.Any() Then Exit Sub
|
||||
@@ -1046,7 +1046,7 @@ Finished:
|
||||
'步骤 3：获取工程信息
|
||||
If Not CurseForgeMapping.Any() Then Exit Sub
|
||||
Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
|
||||
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
|
||||
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
|
||||
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
|
||||
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
|
||||
For Each ProjectJson In CurseForgeProject
|
||||
@@ -1055,7 +1055,6 @@ Finished:
|
||||
Dim Project As New CompProject(ProjectJson)
|
||||
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
|
||||
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
|
||||
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
|
||||
Entry.Comp = Entry.Comp '再次触发修改事件
|
||||
Continue For
|
||||
End If
|
||||
@@ -1066,10 +1065,9 @@ Finished:
|
||||
Dim NewestVersion As String = Nothing
|
||||
Dim NewestFileIds As New List(Of Integer)
|
||||
For Each IndexEntry In ProjectJson("latestFilesIndexes")
|
||||
If IndexEntry("modLoader") Is Nothing OrElse Not IndexEntry("modLoader").HasValues OrElse '镜像源会返回一个值为 null 的键
|
||||
ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
|
||||
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
|
||||
Dim IndexVersion As String = IndexEntry("gameVersion")
|
||||
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
|
||||
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
|
||||
'由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件
|
||||
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
|
||||
If NewestVersion <> IndexVersion Then
|
||||
@@ -1114,9 +1112,9 @@ Finished:
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
|
||||
SucceedThreadCount += 1
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
|
||||
IsFailed = True
|
||||
Finally
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
@@ -1131,7 +1129,7 @@ Finished:
|
||||
Log($"[Mod] 联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存")
|
||||
If Not Mods.Any() Then Exit Sub
|
||||
For Each Entry In Mods
|
||||
Entry.CompLoaded = SucceedThreadCount = 2
|
||||
Entry.CompLoaded = Not IsFailed
|
||||
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
|
||||
Next
|
||||
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
|
||||
|
||||
@@ -88,26 +88,27 @@
|
||||
AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived
|
||||
|
||||
'初始化时钟
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
|
||||
TimerWindow()
|
||||
TimerLog()
|
||||
'设置窗口标题
|
||||
For i = 1 To 3
|
||||
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
|
||||
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
|
||||
SetWindowText(WindowHandle, RealTitle.ToCharArray)
|
||||
End If
|
||||
Thread.Sleep(64)
|
||||
Next
|
||||
Loop
|
||||
WatcherLog("Minecraft 日志监控已退出")
|
||||
Catch ex As Exception
|
||||
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
|
||||
State = MinecraftState.Ended
|
||||
End Try
|
||||
End Sub, "Minecraft Watcher PID " & PID)
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
|
||||
TimerWindow()
|
||||
TimerLog()
|
||||
'设置窗口标题
|
||||
For i = 1 To 3
|
||||
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
|
||||
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
|
||||
SetWindowText(WindowHandle, RealTitle.ToCharArray)
|
||||
End If
|
||||
Thread.Sleep(64)
|
||||
Next
|
||||
Loop
|
||||
WatcherLog("Minecraft 日志监控已退出")
|
||||
Catch ex As Exception
|
||||
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
|
||||
State = MinecraftState.Ended
|
||||
End Try
|
||||
End Sub, "Minecraft Watcher PID " & PID)
|
||||
End Sub
|
||||
|
||||
'状态
|
||||
@@ -349,22 +350,21 @@
|
||||
WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析")
|
||||
Hint("检测到 Minecraft 出现错误，错误分析已开始……")
|
||||
FeedbackInfo()
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Thread.Sleep(2000)
|
||||
WatcherLog("崩溃分析开始")
|
||||
Dim Analyzer As New CrashAnalyzer(PID)
|
||||
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
|
||||
Analyzer.Prepare()
|
||||
Analyzer.Analyze(Version)
|
||||
Analyzer.Output(False, New List(Of String) From
|
||||
{Version.Path & Version.Name & ".json",
|
||||
Path & "PCL\Log1.txt",
|
||||
Path & "PCL\LatestLaunch.bat"})
|
||||
Catch ex As Exception
|
||||
Log(ex, "崩溃分析失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub, "Crash Analyzer")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Thread.Sleep(2000)
|
||||
WatcherLog("崩溃分析开始")
|
||||
Dim Analyzer As New CrashAnalyzer(PID)
|
||||
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
|
||||
Analyzer.Prepare()
|
||||
Analyzer.Analyze(Version)
|
||||
Analyzer.Output(False, New List(Of String) From
|
||||
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
|
||||
Catch ex As Exception
|
||||
Log(ex, "崩溃分析失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub, "Crash Analyzer")
|
||||
End Sub
|
||||
|
||||
'强制关闭
|
||||
|
||||
@@ -55,12 +55,6 @@ RetryStart:
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
If Url.EndsWithF("webp") Then
|
||||
Log($"[Comp] Webp 格式转换：{LocalFileAddress}")
|
||||
Dim dec = New Imazen.WebP.SimpleDecoder()
|
||||
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
|
||||
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
|
||||
End If
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
|
||||
@@ -27,27 +27,24 @@
|
||||
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
|
||||
</Border>
|
||||
<!-- 标题 -->
|
||||
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
|
||||
SnapsToDevicePixels="False" UseLayoutRounding="False">
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
|
||||
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
|
||||
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
<!-- 更新按钮 -->
|
||||
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
|
||||
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
|
||||
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
|
||||
</StackPanel>
|
||||
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
|
||||
<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
|
||||
SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition Width="Auto" />
|
||||
<ColumnDefinition Width="1*" />
|
||||
<ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
|
||||
<ColumnDefinition Width="Auto" />
|
||||
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
|
||||
</Grid.ColumnDefinitions>
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
|
||||
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
|
||||
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
<local:MyIconTextButton Grid.Column="2" Text="更新" />
|
||||
</Grid>-->
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
|
||||
<TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
|
||||
TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
|
||||
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
<!-- 更新按钮 -->
|
||||
<local:MyIconButton Grid.Column="2"
|
||||
Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
|
||||
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
|
||||
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
|
||||
</Grid>
|
||||
<!-- Tag 与 详情 -->
|
||||
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
|
||||
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
|
||||
|
||||
@@ -14,6 +14,7 @@ Public Class MyLocalModItem
|
||||
Set(value As String)
|
||||
If _Logo = value OrElse value Is Nothing Then Exit Property
|
||||
_Logo = value
|
||||
If ModeDebug AndAlso Not _Logo = PathImage & "Icons/NoIcon.png" Then Log($"[LocalModItem] Mod {Title} 的图标：{value}")
|
||||
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
|
||||
Try
|
||||
If _Logo.StartsWithF("http", True) Then
|
||||
@@ -52,17 +53,11 @@ RetryStart:
|
||||
Try
|
||||
'CurseForge 图片使用缩略图
|
||||
Dim Url As String = _Logo
|
||||
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
|
||||
Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小
|
||||
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小
|
||||
Url = Url.Replace("/256/256/", "/64/64/")
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
If Url.EndsWithF("webp") Then
|
||||
Log($"[Comp] Webp 格式转换：{LocalFileAddress}")
|
||||
Dim dec = New Imazen.WebP.SimpleDecoder()
|
||||
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
|
||||
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
|
||||
End If
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
@@ -107,7 +102,7 @@ RetryStart:
|
||||
LabTitle.TextDecorations = Nothing
|
||||
Case McMod.McModState.Disabled
|
||||
LabTitle.TextDecorations = TextDecorations.Strikethrough
|
||||
Case McMod.McModState.Unavaliable
|
||||
Case McMod.McModState.Unavailable
|
||||
LabTitle.TextDecorations = TextDecorations.Strikethrough
|
||||
value &= " [错误]"
|
||||
End Select
|
||||
@@ -120,12 +115,12 @@ RetryStart:
|
||||
'副标题
|
||||
Public Property SubTitle As String
|
||||
Get
|
||||
Return If(LabTitleRaw?.Text, "")
|
||||
Return If(LabSubtitle?.Text, "")
|
||||
End Get
|
||||
Set(value As String)
|
||||
If LabTitleRaw.Text = value Then Exit Property
|
||||
LabTitleRaw.Text = value
|
||||
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
|
||||
If LabSubtitle.Text = value Then Exit Property
|
||||
LabSubtitle.Text = value
|
||||
LabSubtitle.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
|
||||
End Set
|
||||
End Property
|
||||
|
||||
@@ -430,7 +425,7 @@ RetryStart:
|
||||
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
|
||||
Case McMod.McModState.Disabled
|
||||
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
|
||||
Case Else 'McMod.McModState.Unavaliable
|
||||
Case Else 'McMod.McModState.Unavailable
|
||||
NewDescription = GetFileNameFromPath(Entry.Path)
|
||||
End Select
|
||||
If Entry.Comp IsNot Nothing Then
|
||||
@@ -461,7 +456,7 @@ RetryStart:
|
||||
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
|
||||
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
|
||||
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
|
||||
' Source="/Images/Icons/Unavaliable.png" />
|
||||
' Source="/Images/Icons/Unavailable.png" />
|
||||
End If
|
||||
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
|
||||
End If
|
||||
@@ -538,4 +533,17 @@ RetryStart:
|
||||
FrmVersionMod.UpdateMods({Entry})
|
||||
End Sub
|
||||
|
||||
'自适应（#4465）
|
||||
Private Sub PanTitle_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanTitle.SizeChanged
|
||||
If ColumnExtend.Width.IsStar AndAlso ColumnExtend.ActualWidth < 0.5 Then
|
||||
'压缩 Subtitle
|
||||
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
|
||||
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
|
||||
ElseIf Not ColumnExtend.Width.IsStar AndAlso ColumnSubtitle.ActualWidth > LabSubtitle.ActualWidth + 10 Then
|
||||
'向右展开 Subtitle
|
||||
ColumnSubtitle.Width = GridLength.Auto
|
||||
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
@@ -69,14 +69,14 @@ Public Module ModMain
|
||||
Dim Percent As Double = 0.3
|
||||
Select Case CurrentHint.Type
|
||||
Case HintType.Info
|
||||
TargetColor0 = New MyColor(37, 155, 252)
|
||||
TargetColor1 = New MyColor(10, 142, 252)
|
||||
TargetColor0 = New MyColor(215, 37, 155, 252)
|
||||
TargetColor1 = New MyColor(215, 10, 142, 252)
|
||||
Case HintType.Finish
|
||||
TargetColor0 = New MyColor(33, 177, 33)
|
||||
TargetColor1 = New MyColor(29, 160, 29)
|
||||
TargetColor0 = New MyColor(215, 33, 177, 33)
|
||||
TargetColor1 = New MyColor(215, 29, 160, 29)
|
||||
Case Else 'HintType.Critical
|
||||
TargetColor0 = New MyColor(255, 53, 11)
|
||||
TargetColor1 = New MyColor(255, 43, 0)
|
||||
TargetColor0 = New MyColor(215, 255, 53, 11)
|
||||
TargetColor1 = New MyColor(215, 255, 43, 0)
|
||||
End Select
|
||||
If Not IsNothing(DoubleStack) Then
|
||||
'有重复提示，且该提示的进入动画已播放
|
||||
@@ -176,15 +176,17 @@ EndHint:
|
||||
Public Title As String
|
||||
Public Text As String
|
||||
''' <summary>
|
||||
''' 输入框模式：文本框的文本；选择模式：需要放进去的 List(Of MyListItem)。
|
||||
''' 输入模式：文本框的文本。
|
||||
''' 选择模式：需要放进去的 List(Of MyListItem)。
|
||||
''' 登录模式：登录步骤 1 中返回的 JSON。
|
||||
''' </summary>
|
||||
Public Content As Object
|
||||
''' <summary>
|
||||
''' 仅输入框模式：输入验证规则。
|
||||
''' 输入模式：输入验证规则。
|
||||
''' </summary>
|
||||
Public ValidateRules As ObjectModel.Collection(Of Validate)
|
||||
''' <summary>
|
||||
''' 仅输入框模式：提示文本。
|
||||
''' 输入模式：提示文本。
|
||||
''' </summary>
|
||||
Public HintText As String = ""
|
||||
''' <summary>
|
||||
@@ -214,7 +216,9 @@ EndHint:
|
||||
''' </summary>
|
||||
Public IsExited As Boolean = False
|
||||
''' <summary>
|
||||
''' 点击的按钮编号或输入的文本。若输入弹窗点击了非第一个按钮，则为 Nothing。
|
||||
''' 输入模式：输入的文本。若点击了 非 第一个按钮，则为 Nothing。
|
||||
''' 选择模式：点击的按钮编号，从 1 开始。
|
||||
''' 登录模式：字符串数组 {AccessToken, RefreshToken} 或一个 Exception。
|
||||
''' </summary>
|
||||
Public Result As Object
|
||||
End Class
|
||||
@@ -222,6 +226,7 @@ EndHint:
|
||||
Text
|
||||
[Select]
|
||||
Input
|
||||
Login
|
||||
End Enum
|
||||
|
||||
''' <summary>
|
||||
@@ -352,6 +357,8 @@ EndHint:
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
|
||||
Case MyMsgBoxType.Text
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
|
||||
Case MyMsgBoxType.Login
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
|
||||
End Select
|
||||
WaitingMyMsgBox.RemoveAt(0)
|
||||
Else
|
||||
@@ -798,8 +805,6 @@ NextFile:
|
||||
Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
|
||||
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
|
||||
|
||||
Public Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
|
||||
|
||||
#End Region
|
||||
|
||||
Public DragControl = Nothing
|
||||
|
||||
@@ -8,10 +8,12 @@ Friend Module ModSecret
|
||||
|
||||
#Region "杂项"
|
||||
|
||||
'在开源内容的注册表键与普通内容的注册表键隔离
|
||||
'在开源版的注册表与常规版的注册表隔离，以防数据冲突
|
||||
Public Const RegFolder As String = "PCLDebug"
|
||||
'用于微软登录的 ClientId
|
||||
Public Const OAuthClientId As String = ""
|
||||
'CurseForge API Key
|
||||
Public Const CurseForgeAPIKey As String = ""
|
||||
|
||||
Friend Sub SecretOnApplicationStart()
|
||||
'提升 UI 线程优先级
|
||||
@@ -44,7 +46,7 @@ Friend Module ModSecret
|
||||
End If
|
||||
'开源版本提示
|
||||
MyMsgBox($"该版本中无法使用以下特性：
|
||||
- CurseForge API 调用：需要你自行申请 API Key，然后添加到 SecretHeadersSign 方法中
|
||||
- CurseForge API 调用：需要你自行申请 API Key，然后添加到 ModSecret.vb 的开头
|
||||
- 正版登录：需要你自行申请 Client ID，然后添加到 ModSecret.vb 的开头
|
||||
- 更新与联网通知：避免滥用隐患
|
||||
- 主题切换：这是需要赞助解锁的纪念性质的功能，别让赞助者太伤心啦……
|
||||
@@ -107,7 +109,7 @@ Friend Module ModSecret
|
||||
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
|
||||
End If
|
||||
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
|
||||
'如果你有 CurseForge API Key，请添加到 Headers 中，以恢复对 CurseForge 的访问
|
||||
Client.Headers("x-api-key") = CurseForgeAPIKey
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 设置 Headers 的 UA、Referer。
|
||||
@@ -121,7 +123,7 @@ Friend Module ModSecret
|
||||
Request.UserAgent = "PCL2/" & VersionStandardCode
|
||||
End If
|
||||
Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
|
||||
'如果你有 CurseForge API Key，请添加到 Headers 中，以恢复对 CurseForge 的访问
|
||||
Request.Headers("x-api-key") = CurseForgeAPIKey
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
Reference in New Issue
Block a user