同步 2.3.4 代码
This commit is contained in:
龙腾猫跃
@@ -10,12 +10,12 @@ Public Module ModBase
|
||||
#Region "声明"
|
||||
|
||||
'下列版本信息由更新器自动修改
|
||||
Public Const VersionBaseName As String = "2.3.1" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.3.1." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const VersionBaseName As String = "2.3.4" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.3.4." & VersionBranchCode '标准格式的四段式版本号
|
||||
#If BETA Then
|
||||
Public Const VersionCode As Integer = 257 'Release
|
||||
Public Const VersionCode As Integer = 260 'Release
|
||||
#Else
|
||||
Public Const VersionCode As Integer = 259 'Snapshot
|
||||
Public Const VersionCode As Integer = 263 'Snapshot
|
||||
#End If
|
||||
'自动生成的版本信息
|
||||
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
|
||||
@@ -735,7 +735,24 @@ Public Module ModBase
|
||||
Return GetFileNameFromPath(FolderPath)
|
||||
End Function
|
||||
|
||||
'读取、写入文件
|
||||
'读取、写入、复制文件
|
||||
Public Sub CopyFile(FromPath As String, ToPath As String)
|
||||
Try
|
||||
'还原文件路径
|
||||
If Not FromPath.Contains(":\") Then FromPath = Path & FromPath
|
||||
If Not ToPath.Contains(":\") Then ToPath = Path & ToPath
|
||||
'读取文件内容
|
||||
Dim FileBytes As Byte()
|
||||
Using ReadStream As New FileStream(FromPath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
|
||||
ReDim FileBytes(ReadStream.Length - 1)
|
||||
ReadStream.Read(FileBytes, 0, ReadStream.Length)
|
||||
End Using
|
||||
'写入文件内容
|
||||
WriteFile(ToPath, FileBytes)
|
||||
Catch ex As Exception
|
||||
Throw New Exception("复制文件出错：" & FromPath & " -> " & ToPath, ex)
|
||||
End Try
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 读取文件，如果失败则返回空字符串。
|
||||
''' </summary>
|
||||
@@ -745,7 +762,12 @@ Public Module ModBase
|
||||
'还原文件路径
|
||||
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
|
||||
If File.Exists(FilePath) Then
|
||||
ReadFile = DecodeBytes(File.ReadAllBytes(FilePath))
|
||||
Dim FileBytes As Byte()
|
||||
Using ReadStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
|
||||
ReDim FileBytes(ReadStream.Length - 1)
|
||||
ReadStream.Read(FileBytes, 0, ReadStream.Length)
|
||||
End Using
|
||||
ReadFile = DecodeBytes(FileBytes)
|
||||
Else
|
||||
Log("[System] 欲读取的文件不存在，已返回空字符串：" & FilePath)
|
||||
Return ""
|
||||
@@ -818,18 +840,6 @@ Public Module ModBase
|
||||
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
|
||||
'写入文件
|
||||
File.WriteAllBytes(FilePath, Content)
|
||||
'File.Exists 的写法只会写入 System.Byte[]（无法进行转码，Write 不支持写入 Byte[]）
|
||||
'If File.Exists(FilePath) Then
|
||||
' '如果文件存在，刷新目前文件
|
||||
' Using writer As New StreamWriter(FilePath, Append, GetEncoding(FilePath))
|
||||
' writer.Write(Content)
|
||||
' writer.Flush()
|
||||
' writer.Close()
|
||||
' End Using
|
||||
'Else
|
||||
' '如果文件不存在，则新建并写入
|
||||
' File.WriteAllBytes(FilePath, Content)
|
||||
'End If
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
Log(ex, "写入文件时出错：" & FilePath)
|
||||
@@ -1254,6 +1264,14 @@ Re:
|
||||
'My.Computer.FileSystem.DeleteDirectory(Path, FileIO.DeleteDirectoryOption.DeleteAllContents)
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 复制文件夹，失败会抛出异常。
|
||||
''' </summary>
|
||||
Public Sub CopyDirectory(FromPath As String, ToPath As String)
|
||||
For Each File In EnumerateFiles(FromPath)
|
||||
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
|
||||
Next
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 遍历文件夹中的所有文件。
|
||||
''' </summary>
|
||||
Public Function EnumerateFiles(Directory As String) As List(Of FileInfo)
|
||||
@@ -2236,7 +2254,7 @@ Retry:
|
||||
For i = 4 To 1
|
||||
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
|
||||
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
|
||||
File.Copy(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
|
||||
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
|
||||
End If
|
||||
Next
|
||||
File.Create(Path & "PCL\Log1.txt").Dispose()
|
||||
@@ -2329,11 +2347,19 @@ Retry:
|
||||
MyMsgBox(Text, Title)
|
||||
Case LogLevel.Feedback
|
||||
IsErrorTriggered = True
|
||||
If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", Title, "反馈", "取消") = 1 Then Feedback("exlog", False, True)
|
||||
If CanFeedback(False) Then
|
||||
If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", Title, "反馈", "取消") = 1 Then Feedback(False, True)
|
||||
Else
|
||||
MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", Title)
|
||||
End If
|
||||
Case LogLevel.Assert
|
||||
IsErrorTriggered = True
|
||||
Dim Time As Long = GetTimeTick()
|
||||
If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback("exlog", False, True)
|
||||
If CanFeedback(False) Then
|
||||
If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
|
||||
Else
|
||||
MsgBox(Text & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
|
||||
End If
|
||||
If GetTimeTick() - Time < 1500 Then
|
||||
'弹窗无法保留
|
||||
Log("[System] PCL 已崩溃：" & vbCrLf & Text)
|
||||
@@ -2392,10 +2418,18 @@ Retry:
|
||||
Case LogLevel.Msgbox
|
||||
MyMsgBox(ExFull, Title)
|
||||
Case LogLevel.Feedback
|
||||
If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", Title, "反馈", "取消") = 1 Then Feedback("exlog", False, True)
|
||||
If CanFeedback(False) Then
|
||||
If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", Title, "反馈", "取消") = 1 Then Feedback(False, True)
|
||||
Else
|
||||
MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", Title)
|
||||
End If
|
||||
Case LogLevel.Assert
|
||||
Dim Time As Long = GetTimeTick()
|
||||
If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback("exlog", False, True)
|
||||
If CanFeedback(False) Then
|
||||
If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
|
||||
Else
|
||||
MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
|
||||
End If
|
||||
If GetTimeTick() - Time < 1500 Then
|
||||
'弹窗无法保留
|
||||
Log("[System] PCL 已崩溃：" & vbCrLf & ExFull)
|
||||
@@ -2408,15 +2442,22 @@ Retry:
|
||||
End Sub
|
||||
|
||||
'反馈
|
||||
Public Sub Feedback(Source As String, Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
|
||||
Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
|
||||
On Error Resume Next
|
||||
FeedbackInfo()
|
||||
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
|
||||
OpenExplorer("""" & Path & "PCL\""")
|
||||
End If
|
||||
OpenWebsite("https://jinshuju.net/f/rP4b6E?x_field_1=" & Source)
|
||||
If Setup.Get("HintFeedback") = "" Then Setup.Set("HintFeedback", "/") '确保反馈报告会被加载
|
||||
OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
|
||||
End Sub
|
||||
Public Function CanFeedback(ShowHint As Boolean) As Boolean
|
||||
If False.Equals(PageSetupSystem.IsLauncherNewest) Then
|
||||
If ShowHint Then MyMsgBox("你的 PCL2 不是最新版，因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈")
|
||||
Return False
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 在日志中输出系统诊断信息。
|
||||
''' </summary>
|
||||
@@ -2426,6 +2467,7 @@ Retry:
|
||||
"操作系统：" & My.Computer.Info.OSFullName & vbCrLf &
|
||||
"剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
|
||||
"DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf &
|
||||
"MC 文件夹：" & If(PathMcFolder, "Nothing") & vbCrLf &
|
||||
"文件位置：" & Path)
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -484,6 +484,7 @@
|
||||
Case LoadState.Finished
|
||||
'检查是否需要重启
|
||||
If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith
|
||||
'UNDONE: 这里的 IgnoreReloadTimeout 导致加载器不会重启，也就是微软登录不会自动重新登录
|
||||
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
|
||||
If ModeDebug Then Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name)
|
||||
GoTo Restart
|
||||
|
||||
@@ -940,7 +940,7 @@ Capture:
|
||||
Next
|
||||
'是否禁用多线程，以及规定碎片大小
|
||||
Dim TargetUrl As String = GetSource().Url
|
||||
If TargetUrl.Contains("pcl2-server") Then Return False
|
||||
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") Then Return False
|
||||
Dim RealFilePieceLimit = If(TargetUrl.Contains("download.mcbbs.net"), FilePieceLimit * 5, FilePieceLimit)
|
||||
'寻找最大碎片
|
||||
Dim FilePieceMax As NetThread = Threads
|
||||
@@ -1278,7 +1278,7 @@ Retry:
|
||||
MergeFile.Dispose() : MergeFile = Nothing
|
||||
ElseIf Threads.DownloadDone = DownloadDone Then
|
||||
'仅有一个文件，直接复制
|
||||
File.Copy(Threads.Temp, LocalPath, True)
|
||||
CopyFile(Threads.Temp, LocalPath)
|
||||
Else
|
||||
'有多个线程，合并
|
||||
MergeFile = New FileStream(LocalPath, FileMode.Create)
|
||||
|
||||
@@ -119,7 +119,7 @@
|
||||
Log("[Crash] 已解压导入的日志文件：" & FilePath)
|
||||
Else
|
||||
'解压失败
|
||||
File.Copy(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
|
||||
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
|
||||
Log("[Crash] 已复制导入的日志文件：" & FilePath)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
@@ -363,7 +363,8 @@
|
||||
'来源崩溃日志的分析
|
||||
If LogCrash IsNot Nothing Then
|
||||
Log("[Crash] 开始进行崩溃日志堆栈分析")
|
||||
Dim Keywords = AnalyzeStackKeyword(LogCrash.Replace("A detailed walkthrough of the error", "¨").Split("¨").First)
|
||||
Dim StackLogs As String = LogCrash.Replace("System Details", "¨").Split("¨").First
|
||||
Dim Keywords = AnalyzeStackKeyword(StackLogs)
|
||||
If Keywords.Count > 0 Then
|
||||
Dim Names = AnalyzeModName(Keywords)
|
||||
If Names Is Nothing Then
|
||||
@@ -480,10 +481,11 @@ Done:
|
||||
AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类)
|
||||
End If
|
||||
'Mod 导致的崩溃
|
||||
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("mixin.injection.throwables.InjectionError") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
|
||||
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
|
||||
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in callback )[^./ ]+(?=.mixins.json:)")
|
||||
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
End If
|
||||
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "[^\n]+?(?)"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
@@ -504,7 +506,6 @@ Done:
|
||||
'崩溃报告分析
|
||||
If LogCrash IsNot Nothing Then
|
||||
If LogCrash.Contains("maximum id range exceeded") Then AppendReason(CrashReason.Mod过多导致超出ID限制)
|
||||
If LogCrash.Contains("Entity being rendered") AndAlso LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
|
||||
If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
|
||||
If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
|
||||
If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
|
||||
@@ -555,7 +556,7 @@ Done:
|
||||
For Each IgnoreStack In {
|
||||
"java", "sun", "javax", "jdk",
|
||||
"org.lwjgl", "com.sun", "net.minecraftforge", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
|
||||
"com.electronwill.nightconfig",
|
||||
"com.electronwill.nightconfig", "it.unimi.dsi",
|
||||
"MojangTricksIntelDriversForPerformance_javaw"}
|
||||
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
|
||||
Next
|
||||
@@ -576,12 +577,12 @@ NextStack:
|
||||
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
|
||||
Dim Word As String = Splited(i)
|
||||
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
|
||||
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api",
|
||||
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi",
|
||||
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base",
|
||||
"forge", "setup", "block", "model", "mixin", "event",
|
||||
"forge", "setup", "block", "model", "mixin", "event", "unimi",
|
||||
"common", "server", "config", "loader", "launch", "entity", "assist", "client", "modapi", "mojang", "shader", "events", "github",
|
||||
"preinit", "preload", "machine", "reflect", "channel", "general", "handler",
|
||||
"optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override"
|
||||
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content",
|
||||
"fastutil", "optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override"
|
||||
}.Contains(Word.ToLower) Then Continue For
|
||||
PossibleWords.Add(Word.Trim)
|
||||
Next
|
||||
@@ -700,20 +701,16 @@ NextStack:
|
||||
'复制文件
|
||||
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
|
||||
For Each OutputFile In OutputFiles
|
||||
Try
|
||||
Dim FileName As String = GetFileNameFromPath(OutputFile)
|
||||
Select Case FileName
|
||||
Case "LatestLaunch.bat"
|
||||
FileName = "启动脚本.bat"
|
||||
Case "Log1.txt"
|
||||
FileName = "PCL2 启动器日志.txt"
|
||||
Case "RawOutput.log"
|
||||
FileName = "游戏崩溃前的输出.txt"
|
||||
End Select
|
||||
File.Copy(OutputFile, TempFolder & "Report\" & FileName, True)
|
||||
Catch ex As Exception
|
||||
Log(ex, "复制错误报告文件失败（" & OutputFile & "）")
|
||||
End Try
|
||||
Dim FileName As String = GetFileNameFromPath(OutputFile)
|
||||
Select Case FileName
|
||||
Case "LatestLaunch.bat"
|
||||
FileName = "启动脚本.bat"
|
||||
Case "Log1.txt"
|
||||
FileName = "PCL2 启动器日志.txt"
|
||||
Case "RawOutput.log"
|
||||
FileName = "游戏崩溃前的输出.txt"
|
||||
End Select
|
||||
CopyFile(OutputFile, TempFolder & "Report\" & FileName)
|
||||
Next
|
||||
'导出报告
|
||||
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
|
||||
|
||||
@@ -117,13 +117,8 @@
|
||||
End Sub))
|
||||
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
|
||||
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
|
||||
Try
|
||||
File.Copy(TempAddress, RealAddress, True)
|
||||
McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
|
||||
Catch ex As Exception
|
||||
Log(ex, "后台更新资源文件索引失败", LogLevel.Debug)
|
||||
McLaunchLog("后台更新资源文件索引失败：" & TempAddress)
|
||||
End Try
|
||||
CopyFile(TempAddress, RealAddress)
|
||||
McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
|
||||
End Sub))
|
||||
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
|
||||
Log("[Download] 开始后台更新资源文件索引")
|
||||
@@ -944,7 +939,7 @@
|
||||
|
||||
#Region "DlCfProject | CurseForge 工程"
|
||||
|
||||
Private DlCfProjectDb As JObject = Nothing
|
||||
Private DlCfProjectDb As Dictionary(Of String, String) = Nothing
|
||||
Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject)
|
||||
|
||||
''' <summary>
|
||||
@@ -1008,9 +1003,7 @@
|
||||
Private _MCBBS As String
|
||||
Public Property MCBBS As String
|
||||
Get
|
||||
If DlCfProjectDb Is Nothing Then
|
||||
DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
|
||||
End If
|
||||
ReleaseCfDatabase()
|
||||
If _MCBBS Is Nothing Then
|
||||
If Website IsNot Nothing Then
|
||||
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
|
||||
@@ -1029,9 +1022,7 @@
|
||||
Private _ChineseName As String
|
||||
Public Property ChineseName As String
|
||||
Get
|
||||
If DlCfProjectDb Is Nothing Then
|
||||
DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
|
||||
End If
|
||||
ReleaseCfDatabase()
|
||||
If _ChineseName Is Nothing Then
|
||||
_ChineseName = Name
|
||||
If Website IsNot Nothing Then
|
||||
@@ -1040,7 +1031,7 @@
|
||||
Dim Result As String = DlCfProjectDb(Keyword)
|
||||
McWikiId = Result.Split("|")(0)
|
||||
If Not Result.Split("|")(1) = "~" Then '使用原名
|
||||
_ChineseName = Result.Split("|")(1) '& " (" & Name & ")"
|
||||
_ChineseName = Result.Split("|")(1)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
@@ -1233,10 +1224,7 @@
|
||||
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]")
|
||||
If IsChineseSearch AndAlso Not String.IsNullOrEmpty(RawFilter) Then
|
||||
If Task.Input.IsModPack Then Throw New Exception("整合包搜索仅支持英文")
|
||||
'释放资料库文件
|
||||
If DlCfProjectDb Is Nothing Then
|
||||
DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
|
||||
End If
|
||||
ReleaseCfDatabase()
|
||||
'构造搜索请求
|
||||
Dim SearchEntries As New List(Of SearchEntry(Of String))
|
||||
For Each Entry In DlCfProjectDb
|
||||
@@ -1338,6 +1326,22 @@
|
||||
Return New DlCfProject(Json)
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 读取 Mod 数据库。
|
||||
''' </summary>
|
||||
Private Sub ReleaseCfDatabase()
|
||||
If DlCfProjectDb IsNot Nothing Then Exit Sub
|
||||
DlCfProjectDb = New Dictionary(Of String, String)
|
||||
For Each Entry In CType(GetJson(DecodeBytes(GetResources("ModData"))), JObject)
|
||||
Dim Result As String = Entry.Value.ToString
|
||||
If Not Result.Split("|")(1) = "~" Then '处理 *
|
||||
Result = Result.Replace("*", " (" &
|
||||
String.Join(" ", Entry.Key.Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
|
||||
End If
|
||||
DlCfProjectDb.Add(Entry.Key, Result)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "DlCfFile | CurseForge Files"
|
||||
|
||||
@@ -106,14 +106,22 @@ NextInner:
|
||||
'检查路径
|
||||
If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.PathIndie & "）")
|
||||
If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.Path & "）")
|
||||
'检查输入信息
|
||||
Dim CheckResult As String = Nothing
|
||||
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput))
|
||||
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
|
||||
'检查版本
|
||||
If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本！")
|
||||
McVersionCurrent.Load()
|
||||
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)
|
||||
If LoginInput.Type = McLoginType.Legacy AndAlso '离线登录
|
||||
Not RegexCheck(CType(LoginInput, McLoginLegacy).UserName, "^[0-9A-Za-z_]+$") AndAlso
|
||||
McVersionCurrent.Version.McCodeMain >= 18 Then 'MC 1.18 以上
|
||||
CheckResult = "用户名中不可包含除数字、英文、下划线以外的特殊字符！"
|
||||
End If
|
||||
End Sub)
|
||||
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
|
||||
'求赞助
|
||||
If ThemeCheckGold() Then Exit Sub
|
||||
RunInNewThread(Sub()
|
||||
@@ -757,10 +765,11 @@ LoginFinish:
|
||||
'微软登录步骤 1：打开网页认证，获取 OAuth Code
|
||||
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
|
||||
McLaunchLog("开始微软登录步骤 1")
|
||||
If OsVersion <= New Version(10, 0, 17763, 0) Then 'TODO: 添加设置以强制使用网页中继登录
|
||||
If OsVersion <= New Version(10, 0, 17763, 0) Then
|
||||
SystemBrowser:
|
||||
'Windows 7 或老版 Windows 10 登录
|
||||
MyMsgBox("PCL2 即将打开登录网页。登录后会转到一个空白页面（这代表登录成功了），请将该空白页面的网址复制到 PCL2。" & vbCrLf &
|
||||
"如果网络环境不佳，登录网页可能一直加载不出来，此时请尝试使用 VPN 或代理服务器，然后再试。", "登录说明", "开始", ForceWait:=True)
|
||||
"如果网络环境不佳，登录网页可能一直加载不出来，此时请尝试使用 VPN 或加速器，然后再试。", "登录说明", "开始", ForceWait:=True)
|
||||
OpenWebsite(FormLoginOAuth.LoginUrl1)
|
||||
Dim Result As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")}, "https://login.live.com/oauth20_desktop.srf?code=XXXXXX", "输入登录返回码", "确定", "取消")
|
||||
If Result Is Nothing Then
|
||||
@@ -769,12 +778,14 @@ LoginFinish:
|
||||
Else
|
||||
Return RegexSeek(Result, "(?<=code\=)[^&]+")
|
||||
End If
|
||||
Hint("网页登录已完成，你现在可以关闭浏览器上的那个网页了", HintType.Finish)
|
||||
Else
|
||||
'Windows 10 登录
|
||||
Dim ReturnCode As String = Nothing
|
||||
Dim ReturnEx As Exception = Nothing
|
||||
Dim IsFinished As LoadState = LoadState.Loading
|
||||
Dim LoginForm As FormLoginOAuth = Nothing
|
||||
Dim IsSwitchToSystemBrowser As Boolean = False
|
||||
RunInUi(Sub()
|
||||
Try
|
||||
LoginForm = New FormLoginOAuth
|
||||
@@ -783,7 +794,10 @@ LoginFinish:
|
||||
ReturnCode = Code
|
||||
IsFinished = LoadState.Finished
|
||||
End Sub
|
||||
AddHandler LoginForm.OnLoginCanceled, Sub() IsFinished = LoadState.Aborted
|
||||
AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean)
|
||||
IsFinished = LoadState.Aborted
|
||||
IsSwitchToSystemBrowser = IsSwitch
|
||||
End Sub
|
||||
Catch ex As Exception
|
||||
ReturnEx = ex
|
||||
IsFinished = LoadState.Failed
|
||||
@@ -797,6 +811,9 @@ LoginFinish:
|
||||
Return ReturnCode
|
||||
ElseIf IsFinished = LoadState.Failed Then
|
||||
Throw ReturnEx
|
||||
ElseIf IsSwitchToSystemBrowser Then
|
||||
McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
|
||||
GoTo SystemBrowser
|
||||
Else
|
||||
McLaunchLog("微软登录已在步骤 1 被取消")
|
||||
Throw New ThreadInterruptedException("$$")
|
||||
@@ -982,7 +999,7 @@ LoginFinish:
|
||||
#Region "Java 处理"
|
||||
|
||||
Private McLaunchJavaSelected As JavaEntry = Nothing
|
||||
Private Sub McLaunchJavaValidate()
|
||||
Private Sub McLaunchJavaValidate(Task As LoaderTask(Of Integer, List(Of NetFile)))
|
||||
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
|
||||
|
||||
'MC 大版本检测
|
||||
@@ -1028,6 +1045,7 @@ LoginFinish:
|
||||
'选择 Java
|
||||
McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
|
||||
McLaunchJavaSelected = JavaSelect(MinVer, MaxVer, McVersionCurrent)
|
||||
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
|
||||
If McLaunchJavaSelected IsNot Nothing Then
|
||||
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
|
||||
Exit Sub
|
||||
@@ -1151,6 +1169,14 @@ LoginFinish:
|
||||
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
|
||||
End If
|
||||
|
||||
'添加 Java Wrapper 作为主 Jar
|
||||
Dim WrapperPath As String = PathAppdata & "JavaWrapper.jar"
|
||||
If Not File.Exists(WrapperPath) Then
|
||||
WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
McLaunchLog("已自动释放 Java Wrapper")
|
||||
End If
|
||||
DataList.Add("-jar """ & WrapperPath & """")
|
||||
|
||||
'添加 MainClass
|
||||
If Version.JsonObject("mainClass") Is Nothing Then
|
||||
Throw New Exception("版本 Json 中没有 mainClass 项！")
|
||||
@@ -1232,6 +1258,14 @@ NextVersion:
|
||||
'去重
|
||||
Dim Result As String = Join(ArrayNoDouble(DeDuplicateDataList), " ")
|
||||
|
||||
'添加 Java Wrapper 作为主 Jar
|
||||
Dim WrapperPath As String = PathAppdata & "JavaWrapper.jar"
|
||||
If Not File.Exists(WrapperPath) Then
|
||||
WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
McLaunchLog("已自动释放 Java Wrapper")
|
||||
End If
|
||||
Result += " -jar """ & WrapperPath & """"
|
||||
|
||||
'添加 MainClass
|
||||
If Version.JsonObject("mainClass") Is Nothing Then
|
||||
Throw New Exception("版本 Json 中没有 mainClass 项！")
|
||||
@@ -1251,18 +1285,21 @@ NextVersion:
|
||||
If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
|
||||
DataList.Add(BasicString)
|
||||
|
||||
McLaunchArgumentsGameOld = Join(DataList, " ")
|
||||
'添加 Wrapper 导出参数
|
||||
DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
|
||||
|
||||
Dim Result As String = Join(DataList, " ")
|
||||
|
||||
'特别改变 OptiFineTweaker
|
||||
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
|
||||
'把 OptiFineForgeTweaker 放在最后，不然会导致崩溃！
|
||||
If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
|
||||
Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameOld)
|
||||
McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
|
||||
If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
|
||||
Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & Result)
|
||||
Result = Result.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
|
||||
End If
|
||||
If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineTweaker") Then
|
||||
Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameOld)
|
||||
McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
|
||||
If Result.Contains("--tweakClass optifine.OptiFineTweaker") Then
|
||||
Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & Result)
|
||||
Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
|
||||
Try
|
||||
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
|
||||
Catch ex As Exception
|
||||
@@ -1270,6 +1307,8 @@ NextVersion:
|
||||
End Try
|
||||
End If
|
||||
End If
|
||||
|
||||
Return Result
|
||||
End Function
|
||||
Private Function McLaunchArgumentsGameNew(Version As McVersion) As String
|
||||
Dim DataList As New List(Of String)
|
||||
@@ -1302,6 +1341,9 @@ NextVersion:
|
||||
GoTo NextVersion
|
||||
End If
|
||||
|
||||
'添加 Wrapper 导出参数
|
||||
DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
|
||||
|
||||
'将 "-XXX" 与后面 "XXX" 合并到一起
|
||||
'如果不进行合并 Impact 会启动无效，它有两个 --tweakclass
|
||||
Dim DeDuplicateDataList As New List(Of String)
|
||||
|
||||
@@ -225,7 +225,7 @@ Public Module ModMinecraft
|
||||
JavaSearchFolder(Disk.Name, JavaPreList, False)
|
||||
Next
|
||||
'查找 APPDATA 文件夹中的 Java
|
||||
JavaSearchFolder(PathAppdata, JavaPreList, False)
|
||||
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), JavaPreList, False)
|
||||
'查找启动器目录中的 Java
|
||||
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
|
||||
'查找所选 Minecraft 文件夹中的 Java
|
||||
@@ -404,7 +404,7 @@ Wait:
|
||||
Log(ex, "遍历查找 Java 时出错（" & OriginalPath.FullName & "）")
|
||||
End Try
|
||||
End Sub
|
||||
Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\"
|
||||
Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
|
||||
|
||||
'获取
|
||||
|
||||
@@ -1075,7 +1075,7 @@ VersionSearchFinish:
|
||||
Public Property JsonText As String
|
||||
Get
|
||||
If _JsonText Is Nothing Then
|
||||
If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 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
|
||||
@@ -1264,7 +1264,7 @@ Recheck:
|
||||
Try
|
||||
Dim JsonObjCheck = JsonObject
|
||||
Catch ex As Exception
|
||||
Log(ex, "版本 Json 可用性检查失败（" & Name & "）")
|
||||
Log(ex, "版本 Json 可用性检查失败（" & Path & "）")
|
||||
JsonText = ""
|
||||
JsonObject = Nothing
|
||||
Info = ex.Message
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
'获取整合包种类与关键 Json
|
||||
Dim PackType As Integer = -1
|
||||
Try
|
||||
Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open))
|
||||
Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
|
||||
'从根目录判断整合包类型
|
||||
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
|
||||
If Archive.GetEntry("manifest.json") IsNot Nothing Then
|
||||
@@ -54,7 +54,10 @@
|
||||
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
|
||||
Next
|
||||
Catch ex As Exception
|
||||
If File.ToLower.EndsWith(".rar") Then
|
||||
If GetString(ex, False, True).Contains("Error.WinIOError") Then
|
||||
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
ElseIf File.ToLower.EndsWith(".rar") Then
|
||||
Log(ex, "PCL2 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
Else
|
||||
@@ -198,20 +201,20 @@ Retry:
|
||||
Dim OverrideHome As String = If(Json("overrides"), "")
|
||||
If OverrideHome <> "" Then
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {
|
||||
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {
|
||||
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
End If
|
||||
'获取 Mod 列表
|
||||
Dim ModFileList As New List(Of Integer)
|
||||
@@ -225,26 +228,25 @@ Retry:
|
||||
Next
|
||||
If ModFileList.Count > 0 Then
|
||||
'获取 Mod 下载信息
|
||||
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)(
|
||||
"获取 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of Integer, JArray))
|
||||
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
|
||||
'如果文件已被删除，则 API 会跳过那一项
|
||||
If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
|
||||
End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s
|
||||
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of Integer, JArray))
|
||||
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
|
||||
'如果文件已被删除，则 API 会跳过那一项
|
||||
If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
|
||||
End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s
|
||||
'构造 NetFile
|
||||
InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
|
||||
Dim FileList As New Dictionary(Of Integer, NetFile)
|
||||
For Each ModJson In Task.Input
|
||||
'跳过重复的 Mod（疑似 CurseForge Bug）
|
||||
If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
|
||||
'实际的添加
|
||||
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
|
||||
Task.Progress += 1 / (1 + ModFileList.Count)
|
||||
Next
|
||||
Task.Output = FileList.Values.ToList
|
||||
End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
|
||||
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
|
||||
Dim FileList As New Dictionary(Of Integer, NetFile)
|
||||
For Each ModJson In Task.Input
|
||||
'跳过重复的 Mod（疑似 CurseForge Bug）
|
||||
If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
|
||||
'实际的添加
|
||||
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
|
||||
Task.Progress += 1 / (1 + ModFileList.Count)
|
||||
Next
|
||||
Task.Output = FileList.Values.ToList
|
||||
End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
|
||||
'下载 Mod 文件
|
||||
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModFileList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
End If
|
||||
@@ -342,19 +344,19 @@ Retry:
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造加载器
|
||||
If Json("gameVersion") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
|
||||
Dim Request As New McInstallRequest With {
|
||||
@@ -374,19 +376,19 @@ Retry:
|
||||
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）",
|
||||
Sub()
|
||||
Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
|
||||
Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
|
||||
If File.Exists(OldFileName) Then
|
||||
'修改 id
|
||||
Dim FileJson = GetJson(ReadFile(OldFileName))
|
||||
FileJson("id") = VersionName
|
||||
'替换文件
|
||||
File.Delete(OldFileName)
|
||||
WriteFile(RealFileName, FileJson.ToString)
|
||||
Log("[ModPack] 已重命名版本 Json：" & RealFileName)
|
||||
End If
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
Sub()
|
||||
Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
|
||||
Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
|
||||
If File.Exists(OldFileName) Then
|
||||
'修改 id
|
||||
Dim FileJson = GetJson(ReadFile(OldFileName))
|
||||
FileJson("id") = VersionName
|
||||
'替换文件
|
||||
File.Delete(OldFileName)
|
||||
WriteFile(RealFileName, FileJson.ToString)
|
||||
Log("[ModPack] 已重命名版本 Json：" & RealFileName)
|
||||
End If
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
@@ -438,19 +440,19 @@ Retry:
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造版本安装请求
|
||||
If PackJson("components") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
|
||||
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName}
|
||||
@@ -526,19 +528,19 @@ Retry:
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress)
|
||||
Task.Progress = 0.5
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
|
||||
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造加载器
|
||||
If Json("addons") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
|
||||
Dim Addons As New Dictionary(Of String, String)
|
||||
|
||||
Reference in New Issue
Block a user