同步 2.3.4 代码

This commit is contained in:
龙腾猫跃
2022-09-25 20:53:23 +08:00
parent f1310f18fd
commit 47a2fe2315
41 changed files with 451 additions and 386 deletions
-3
View File
@@ -349,8 +349,6 @@ healthchecksdb
*.lnk *.lnk
# 等待下次更新迁移到 GitHub
PageOtherFeedback.*
# 包含主题解锁、加密解密等部分的代码 # 包含主题解锁、加密解密等部分的代码
ModSecret.vb ModSecret.vb
ModSetup.vb ModSetup.vb
@@ -361,6 +359,5 @@ PageSetupUI.*
PageLink/ PageLink/
# 开发者工具 # 开发者工具
ModDevelop.vb ModDevelop.vb
Releaser/
# 不公开底层函数库,以免抄袭 # 不公开底层函数库,以免抄袭
ModMain.vb ModMain.vb
-47
View File
@@ -1,47 +0,0 @@
Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 16
VisualStudioVersion = 16.0.29728.190
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Plain Craft Launcher 2", "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj", "{4499F2D2-18EF-4238-B1F0-7BD547AFF925}"
EndProject
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Releaser", "Releaser", "{0FB7B07C-83E1-477E-B05B-C298304748BC}"
ProjectSection(SolutionItems) = preProject
E:\工具\de4dot\de4dot.exe = E:\工具\de4dot\de4dot.exe
E:\软件\dnSpy\dnSpy.exe = E:\软件\dnSpy\dnSpy.exe
Releaser\Release.nrproj = Releaser\Release.nrproj
Releaser\Releaser.bat = Releaser\Releaser.bat
Releaser\Snapshot.nrproj = Releaser\Snapshot.nrproj
Releaser\Snapshot.vmp = Releaser\Snapshot.vmp
EndProjectSection
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Beta|Any CPU = Beta|Any CPU
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
ReleaseUpdate|Any CPU = ReleaseUpdate|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.ActiveCfg = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.Build.0 = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.Build.0 = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.ActiveCfg = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.Build.0 = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.ActiveCfg = ReleaseUpdate|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.Build.0 = ReleaseUpdate|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {838A572E-025C-4A2B-B682-68732EC0FE76}
EndGlobalSection
GlobalSection(Performance) = preSolution
HasPerformanceSessions = true
EndGlobalSection
GlobalSection(Performance) = preSolution
HasPerformanceSessions = true
EndGlobalSection
EndGlobal
@@ -112,8 +112,6 @@
Select Case Type Select Case Type
Case 0 Case 0
Stack.Children.Add(PageSelectRight.McVersionListItem(Data)) Stack.Children.Add(PageSelectRight.McVersionListItem(Data))
Case 1
Stack.Children.Add(PageOtherFeedback.FeedbackListItem(Data, CardTitle))
Case 2 Case 2
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True)) Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3 Case 3
@@ -116,7 +116,7 @@
Select Case PageState Select Case PageState
Case PageStates.Empty Case PageStates.Empty
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished Then If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Aborted Then
PageState = PageStates.ContentEnter PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanAlways, If(PanContent, Child)) TriggerEnterAnimation(PanAlways, If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then ElseIf PageLoader.State = LoadState.Loading Then
+24 -7
View File
@@ -10,6 +10,11 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 260 Then 'Release 2.3.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
FeatureCount += 22
BugCount += 4
End If
If LastVersion < 257 Then 'Release 2.3.0 If LastVersion < 257 Then 'Release 2.3.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug"))
FeatureCount += 4 FeatureCount += 4
@@ -137,6 +142,20 @@ Public Class FormMain
'3:小* '3:小*
'2:极度严重的 Bug '2:极度严重的 Bug
'1:严重的 Bug '1:严重的 Bug
If LastVersion < 263 Then 'Snapshot 2.3.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
FeatureCount += 11
BugCount += 5
End If
If LastVersion < 262 Then 'Snapshot 2.3.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用 Mod、整合包搜索功能的 Bug"))
BugCount += 1
End If
If LastVersion < 261 Then 'Snapshot 2.3.2
FeatureCount += 8
BugCount += 4
End If
If LastVersion < 259 Then 'Snapshot 2.3.1 If LastVersion < 259 Then 'Snapshot 2.3.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题")) FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
FeatureCount += 14 FeatureCount += 14
@@ -452,7 +471,6 @@ Reopen:
Try Try
Thread.Sleep(200) Thread.Sleep(200)
If Setup.Get("LinkAuto") Then PageLinkIoi.InitLoader.Start() If Setup.Get("LinkAuto") Then PageLinkIoi.InitLoader.Start()
If Not Setup.Get("HintFeedback") = "" Then FeedbackLoader.Start()
DlClientListMojangLoader.Start(1) DlClientListMojangLoader.Start(1)
RunCountSub() RunCountSub()
ServerLoader.Start(1) ServerLoader.Start(1)
@@ -530,7 +548,7 @@ Reopen:
End If End If
'移动自定义皮肤 '移动自定义皮肤
If LastVersionCode <= 161 AndAlso File.Exists(Path & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathTemp & "CustomSkin.png") Then If LastVersionCode <= 161 AndAlso File.Exists(Path & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathTemp & "CustomSkin.png") Then
File.Copy(Path & "PCL\CustomSkin.png", PathTemp & "CustomSkin.png") CopyFile(Path & "PCL\CustomSkin.png", PathTemp & "CustomSkin.png")
Log("[Start] 已移动离线自定义皮肤") Log("[Start] 已移动离线自定义皮肤")
End If End If
'解除帮助页面的隐藏 '解除帮助页面的隐藏
@@ -751,15 +769,15 @@ Reopen:
Exit Sub Exit Sub
End If End If
If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
'Little Skin 'LittleSkin
If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启 Little Skin 登录?" & vbCrLf & If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启 LittleSkin 登录?" & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Exit Sub Exit Sub
End If End If
Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent) Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=McVersionCurrent) Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=McVersionCurrent)
Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=McVersionCurrent) Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=McVersionCurrent)
Setup.Set("VersionServerAuthName", "Little Skin 登录", Version:=McVersionCurrent) Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=McVersionCurrent)
Else Else
'第三方 Authlib 服务器 '第三方 Authlib 服务器
If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启第三方登录?" & vbCrLf & If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启第三方登录?" & vbCrLf &
@@ -823,7 +841,7 @@ Reopen:
Install: Install:
Try Try
For Each ModFile In FilePathList For Each ModFile In FilePathList
File.Copy(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile), True) CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
Next Next
If FilePathList.Count = 1 Then If FilePathList.Count = 1 Then
Hint("已安装 " & GetFileNameFromPath(FilePathList.First) & "!", HintType.Finish) Hint("已安装 " & GetFileNameFromPath(FilePathList.First) & "!", HintType.Finish)
@@ -1018,7 +1036,6 @@ Install:
OtherHelp = 0 OtherHelp = 0
OtherAbout = 1 OtherAbout = 1
OtherTest = 2 OtherTest = 2
OtherFeedback = 3
VersionOverall = 0 VersionOverall = 0
VersionSetup = 1 VersionSetup = 1
VersionMod = 2 VersionMod = 2
+68 -26
View File
@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.3.1" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.3.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.3.1." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.3.4." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 257 'Release Public Const VersionCode As Integer = 260 'Release
#Else #Else
Public Const VersionCode As Integer = 259 'Snapshot Public Const VersionCode As Integer = 263 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -735,7 +735,24 @@ Public Module ModBase
Return GetFileNameFromPath(FolderPath) Return GetFileNameFromPath(FolderPath)
End Function 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>
''' 读取文件,如果失败则返回空字符串。 ''' 读取文件,如果失败则返回空字符串。
''' </summary> ''' </summary>
@@ -745,7 +762,12 @@ Public Module ModBase
'还原文件路径 '还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
If File.Exists(FilePath) Then 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 Else
Log("[System] 欲读取的文件不存在,已返回空字符串:" & FilePath) Log("[System] 欲读取的文件不存在,已返回空字符串:" & FilePath)
Return "" Return ""
@@ -818,18 +840,6 @@ Public Module ModBase
Directory.CreateDirectory(GetPathFromFullPath(FilePath)) Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件 '写入文件
File.WriteAllBytes(FilePath, Content) 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 Return True
Catch ex As Exception Catch ex As Exception
Log(ex, "写入文件时出错:" & FilePath) Log(ex, "写入文件时出错:" & FilePath)
@@ -1254,6 +1264,14 @@ Re:
'My.Computer.FileSystem.DeleteDirectory(Path, FileIO.DeleteDirectoryOption.DeleteAllContents) 'My.Computer.FileSystem.DeleteDirectory(Path, FileIO.DeleteDirectoryOption.DeleteAllContents)
End Sub End Sub
''' <summary> ''' <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> ''' </summary>
Public Function EnumerateFiles(Directory As String) As List(Of FileInfo) Public Function EnumerateFiles(Directory As String) As List(Of FileInfo)
@@ -2236,7 +2254,7 @@ Retry:
For i = 4 To 1 For i = 4 To 1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then 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") 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 End If
Next Next
File.Create(Path & "PCL\Log1.txt").Dispose() File.Create(Path & "PCL\Log1.txt").Dispose()
@@ -2329,11 +2347,19 @@ Retry:
MyMsgBox(Text, Title) MyMsgBox(Text, Title)
Case LogLevel.Feedback Case LogLevel.Feedback
IsErrorTriggered = True 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 Case LogLevel.Assert
IsErrorTriggered = True IsErrorTriggered = True
Dim Time As Long = GetTimeTick() 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 If GetTimeTick() - Time < 1500 Then
'弹窗无法保留 '弹窗无法保留
Log("[System] PCL 已崩溃:" & vbCrLf & Text) Log("[System] PCL 已崩溃:" & vbCrLf & Text)
@@ -2392,10 +2418,18 @@ Retry:
Case LogLevel.Msgbox Case LogLevel.Msgbox
MyMsgBox(ExFull, Title) MyMsgBox(ExFull, Title)
Case LogLevel.Feedback 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 Case LogLevel.Assert
Dim Time As Long = GetTimeTick() 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 If GetTimeTick() - Time < 1500 Then
'弹窗无法保留 '弹窗无法保留
Log("[System] PCL 已崩溃:" & vbCrLf & ExFull) Log("[System] PCL 已崩溃:" & vbCrLf & ExFull)
@@ -2408,15 +2442,22 @@ Retry:
End Sub 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 On Error Resume Next
FeedbackInfo() FeedbackInfo()
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
OpenExplorer("""" & Path & "PCL\""") OpenExplorer("""" & Path & "PCL\""")
End If End If
OpenWebsite("https://jinshuju.net/f/rP4b6E?x_field_1=" & Source) OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
If Setup.Get("HintFeedback") = "" Then Setup.Set("HintFeedback", "/") '确保反馈报告会被加载
End Sub 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>
''' 在日志中输出系统诊断信息。 ''' 在日志中输出系统诊断信息。
''' </summary> ''' </summary>
@@ -2426,6 +2467,7 @@ Retry:
"操作系统:" & My.Computer.Info.OSFullName & vbCrLf & "操作系统:" & My.Computer.Info.OSFullName & vbCrLf &
"剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & 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 & "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf &
"文件位置:" & Path) "文件位置:" & Path)
End Sub End Sub
@@ -484,6 +484,7 @@
Case LoadState.Finished Case LoadState.Finished
'检查是否需要重启 '检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith 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 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) If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart GoTo Restart
@@ -940,7 +940,7 @@ Capture:
Next Next
'是否禁用多线程,以及规定碎片大小 '是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url 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 RealFilePieceLimit = If(TargetUrl.Contains("download.mcbbs.net"), FilePieceLimit * 5, FilePieceLimit)
'寻找最大碎片 '寻找最大碎片
Dim FilePieceMax As NetThread = Threads Dim FilePieceMax As NetThread = Threads
@@ -1278,7 +1278,7 @@ Retry:
MergeFile.Dispose() : MergeFile = Nothing MergeFile.Dispose() : MergeFile = Nothing
ElseIf Threads.DownloadDone = DownloadDone Then ElseIf Threads.DownloadDone = DownloadDone Then
'仅有一个文件,直接复制 '仅有一个文件,直接复制
File.Copy(Threads.Temp, LocalPath, True) CopyFile(Threads.Temp, LocalPath)
Else Else
'有多个线程,合并 '有多个线程,合并
MergeFile = New FileStream(LocalPath, FileMode.Create) MergeFile = New FileStream(LocalPath, FileMode.Create)
@@ -119,7 +119,7 @@
Log("[Crash] 已解压导入的日志文件:" & FilePath) Log("[Crash] 已解压导入的日志文件:" & FilePath)
Else Else
'解压失败 '解压失败
File.Copy(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath)) CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件:" & FilePath) Log("[Crash] 已复制导入的日志文件:" & FilePath)
End If End If
Catch ex As Exception Catch ex As Exception
@@ -363,7 +363,8 @@
'来源崩溃日志的分析 '来源崩溃日志的分析
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析") 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 If Keywords.Count > 0 Then
Dim Names = AnalyzeModName(Keywords) Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then If Names Is Nothing Then
@@ -480,10 +481,11 @@ Done:
AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类) AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类)
End If End If
'Mod 导致的崩溃 '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)") 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, "(?<= 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 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))) AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If End If
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "[^\n]+?(?)"), "").TrimEnd((vbCrLf & " ").ToCharArray))) 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 IsNot Nothing Then
If LogCrash.Contains("maximum id range exceeded") Then AppendReason(CrashReason.Mod过多导致超出ID限制) 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("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃) If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
@@ -555,7 +556,7 @@ Done:
For Each IgnoreStack In { For Each IgnoreStack In {
"java", "sun", "javax", "jdk", "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", "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"} "MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
Next Next
@@ -576,12 +577,12 @@ NextStack:
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节 For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i) Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For 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", "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", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "modapi", "mojang", "shader", "events", "github",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content",
"optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override" "fastutil", "optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override"
}.Contains(Word.ToLower) Then Continue For }.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim) PossibleWords.Add(Word.Trim)
Next Next
@@ -700,7 +701,6 @@ NextStack:
'复制文件 '复制文件
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles) If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles For Each OutputFile In OutputFiles
Try
Dim FileName As String = GetFileNameFromPath(OutputFile) Dim FileName As String = GetFileNameFromPath(OutputFile)
Select Case FileName Select Case FileName
Case "LatestLaunch.bat" Case "LatestLaunch.bat"
@@ -710,10 +710,7 @@ NextStack:
Case "RawOutput.log" Case "RawOutput.log"
FileName = "游戏崩溃前的输出.txt" FileName = "游戏崩溃前的输出.txt"
End Select End Select
File.Copy(OutputFile, TempFolder & "Report\" & FileName, True) CopyFile(OutputFile, TempFolder & "Report\" & FileName)
Catch ex As Exception
Log(ex, "复制错误报告文件失败(" & OutputFile & ")")
End Try
Next Next
'导出报告 '导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress) Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
@@ -117,13 +117,8 @@
End Sub)) End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile))) 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)) LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
Try CopyFile(TempAddress, RealAddress)
File.Copy(TempAddress, RealAddress, True)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress) McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
Catch ex As Exception
Log(ex, "后台更新资源文件索引失败", LogLevel.Debug)
McLaunchLog("后台更新资源文件索引失败:" & TempAddress)
End Try
End Sub)) End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate) Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Log("[Download] 开始后台更新资源文件索引") Log("[Download] 开始后台更新资源文件索引")
@@ -944,7 +939,7 @@
#Region "DlCfProject | CurseForge 工程" #Region "DlCfProject | CurseForge 工程"
Private DlCfProjectDb As JObject = Nothing Private DlCfProjectDb As Dictionary(Of String, String) = Nothing
Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject) Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject)
''' <summary> ''' <summary>
@@ -1008,9 +1003,7 @@
Private _MCBBS As String Private _MCBBS As String
Public Property MCBBS As String Public Property MCBBS As String
Get Get
If DlCfProjectDb Is Nothing Then ReleaseCfDatabase()
DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
End If
If _MCBBS Is Nothing Then If _MCBBS Is Nothing Then
If Website IsNot Nothing Then If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
@@ -1029,9 +1022,7 @@
Private _ChineseName As String Private _ChineseName As String
Public Property ChineseName As String Public Property ChineseName As String
Get Get
If DlCfProjectDb Is Nothing Then ReleaseCfDatabase()
DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
End If
If _ChineseName Is Nothing Then If _ChineseName Is Nothing Then
_ChineseName = Name _ChineseName = Name
If Website IsNot Nothing Then If Website IsNot Nothing Then
@@ -1040,7 +1031,7 @@
Dim Result As String = DlCfProjectDb(Keyword) Dim Result As String = DlCfProjectDb(Keyword)
McWikiId = Result.Split("|")(0) McWikiId = Result.Split("|")(0)
If Not Result.Split("|")(1) = "~" Then '使用原名 If Not Result.Split("|")(1) = "~" Then '使用原名
_ChineseName = Result.Split("|")(1) '& " (" & Name & ")" _ChineseName = Result.Split("|")(1)
End If End If
End If End If
End If End If
@@ -1233,10 +1224,7 @@
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]")
If IsChineseSearch AndAlso Not String.IsNullOrEmpty(RawFilter) Then If IsChineseSearch AndAlso Not String.IsNullOrEmpty(RawFilter) Then
If Task.Input.IsModPack Then Throw New Exception("整合包搜索仅支持英文") If Task.Input.IsModPack Then Throw New Exception("整合包搜索仅支持英文")
'释放资料库文件 ReleaseCfDatabase()
If DlCfProjectDb Is Nothing Then
DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData")))
End If
'构造搜索请求 '构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of String)) Dim SearchEntries As New List(Of SearchEntry(Of String))
For Each Entry In DlCfProjectDb For Each Entry In DlCfProjectDb
@@ -1338,6 +1326,22 @@
Return New DlCfProject(Json) Return New DlCfProject(Json)
End Function 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 #End Region
#Region "DlCfFile | CurseForge Files" #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.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 & ")") 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 版本!") If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本!")
McVersionCurrent.Load() McVersionCurrent.Load()
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题:" & McVersionCurrent.Info) 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 If ThemeCheckGold() Then Exit Sub
RunInNewThread(Sub() RunInNewThread(Sub()
@@ -757,10 +765,11 @@ LoginFinish:
'微软登录步骤 1:打开网页认证,获取 OAuth Code '微软登录步骤 1:打开网页认证,获取 OAuth Code
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
McLaunchLog("开始微软登录步骤 1") 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 登录 'Windows 7 或老版 Windows 10 登录
MyMsgBox("PCL2 即将打开登录网页。登录后会转到一个空白页面(这代表登录成功了),请将该空白页面的网址复制到 PCL2。" & vbCrLf & MyMsgBox("PCL2 即将打开登录网页。登录后会转到一个空白页面(这代表登录成功了),请将该空白页面的网址复制到 PCL2。" & vbCrLf &
"如果网络环境不佳,登录网页可能一直加载不出来,此时请尝试使用 VPN 或代理服务器,然后再试。", "登录说明", "开始", ForceWait:=True) "如果网络环境不佳,登录网页可能一直加载不出来,此时请尝试使用 VPN 或加速器,然后再试。", "登录说明", "开始", ForceWait:=True)
OpenWebsite(FormLoginOAuth.LoginUrl1) 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", "输入登录返回码", "确定", "取消") 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 If Result Is Nothing Then
@@ -769,12 +778,14 @@ LoginFinish:
Else Else
Return RegexSeek(Result, "(?<=code\=)[^&]+") Return RegexSeek(Result, "(?<=code\=)[^&]+")
End If End If
Hint("网页登录已完成,你现在可以关闭浏览器上的那个网页了", HintType.Finish)
Else Else
'Windows 10 登录 'Windows 10 登录
Dim ReturnCode As String = Nothing Dim ReturnCode As String = Nothing
Dim ReturnEx As Exception = Nothing Dim ReturnEx As Exception = Nothing
Dim IsFinished As LoadState = LoadState.Loading Dim IsFinished As LoadState = LoadState.Loading
Dim LoginForm As FormLoginOAuth = Nothing Dim LoginForm As FormLoginOAuth = Nothing
Dim IsSwitchToSystemBrowser As Boolean = False
RunInUi(Sub() RunInUi(Sub()
Try Try
LoginForm = New FormLoginOAuth LoginForm = New FormLoginOAuth
@@ -783,7 +794,10 @@ LoginFinish:
ReturnCode = Code ReturnCode = Code
IsFinished = LoadState.Finished IsFinished = LoadState.Finished
End Sub 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 Catch ex As Exception
ReturnEx = ex ReturnEx = ex
IsFinished = LoadState.Failed IsFinished = LoadState.Failed
@@ -797,6 +811,9 @@ LoginFinish:
Return ReturnCode Return ReturnCode
ElseIf IsFinished = LoadState.Failed Then ElseIf IsFinished = LoadState.Failed Then
Throw ReturnEx Throw ReturnEx
ElseIf IsSwitchToSystemBrowser Then
McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
GoTo SystemBrowser
Else Else
McLaunchLog("微软登录已在步骤 1 被取消") McLaunchLog("微软登录已在步骤 1 被取消")
Throw New ThreadInterruptedException("$$") Throw New ThreadInterruptedException("$$")
@@ -982,7 +999,7 @@ LoginFinish:
#Region "Java 处理" #Region "Java 处理"
Private McLaunchJavaSelected As JavaEntry = Nothing 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) Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'MC 大版本检测 'MC 大版本检测
@@ -1028,6 +1045,7 @@ LoginFinish:
'选择 Java '选择 Java
McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString) McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect(MinVer, MaxVer, McVersionCurrent) McLaunchJavaSelected = JavaSelect(MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
If McLaunchJavaSelected IsNot Nothing Then If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString) McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Exit Sub Exit Sub
@@ -1151,6 +1169,14 @@ LoginFinish:
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response))) " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
End If 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 '添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then If Version.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 Json 中没有 mainClass 项!") Throw New Exception("版本 Json 中没有 mainClass 项!")
@@ -1232,6 +1258,14 @@ NextVersion:
'去重 '去重
Dim Result As String = Join(ArrayNoDouble(DeDuplicateDataList), " ") 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 '添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then If Version.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 Json 中没有 mainClass 项!") Throw New Exception("版本 Json 中没有 mainClass 项!")
@@ -1251,18 +1285,21 @@ NextVersion:
If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}" If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
DataList.Add(BasicString) 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 '特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
'把 OptiFineForgeTweaker 放在最后,不然会导致崩溃! '把 OptiFineForgeTweaker 放在最后,不然会导致崩溃!
If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameOld) Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & Result)
McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" Result = Result.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
End If End If
If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineTweaker") Then If Result.Contains("--tweakClass optifine.OptiFineTweaker") Then
Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameOld) Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & Result)
McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try Try
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker")) WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception Catch ex As Exception
@@ -1270,6 +1307,8 @@ NextVersion:
End Try End Try
End If End If
End If End If
Return Result
End Function End Function
Private Function McLaunchArgumentsGameNew(Version As McVersion) As String Private Function McLaunchArgumentsGameNew(Version As McVersion) As String
Dim DataList As New List(Of String) Dim DataList As New List(Of String)
@@ -1302,6 +1341,9 @@ NextVersion:
GoTo NextVersion GoTo NextVersion
End If End If
'添加 Wrapper 导出参数
DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
'将 "-XXX" 与后面 "XXX" 合并到一起 '将 "-XXX" 与后面 "XXX" 合并到一起
'如果不进行合并 Impact 会启动无效,它有两个 --tweakclass '如果不进行合并 Impact 会启动无效,它有两个 --tweakclass
Dim DeDuplicateDataList As New List(Of String) Dim DeDuplicateDataList As New List(Of String)
@@ -225,7 +225,7 @@ Public Module ModMinecraft
JavaSearchFolder(Disk.Name, JavaPreList, False) JavaSearchFolder(Disk.Name, JavaPreList, False)
Next Next
'查找 APPDATA 文件夹中的 Java '查找 APPDATA 文件夹中的 Java
JavaSearchFolder(PathAppdata, JavaPreList, False) JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), JavaPreList, False)
'查找启动器目录中的 Java '查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True) JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java '查找所选 Minecraft 文件夹中的 Java
@@ -404,7 +404,7 @@ Wait:
Log(ex, "遍历查找 Java 时出错(" & OriginalPath.FullName & ")") Log(ex, "遍历查找 Java 时出错(" & OriginalPath.FullName & ")")
End Try End Try
End Sub 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 Public Property JsonText As String
Get Get
If _JsonText Is Nothing Then 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") _JsonText = ReadFile(Path & Name & ".json")
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试 '如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
If _JsonText.Length = 0 Then If _JsonText.Length = 0 Then
@@ -1264,7 +1264,7 @@ Recheck:
Try Try
Dim JsonObjCheck = JsonObject Dim JsonObjCheck = JsonObject
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 Json 可用性检查失败(" & Name & ")") Log(ex, "版本 Json 可用性检查失败(" & Path & ")")
JsonText = "" JsonText = ""
JsonObject = Nothing JsonObject = Nothing
Info = ex.Message Info = ex.Message
@@ -20,7 +20,7 @@
'获取整合包种类与关键 Json '获取整合包种类与关键 Json
Dim PackType As Integer = -1 Dim PackType As Integer = -1
Try 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("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If Archive.GetEntry("manifest.json") IsNot Nothing Then If Archive.GetEntry("manifest.json") IsNot Nothing Then
@@ -54,7 +54,10 @@
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包 If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
Next Next
Catch ex As Exception 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)) Log(ex, "PCL2 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return False
Else Else
@@ -225,8 +228,7 @@ Retry:
Next Next
If ModFileList.Count > 0 Then If ModFileList.Count > 0 Then
'获取 Mod 下载信息 '获取 Mod 下载信息
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)( InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
"获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray)) 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") Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
'如果文件已被删除,则 API 会跳过那一项 '如果文件已被删除,则 API 会跳过那一项
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.3.1.0")> <Assembly: AssemblyVersion("2.3.4.0")>
<Assembly: AssemblyFileVersion("2.3.1.0")> <Assembly: AssemblyFileVersion("2.3.4.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
+10
View File
@@ -100,6 +100,16 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property JavaWrapper() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("JavaWrapper", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -130,6 +130,9 @@
<data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
@@ -119,7 +119,10 @@ Public Module ModDownloadLib
'下载支持库文件 '下载支持库文件
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件(副加载器)", LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False}) LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
Loaders.Add(New LoaderCombo(Of String)(McDownloadClientLibName, LoadersLib) With {.Block = False, .ProgressWeight = 14}) Loaders.Add(New LoaderCombo(Of String)(McDownloadClientLibName, LoadersLib) With {.Block = False, .ProgressWeight = 14})
@@ -518,19 +521,14 @@ Public Module ModDownloadLib
Next Next
'拷贝原版文件 '拷贝原版文件
If IsCustomFolder Then If IsCustomFolder Then
Try
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit) Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
File.Copy(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
End If End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
File.Copy(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
End If End If
Catch ex As Exception
'OptiFine 与 Forge 同时开始复制偶尔会导致冲突出错
Log(ex, "安装 OptiFine 拷贝原版文件时出错")
End Try
End If End If
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -548,9 +546,9 @@ Public Module ModDownloadLib
End If End If
My.Computer.FileSystem.CreateDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\") My.Computer.FileSystem.CreateDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
McFolderLauncherProfilesJsonCreate(BaseMcFolder) McFolderLauncherProfilesJsonCreate(BaseMcFolder)
File.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json", CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
File.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
Task.Progress = 0.06 Task.Progress = 0.06
'进行安装 '进行安装
@@ -577,7 +575,7 @@ Public Module ModDownloadLib
Task.Progress = 0.1 Task.Progress = 0.1
'复制 Jar 文件 '复制 Jar 文件
If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar") If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar")
File.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar") CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
Task.Progress = 0.7 Task.Progress = 0.7
'建立 Json 文件 '建立 Json 文件
Dim InheritVersion As New McVersion(McFolder & "versions\" & DownloadInfo.Inherit) Dim InheritVersion As New McVersion(McFolder & "versions\" & DownloadInfo.Inherit)
@@ -1314,7 +1312,7 @@ Public Module ModDownloadLib
Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder) Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder)
If Not File.Exists(RealPath) Then If Not File.Exists(RealPath) Then
Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath)) Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
File.Copy(LibFile.LocalPath, RealPath) CopyFile(LibFile.LocalPath, RealPath)
End If End If
If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件:" & LibFile.LocalPath) If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件:" & LibFile.LocalPath)
Next Next
@@ -1331,19 +1329,14 @@ Public Module ModDownloadLib
Next Next
'拷贝原版文件 '拷贝原版文件
If IsCustomFolder Then If IsCustomFolder Then
Try
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & Inherit) Directory.CreateDirectory(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
File.Copy(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json") CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
File.Copy(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If End If
Catch ex As Exception
'OptiFine 与 Forge 同时开始复制偶尔会导致冲突出错
Log(ex, "安装 Forge 拷贝原版文件时出错")
End Try
End If End If
#End Region #End Region
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -1352,15 +1345,15 @@ Public Module ModDownloadLib
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
Log("[Download] 开始进行新版方式 Forge 安装:" & InstallerAddress) Log("[Download] 开始进行新版方式 Forge 安装:" & InstallerAddress)
'记录当前文件夹列表(在新建目标文件夹之前)
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(Info As DirectoryInfo) As String
Return Info.FullName
End Function).ToList()
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
'新建目标版本文件夹 '新建目标版本文件夹
Directory.CreateDirectory(VersionFolder) Directory.CreateDirectory(VersionFolder)
'记录当前文件夹列表
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(Info As DirectoryInfo) As String
Return Info.FullName
End Function).ToList()
Task.Progress = 0.04 Task.Progress = 0.04
'释放 launcher_installer.json '释放 launcher_installer.json
McFolderLauncherProfilesJsonCreate(McFolder) McFolderLauncherProfilesJsonCreate(McFolder)
@@ -1375,16 +1368,18 @@ Public Module ModDownloadLib
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.SkipWhile(Function(Info As DirectoryInfo) As Boolean Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.SkipWhile(Function(Info As DirectoryInfo) As Boolean
Return OldList.Contains(Info.FullName) Return OldList.Contains(Info.FullName)
End Function).ToList() End Function).ToList()
If DeltaList.Count > 1 Then '它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
DeltaList = New List(Of DirectoryInfo) From {DeltaList.Where(Function(l) l.Name.Contains("forge")).First}
End If
If DeltaList.Count = 1 Then '如果没有新增文件夹,那么预测的文件夹名就是正确的 If DeltaList.Count = 1 Then '如果没有新增文件夹,那么预测的文件夹名就是正确的
Dim RealFolder As DirectoryInfo = DeltaList(0) Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
Dim JsonFile As FileInfo = RealFolder.EnumerateFiles.First() WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName))
JsonFile.CopyTo(VersionFolder & Id & ".json", True)
End If End If
'新建 mods 文件夹 '新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception Catch ex As Exception
Throw New Exception("安装新 Forge 版本失败", ex) Throw New Exception("安装新 Forge 版本失败", ex)
End Try Finally
'清理文件 '清理文件
Try Try
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
@@ -1392,6 +1387,7 @@ Public Module ModDownloadLib
Catch ex As Exception Catch ex As Exception
Log(ex, "安装 Forge 清理文件时出错") Log(ex, "安装 Forge 清理文件时出错")
End Try End Try
End Try
End Sub) With {.ProgressWeight = 10}) End Sub) With {.ProgressWeight = 10})
Else Else
Log("[Download] 检测为非新版 Forge:" & Version) Log("[Download] 检测为非新版 Forge:" & Version)
@@ -1437,15 +1433,16 @@ Public Module ModDownloadLib
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception Catch ex As Exception
Throw New Exception("非新版方式安装 Forge 失败", ex) Throw New Exception("非新版方式安装 Forge 失败", ex)
End Try Finally
Try Try
'释放文件 '清理文件
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then My.Computer.FileSystem.DeleteFile(InstallerAddress) If File.Exists(InstallerAddress) Then My.Computer.FileSystem.DeleteFile(InstallerAddress)
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\") If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
Catch ex As Exception Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错") Log(ex, "非新版方式安装 Forge 清理文件时出错")
End Try End Try
End Try
End Sub) With {.ProgressWeight = 1}) End Sub) With {.ProgressWeight = 1})
If FixLibrary Then If FixLibrary Then
If IsCustomFolder Then Throw New Exception("若需要补全支持库,就不能自定义 MC 文件夹") If IsCustomFolder Then Throw New Exception("若需要补全支持库,就不能自定义 MC 文件夹")
@@ -2115,7 +2112,7 @@ Public Module ModDownloadLib
WriteFile(OutputJsonPath, OutputJson.ToString) WriteFile(OutputJsonPath, OutputJson.ToString)
If MinecraftJar <> OutputJar Then '可能是同一个文件 If MinecraftJar <> OutputJar Then '可能是同一个文件
If File.Exists(OutputJar) Then File.Delete(OutputJar) If File.Exists(OutputJar) Then File.Delete(OutputJar)
File.Copy(MinecraftJar, OutputJar) CopyFile(MinecraftJar, OutputJar)
End If End If
Log("[Download] 版本合并 " & OutputName & " 完成") Log("[Download] 版本合并 " & OutputName & " 完成")
#End Region #End Region
@@ -51,6 +51,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
<local:MyComboBoxItem Content="" IsSelected="True" /> <local:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" /> <local:MyComboBoxItem Content="1.19.1" />
<local:MyComboBoxItem Content="1.19" /> <local:MyComboBoxItem Content="1.19" />
<local:MyComboBoxItem Content="1.18.2" /> <local:MyComboBoxItem Content="1.18.2" />
@@ -47,6 +47,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
<local:MyComboBoxItem Content="" IsSelected="True" /> <local:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" /> <local:MyComboBoxItem Content="1.19.1" />
<local:MyComboBoxItem Content="1.19" /> <local:MyComboBoxItem Content="1.19" />
<local:MyComboBoxItem Content="1.18.2" /> <local:MyComboBoxItem Content="1.18.2" />
@@ -17,11 +17,12 @@
<local:MyLoading x:Name="Loading" Text="正在加载登录页面" HorizontalAlignment="Center" /> <local:MyLoading x:Name="Loading" Text="正在加载登录页面" HorizontalAlignment="Center" />
<TextBlock Text="如果网络环境不佳,加载可能非常缓慢甚至一直加载不出来" Margin="0,25,0,0" <TextBlock Text="如果网络环境不佳,加载可能非常缓慢甚至一直加载不出来" Margin="0,25,0,0"
HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" /> HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" />
<TextBlock Text="此时请尝试使用 VPN 或代理服务器,然后再试" <TextBlock Text="此时请尝试使用 VPN 或加速器,然后重试"
HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" /> HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" />
</StackPanel> </StackPanel>
<WebBrowser x:Name="Browser1" Visibility="Collapsed" Tag="1" /> <WebBrowser x:Name="Browser1" Visibility="Collapsed" Tag="1" Margin="0,0,0,25" />
<WebBrowser x:Name="Browser2" Visibility="Collapsed" Tag="2" /> <WebBrowser x:Name="Browser2" Visibility="Collapsed" Tag="2" Margin="0,0,0,25" />
<WebBrowser x:Name="Browser3" Visibility="Collapsed" Tag="3" /> <WebBrowser x:Name="Browser3" Visibility="Collapsed" Tag="3" Margin="0,0,0,25" />
<local:MyTextButton Text="如果遇到问题,可以点击这里使用系统浏览器登录" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="0,0,0,5" x:Name="HintSwitch" />
</Grid> </Grid>
</Window> </Window>
@@ -3,11 +3,11 @@
Public Class FormLoginOAuth Public Class FormLoginOAuth
Public Event OnLoginSuccess(code As String) Public Event OnLoginSuccess(code As String)
Public Event OnLoginCanceled(IsForceExit As Boolean) Public Event OnLoginCanceled(IsSwitch As Boolean)
'跳转事件 '跳转事件
Private IsLoginSuccessed As Boolean = False Private IsLoginSuccessed As Boolean = False
Private IsForceExit As Boolean = False Private IsSwitch As Boolean = False
Private Sub Browser_Navigating(sender As WebBrowser, e As NavigatingCancelEventArgs) Handles Browser1.Navigating, Browser2.Navigating, Browser3.Navigating Private Sub Browser_Navigating(sender As WebBrowser, e As NavigatingCancelEventArgs) Handles Browser1.Navigating, Browser2.Navigating, Browser3.Navigating
Dim Url As String = e.Uri.AbsoluteUri Dim Url As String = e.Uri.AbsoluteUri
If ModeDebug Then Log("[Login] 登录浏览器 " & sender.Tag & " 导向:" & Url) If ModeDebug Then Log("[Login] 登录浏览器 " & sender.Tag & " 导向:" & Url)
@@ -18,7 +18,6 @@ Public Class FormLoginOAuth
RaiseEvent OnLoginSuccess(Code) RaiseEvent OnLoginSuccess(Code)
ElseIf Url.Contains("github.") Then ElseIf Url.Contains("github.") Then
Hint("PCL2 不支持使用 GitHub 登录微软账号!", HintType.Critical) Hint("PCL2 不支持使用 GitHub 登录微软账号!", HintType.Critical)
IsForceExit = True
Close() Close()
End If End If
End Sub End Sub
@@ -36,6 +35,7 @@ Public Class FormLoginOAuth
RunInUi(Sub() RunInUi(Sub()
sender.Visibility = Visibility.Visible sender.Visibility = Visibility.Visible
PanLoading.Visibility = Visibility.Collapsed PanLoading.Visibility = Visibility.Collapsed
Log("[Login] 已将登录窗口切换至浏览器")
End Sub) End Sub)
End Sub) End Sub)
End Sub End Sub
@@ -64,15 +64,37 @@ Public Class FormLoginOAuth
End Sub) End Sub)
End Sub End Sub
Private Sub FormLoginOAuth_Closed() Handles Me.Closed Private Sub FormLoginOAuth_Closed() Handles Me.Closed
RunInThread(Sub()
Thread.Sleep(1000) '释放会卡一下,所以稍等一下……
RunInUiWait(Sub()
Try Try
Browser1.Dispose() Browser1.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 1 失败")
End Try
End Sub)
Thread.Sleep(200)
RunInUiWait(Sub()
Try
Browser2.Dispose() Browser2.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 2 失败")
End Try
End Sub)
Thread.Sleep(200)
RunInUiWait(Sub()
Try
Browser3.Dispose() Browser3.Dispose()
Catch ex As Exception Catch ex As Exception
Log(ex, "释放微软登录浏览器失败") Log(ex, "释放微软登录浏览器 3 失败")
End Try End Try
If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsForceExit) End Sub)
End Sub)
If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch)
FrmMain.Focus() FrmMain.Focus()
End Sub End Sub
Private Sub HintSwitch_Click(sender As Object, e As EventArgs) Handles HintSwitch.Click
IsSwitch = True
Close()
End Sub
End Class End Class
@@ -59,7 +59,7 @@
Dim Image As New MyBitmap(Address) Dim Image As New MyBitmap(Address)
Image.Save(FileAddress) Image.Save(FileAddress)
Else Else
File.Copy(Address, FileAddress) CopyFile(Address, FileAddress)
End If End If
Hint("皮肤保存成功!", HintType.Finish) Hint("皮肤保存成功!", HintType.Finish)
End If End If
@@ -211,7 +211,7 @@
Try Try
Retry: Retry:
'获取登录信息 '获取登录信息
If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit() '等待登录结束 If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit(PageLoginMsSkin.GetLoginData())
If McLoginMsLoader.State <> LoadState.Finished Then If McLoginMsLoader.State <> LoadState.Finished Then
Hint("登录失败,无法更改披风!", HintType.Critical) Hint("登录失败,无法更改披风!", HintType.Critical)
Exit Sub Exit Sub
@@ -9,20 +9,6 @@
<StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True"> <StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<StackPanel x:Name="PanCustom"> <StackPanel x:Name="PanCustom">
</StackPanel> </StackPanel>
<local:MyCard Margin="0,0,0,15" Title="请立即迁移到微软账号!" x:Name="PanMs" Visibility="Collapsed" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,37,20,14">
<TextBlock TextWrapping="Wrap" Text="为了提高账户安全性,你必须将 Mojang 账号迁移到微软账号上,否则将无法进入正版服务器!" Margin="0,0,0,2" />
<TextBlock TextWrapping="Wrap" Text="在完成迁移后,你需要将左侧的登录方式从 Mojang 改为 微软,才能继续登录。此外,你还会获得一件披风作为奖励!" Margin="0,0,0,2" />
<Grid Height="35" Margin="0,10,0,4">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnMsStart" Grid.Column="0" MinWidth="140" Text="开始迁移" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnMsFaq" Grid.Column="1" MinWidth="140" Text="迁移常见问题" Padding="13,0" HorizontalAlignment="Left" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="快照版提示" x:Name="PanHint"> <local:MyCard Margin="0,0,0,15" Title="快照版提示" x:Name="PanHint">
<StackPanel Margin="25,40,23,12"> <StackPanel Margin="25,40,23,12">
<TextBlock x:Name="LabHint1" TextWrapping="Wrap" Margin="0,0,0,2" /> <TextBlock x:Name="LabHint1" TextWrapping="Wrap" Margin="0,0,0,2" />
@@ -99,12 +99,10 @@
Init() Init()
End Sub End Sub
Private Sub BtnMsStart_Click() Handles BtnMsStart.Click Public Shared Sub StartMigration()
MyMsgBox("在迁移过程中,你可能需要设置你的档案信息。" & vbCrLf & "在输入年龄或生日时,请注意让你的年龄大于 18 岁,否则可能导致无法登录!", "迁移提示", "继续", ForceWait:=True) MyMsgBox("在迁移过程中,你可能需要设置你的档案信息,此时请注意让年龄大于 18 岁,否则可能导致无法登录!" & vbCrLf &
"在迁移完成后,请在上方选择 微软 登录方式而非 Mojang。", "迁移提示", "继续", ForceWait:=True)
OpenWebsite("https://www.minecraft.net/zh-hans/account-security") OpenWebsite("https://www.minecraft.net/zh-hans/account-security")
End Sub End Sub
Private Sub BtnMsFaq_Click() Handles BtnMsFaq.Click
OpenWebsite("https://www.mcbbs.net/thread-1252431-1-1.html")
End Sub
End Class End Class
@@ -6,6 +6,7 @@
xmlns:local="clr-namespace:PCL" xmlns:local="clr-namespace:PCL"
mc:Ignorable="d" d:DesignWidth="302.4" Margin="0,0,0,-2"> mc:Ignorable="d" d:DesignWidth="302.4" Margin="0,0,0,-2">
<Grid.RowDefinitions> <Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
<RowDefinition Height="10" /> <RowDefinition Height="10" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
@@ -15,10 +16,11 @@
<ColumnDefinition /> <ColumnDefinition />
<ColumnDefinition Width="224" /> <ColumnDefinition Width="224" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyComboBox Grid.Row="0" Grid.Column="1" IsEditable="True" Height="28" x:Name="ComboName" /> <local:MyHint Text="Mojang 账号现已无法进入正版服务器,请点击此处开始账号迁移!" Grid.ColumnSpan="2" Margin="0,0,0,15" x:Name="HintMigration" />
<TextBlock Text="邮箱" VerticalAlignment="Center" /> <local:MyComboBox Grid.Row="1" Grid.Column="1" IsEditable="True" Height="28" x:Name="ComboName" />
<PasswordBox Grid.Row="2" Grid.Column="1" x:Name="TextPass" /> <TextBlock Grid.Row="1" Text="邮箱" VerticalAlignment="Center" />
<TextBlock Text="密码" Grid.Row="2" VerticalAlignment="Center" /> <PasswordBox Grid.Row="3" Grid.Column="1" x:Name="TextPass" />
<local:MyCheckBox x:Name="CheckRemember" Tag="LoginRemember" Height="20" Margin="-1,12,80,0" Text="记住密码" Grid.Row="3" Grid.Column="1" Grid.ColumnSpan="2" /> <TextBlock Text="密码" Grid.Row="3" VerticalAlignment="Center" />
<local:MyTextButton Margin="0,12,2,0" x:Name="BtnLink" Content="购买正版" Grid.Row="3" HorizontalAlignment="Right" Grid.Column="1" Padding="20,0,0,0" HorizontalContentAlignment="Right" VerticalContentAlignment="Center" FontSize="13" /> <local:MyCheckBox x:Name="CheckRemember" Tag="LoginRemember" Height="20" Margin="-1,12,80,0" Text="记住密码" Grid.Row="4" Grid.Column="1" Grid.ColumnSpan="2" />
<local:MyTextButton Margin="0,12,2,0" x:Name="BtnLink" Content="购买正版" Grid.Row="4" HorizontalAlignment="Right" Grid.Column="1" Padding="20,0,0,0" HorizontalContentAlignment="Right" VerticalContentAlignment="Center" FontSize="13" />
</Grid> </Grid>
@@ -77,5 +77,8 @@
OpenWebsite("https://account.mojang.com/password") OpenWebsite("https://account.mojang.com/password")
End If End If
End Sub End Sub
Private Sub HintMigration_Click() Handles HintMigration.MouseLeftButtonUp
PageLaunchRight.StartMigration()
End Sub
End Class End Class
@@ -12,16 +12,18 @@
<ColumnDefinition Width="34" /> <ColumnDefinition Width="34" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<Grid.RowDefinitions> <Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="19" /> <RowDefinition Height="19" />
<RowDefinition Height="Auto" MinHeight="30" /> <RowDefinition Height="Auto" MinHeight="30" />
<RowDefinition Height="19" /> <RowDefinition Height="19" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<StackPanel Grid.Column="1" Grid.Row="1" VerticalAlignment="Center"> <local:MyHint Text="Mojang 账号现已无法进入正版服务器,请点击此处开始账号迁移!" Grid.ColumnSpan="3" Margin="0,0,0,15" x:Name="HintMigration" />
<StackPanel Grid.Column="1" Grid.Row="2" VerticalAlignment="Center">
<TextBlock Name="TextName" Text="加载中" Margin="8,0" FontSize="14" HorizontalAlignment="Center" TextTrimming="CharacterEllipsis" /> <TextBlock Name="TextName" Text="加载中" Margin="8,0" FontSize="14" HorizontalAlignment="Center" TextTrimming="CharacterEllipsis" />
<TextBlock Name="TextEmail" Text="加载中" Margin="8,4,8,0" FontSize="12" HorizontalAlignment="Center" TextTrimming="CharacterEllipsis" Foreground="{DynamicResource ColorBrushGray3}" /> <TextBlock Name="TextEmail" Text="加载中" Margin="8,4,8,0" FontSize="12" HorizontalAlignment="Center" TextTrimming="CharacterEllipsis" Foreground="{DynamicResource ColorBrushGray3}" />
</StackPanel> </StackPanel>
<local:MyIconButton ToolTip="更改密码" Grid.Row="1" Height="14" Opacity="0" x:Name="BtnEdit" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="32" ToolTipService.InitialShowDelay="50" ToolTipService.ShowDuration="1000000" Grid.Column="0" HorizontalAlignment="Center" Logo="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z" Margin="8,0,0,0" VerticalAlignment="Center" /> <local:MyIconButton ToolTip="更改密码" Grid.Row="2" Height="14" Opacity="0" x:Name="BtnEdit" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="32" ToolTipService.InitialShowDelay="50" ToolTipService.ShowDuration="1000000" Grid.Column="0" HorizontalAlignment="Center" Logo="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z" Margin="8,0,0,0" VerticalAlignment="Center" />
<local:MyIconButton ToolTip="退出登录" Grid.Row="1" Height="14" Opacity="0" x:Name="BtnExit" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="32" ToolTipService.InitialShowDelay="50" ToolTipService.ShowDuration="1000000" Grid.Column="2" HorizontalAlignment="Center" Logo="F1 M 51.0071,19.0027L 51.0071,27.0038L 48.0067,27.0038L 48.0067,22.0031L 25.0035,22.0031L 25.0035,54.0075L 48.0067,54.0075L 48.0067,49.0068L 51.0071,49.0068L 51.0071,57.008L 22.1698,57.008L 22.0031,19.0027L 51.0071,19.0027 Z M 30.0042,35.0049L 45.2563,35.0049L 37.005,28.0039L 47.0066,28.0039L 58.5082,38.0053L 47.0066,48.0067L 37.005,48.0067L 45.2563,41.0057L 30.0042,41.0057L 30.0042,35.0049 Z" Margin="0,0,8,0" VerticalAlignment="Center" /> <local:MyIconButton ToolTip="退出登录" Grid.Row="2" Height="14" Opacity="0" x:Name="BtnExit" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="32" ToolTipService.InitialShowDelay="50" ToolTipService.ShowDuration="1000000" Grid.Column="2" HorizontalAlignment="Center" Logo="F1 M 51.0071,19.0027L 51.0071,27.0038L 48.0067,27.0038L 48.0067,22.0031L 25.0035,22.0031L 25.0035,54.0075L 48.0067,54.0075L 48.0067,49.0068L 51.0071,49.0068L 51.0071,57.008L 22.1698,57.008L 22.0031,19.0027L 51.0071,19.0027 Z M 30.0042,35.0049L 45.2563,35.0049L 37.005,28.0039L 47.0066,28.0039L 58.5082,38.0053L 47.0066,48.0067L 37.005,48.0067L 45.2563,41.0057L 30.0042,41.0057L 30.0042,35.0049 Z" Margin="0,0,8,0" VerticalAlignment="Center" />
</Grid> </Grid>
<local:MySkin HorizontalAlignment="Center" VerticalAlignment="Top" x:Name="Skin" HasCape="False" /> <local:MySkin HorizontalAlignment="Center" VerticalAlignment="Top" x:Name="Skin" HasCape="False" />
</Grid> </Grid>
@@ -110,5 +110,8 @@
End Try End Try
End Sub, "Mojang Skin Upload") End Sub, "Mojang Skin Upload")
End Sub End Sub
Private Sub HintMigration_Click() Handles HintMigration.MouseLeftButtonUp
PageLaunchRight.StartMigration()
End Sub
End Class End Class
@@ -15,13 +15,7 @@
LogoScale="0.98" Logo="M149.883623 873.911618c47.094581 47.094581 101.765247 83.95121 162.783444 109.75085 63.065787 26.618676 130.226755 40.337532 199.230553 40.337532 69.003799 0 136.164767-13.514097 199.230554-40.337532 61.018196-25.79964 115.688862-62.656269 162.783444-109.75085s83.95121-101.765247 109.75085-162.783444c26.618676-63.065787 40.337532-130.226755 40.337532-199.230554 0-69.003799-13.514097-136.164767-40.337532-199.230553-25.79964-61.018196-62.656269-115.688862-109.75085-162.783444-46.889822-46.889822-101.765247-83.95121-162.783444-109.75085C648.062388 13.514097 580.90142 0 511.89762 0s-136.164767 13.514097-199.230553 40.337532c-61.018196 25.79964-115.688862 62.656269-162.783444 109.75085s-83.95121 101.765247-109.75085 162.783444C13.514097 375.732853 0 442.893821 0 511.89762s13.514097 136.164767 40.337532 199.230554c25.594881 61.018196 62.656269 115.688862 109.546091 162.783444zM97.670066 511.89762c0-228.511098 185.921216-414.227554 414.227554-414.227554 228.511098 0 414.227554 185.921216 414.227555 414.227554S740.408718 926.125175 511.89762 926.125175c-228.511098 0-414.227554-185.716457-414.227554-414.227555z M539.130574 244.277544c-8.190362-4.709458-17.609278-7.371326-27.232954-7.371325-9.623675 0-19.042591 2.457109-27.232953 7.371325-16.790242 9.623675-27.232953 27.847231-27.232953 47.299341 0 30.09958 24.366327 54.465907 54.465906 54.465906 30.09958 0 54.465907-24.366327 54.465907-54.465906 0-19.45211-10.442711-37.470906-27.232953-47.299341zM566.363527 732.218356v-284.615077c0-30.09958-24.366327-54.465907-54.465907-54.465906-30.09958 0-54.465907 24.366327-54.465906 54.465906v284.615077c0 30.09958 24.366327 54.465907 54.465906 54.465907 30.09958 0 54.465907-24.366327 54.465907-54.465907z" /> LogoScale="0.98" Logo="M149.883623 873.911618c47.094581 47.094581 101.765247 83.95121 162.783444 109.75085 63.065787 26.618676 130.226755 40.337532 199.230553 40.337532 69.003799 0 136.164767-13.514097 199.230554-40.337532 61.018196-25.79964 115.688862-62.656269 162.783444-109.75085s83.95121-101.765247 109.75085-162.783444c26.618676-63.065787 40.337532-130.226755 40.337532-199.230554 0-69.003799-13.514097-136.164767-40.337532-199.230553-25.79964-61.018196-62.656269-115.688862-109.75085-162.783444-46.889822-46.889822-101.765247-83.95121-162.783444-109.75085C648.062388 13.514097 580.90142 0 511.89762 0s-136.164767 13.514097-199.230553 40.337532c-61.018196 25.79964-115.688862 62.656269-162.783444 109.75085s-83.95121 101.765247-109.75085 162.783444C13.514097 375.732853 0 442.893821 0 511.89762s13.514097 136.164767 40.337532 199.230554c25.594881 61.018196 62.656269 115.688862 109.546091 162.783444zM97.670066 511.89762c0-228.511098 185.921216-414.227554 414.227554-414.227554 228.511098 0 414.227554 185.921216 414.227555 414.227554S740.408718 926.125175 511.89762 926.125175c-228.511098 0-414.227554-185.716457-414.227554-414.227555z M539.130574 244.277544c-8.190362-4.709458-17.609278-7.371326-27.232954-7.371325-9.623675 0-19.042591 2.457109-27.232953 7.371325-16.790242 9.623675-27.232953 27.847231-27.232953 47.299341 0 30.09958 24.366327 54.465907 54.465906 54.465906 30.09958 0 54.465907-24.366327 54.465907-54.465906 0-19.45211-10.442711-37.470906-27.232953-47.299341zM566.363527 732.218356v-284.615077c0-30.09958-24.366327-54.465907-54.465907-54.465906-30.09958 0-54.465907 24.366327-54.465906 54.465906v284.615077c0 30.09958 24.366327 54.465907 54.465906 54.465907 30.09958 0 54.465907-24.366327 54.465907-54.465907z" />
<local:MyListItem x:Name="ItemTest" IsScaleAnimationEnabled="False" Tag="2" PaddingRight="35" Type="RadioBox" Height="36" VerticalAlignment="Top" Title="百宝箱" <local:MyListItem x:Name="ItemTest" IsScaleAnimationEnabled="False" Tag="2" PaddingRight="35" Type="RadioBox" Height="36" VerticalAlignment="Top" Title="百宝箱"
LogoScale="0.97" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z" /> LogoScale="0.97" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z" />
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="3" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="反馈" <local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="Clickable" Tag="3" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="反馈"
LogoScale="0.9" Logo="M613.717333 64.426667l3.413334 3.242666 331.861333 331.861334a85.333333 85.333333 0 0 1 3.2 117.269333l-3.2 3.413333L573.162667 896H960a21.333333 21.333333 0 0 1 21.333333 21.333333v42.666667a21.333333 21.333333 0 0 1-21.333333 21.333333H64a21.333333 21.333333 0 0 1-21.333333-21.333333v-42.666667a21.333333 21.333333 0 0 1 21.333333-21.333333h295.338667L74.069333 610.709333a85.333333 85.333333 0 0 1-3.221333-117.269333l3.2-3.413333 422.4-422.357334a85.333333 85.333333 0 0 1 117.269333-3.221333z m-20.629333 99.882666l-21.418667 321.493334a85.333333 85.333333 0 0 1-74.944 79.04l-4.522666 0.426666-321.493334 21.44 295.552 295.530667 422.4-422.378667L593.066667 164.309333z m-86.442667 13.824L184.533333 500.266667l301.994667-20.117334 20.117333-301.994666z"> LogoScale="0.9" Logo="M613.717333 64.426667l3.413334 3.242666 331.861333 331.861334a85.333333 85.333333 0 0 1 3.2 117.269333l-3.2 3.413333L573.162667 896H960a21.333333 21.333333 0 0 1 21.333333 21.333333v42.666667a21.333333 21.333333 0 0 1-21.333333 21.333333H64a21.333333 21.333333 0 0 1-21.333333-21.333333v-42.666667a21.333333 21.333333 0 0 1 21.333333-21.333333h295.338667L74.069333 610.709333a85.333333 85.333333 0 0 1-3.221333-117.269333l3.2-3.413333 422.4-422.357334a85.333333 85.333333 0 0 1 117.269333-3.221333z m-20.629333 99.882666l-21.418667 321.493334a85.333333 85.333333 0 0 1-74.944 79.04l-4.522666 0.426666-321.493334 21.44 295.552 295.530667 422.4-422.378667L593.066667 164.309333z m-86.442667 13.824L184.533333 500.266667l301.994667-20.117334 20.117333-301.994666z" />
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="3" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.ShowDuration="2333333" ToolTipService.InitialShowDelay="200" Click="Refresh" LogoScale="0.85" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
</StackPanel> </StackPanel>
</local:MyPageLeft> </local:MyPageLeft>
@@ -6,7 +6,6 @@
'是否处于隐藏的子页面 '是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False Dim IsHiddenPage As Boolean = False
If ItemHelp.Checked AndAlso Setup.Get("UiHiddenOtherHelp") Then IsHiddenPage = True If ItemHelp.Checked AndAlso Setup.Get("UiHiddenOtherHelp") Then IsHiddenPage = True
If ItemFeedback.Checked AndAlso Setup.Get("UiHiddenOtherFeedback") Then IsHiddenPage = True
If ItemAbout.Checked AndAlso Setup.Get("UiHiddenOtherAbout") Then IsHiddenPage = True If ItemAbout.Checked AndAlso Setup.Get("UiHiddenOtherAbout") Then IsHiddenPage = True
If ItemTest.Checked AndAlso Setup.Get("UiHiddenOtherTest") Then IsHiddenPage = True If ItemTest.Checked AndAlso Setup.Get("UiHiddenOtherTest") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
@@ -21,10 +20,8 @@
ItemHelp.SetChecked(True, False, False) ItemHelp.SetChecked(True, False, False)
ElseIf Not Setup.Get("UiHiddenOtherAbout") Then ElseIf Not Setup.Get("UiHiddenOtherAbout") Then
ItemAbout.SetChecked(True, False, False) ItemAbout.SetChecked(True, False, False)
ElseIf Not Setup.Get("UiHiddenOtherTest") Then
ItemTest.SetChecked(True, False, False)
Else Else
ItemFeedback.SetChecked(True, False, False) ItemTest.SetChecked(True, False, False)
End If End If
End Sub End Sub
Private Sub PageOtherLeft_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded Private Sub PageOtherLeft_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded
@@ -44,17 +41,15 @@
PageID = FormMain.PageSubType.OtherHelp PageID = FormMain.PageSubType.OtherHelp
ElseIf Not Setup.Get("UiHiddenOtherAbout") Then ElseIf Not Setup.Get("UiHiddenOtherAbout") Then
PageID = FormMain.PageSubType.OtherAbout PageID = FormMain.PageSubType.OtherAbout
ElseIf Not Setup.Get("UiHiddenOtherTest") Then
PageID = FormMain.PageSubType.OtherTest
Else Else
PageID = FormMain.PageSubType.OtherFeedback PageID = FormMain.PageSubType.OtherTest
End If End If
End Sub End Sub
''' <summary> ''' <summary>
''' 勾选事件改变页面。 ''' 勾选事件改变页面。
''' </summary> ''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemAbout.Check, ItemHelp.Check, ItemFeedback.Check, ItemTest.Check Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemAbout.Check, ItemHelp.Check, ItemTest.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0 '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False) '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -66,9 +61,6 @@
Case FormMain.PageSubType.OtherHelp Case FormMain.PageSubType.OtherHelp
If FrmOtherHelp Is Nothing Then FrmOtherHelp = New PageOtherHelp If FrmOtherHelp Is Nothing Then FrmOtherHelp = New PageOtherHelp
Return FrmOtherHelp Return FrmOtherHelp
Case FormMain.PageSubType.OtherFeedback
If FrmOtherFeedback Is Nothing Then FrmOtherFeedback = New PageOtherFeedback
Return FrmOtherFeedback
Case FormMain.PageSubType.OtherAbout Case FormMain.PageSubType.OtherAbout
If FrmOtherAbout Is Nothing Then FrmOtherAbout = New PageOtherAbout If FrmOtherAbout Is Nothing Then FrmOtherAbout = New PageOtherAbout
Return FrmOtherAbout Return FrmOtherAbout
@@ -122,13 +114,6 @@
Select Case Val(sender.Tag) Select Case Val(sender.Tag)
Case FormMain.PageSubType.OtherHelp Case FormMain.PageSubType.OtherHelp
RefreshHelp() RefreshHelp()
Case FormMain.PageSubType.OtherFeedback
If FrmOtherFeedback IsNot Nothing Then
FrmOtherFeedback.PageLoaderRestart()
FrmOtherFeedback.SearchBox.Text = ""
Else
FeedbackLoader.Start()
End If
End Select End Select
End Sub End Sub
Public Shared Sub RefreshHelp() Public Shared Sub RefreshHelp()
@@ -137,4 +122,9 @@
FrmOtherHelp.SearchBox.Text = "" FrmOtherHelp.SearchBox.Text = ""
End Sub End Sub
'打开反馈
Public Shared Sub TryFeedback() Handles ItemFeedback.Click
If CanFeedback(True) Then Feedback(True, False)
End Sub
End Class End Class
@@ -162,8 +162,10 @@
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub
'要求输入显示名称 '要求输入显示名称
Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\") Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\")
Dim NewName As String = MyMsgBoxInput(If(SplitedNames.Last = ".minecraft", If(SplitedNames.Count >= 3, SplitedNames(SplitedNames.Count - 2), ""), SplitedNames.Last), New ObjectModel.Collection(Of Validate) From { Dim DefaultName As String = If(SplitedNames.Last = ".minecraft", If(SplitedNames.Count >= 3, SplitedNames(SplitedNames.Count - 2), ""), SplitedNames.Last)
New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"}) If DefaultName.Length > 40 Then DefaultName = DefaultName.Substring(0, 39)
Dim NewName As String = MyMsgBoxInput(DefaultName, New ObjectModel.Collection(Of Validate) From {
New ValidateNullOrWhiteSpace, New ValidateLength(1, 40), New ValidateExcept({">", "|"})
},, "输入显示名称",, "取消") },, "输入显示名称",, "取消")
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
'添加文件夹 '添加文件夹
@@ -223,7 +223,7 @@
<RowDefinition Height="28" /> <RowDefinition Height="28" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数" Margin="0,0,25,0" /> <TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xA;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" ToolTipService.ShowDuration="2333333" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true -Djava.net.preferIPv4Stack=true" /> <local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xA;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" ToolTipService.ShowDuration="2333333" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="额外参数" Margin="0,0,25,0" /> <TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="额外参数" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xA;例如输入 --demo 则会以试玩模式启动游戏。" ToolTipService.ShowDuration="2333333" /> <local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xA;例如输入 --demo 则会以试玩模式启动游戏。" ToolTipService.ShowDuration="2333333" />
</Grid> </Grid>
@@ -115,7 +115,7 @@
Try Try
'拷贝文件 '拷贝文件
File.Delete(PathTemp & "CustomSkin.png") File.Delete(PathTemp & "CustomSkin.png")
File.Copy(SkinInfo.LocalFile, PathTemp & "CustomSkin.png") CopyFile(SkinInfo.LocalFile, PathTemp & "CustomSkin.png")
'更新设置 '更新设置
Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim) Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim)
Catch ex As Exception Catch ex As Exception
@@ -138,7 +138,7 @@
End If End If
'拷贝文件 '拷贝文件
File.Delete(PathTemp & "CustomSkin.png") File.Delete(PathTemp & "CustomSkin.png")
File.Copy(SkinInfo.LocalFile, PathTemp & "CustomSkin.png") CopyFile(SkinInfo.LocalFile, PathTemp & "CustomSkin.png")
'更新设置 '更新设置
Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim) Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim)
Catch ex As Exception Catch ex As Exception
@@ -183,7 +183,7 @@
Dim Temp As String() Dim Temp As String()
Temp = Directory.GetFiles(Path) Temp = Directory.GetFiles(Path)
For Each str As String In Temp For Each str As String In Temp
If str = PathTemp & "CustomSkin.png" Then Continue For '不删除自定义皮肤 If str = PathTemp & "CustomSkin.png" OrElse str = PathTemp & "联机模块.exe" Then Continue For '不删除的文件
Try Try
Dim Info As New FileInfo(str) Dim Info As New FileInfo(str)
Dim FileActualSize = Math.Ceiling(Info.Length / 4096) * 4096 Dim FileActualSize = Math.Ceiling(Info.Length / 4096) * 4096
@@ -254,7 +254,7 @@
End If End If
File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png") File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png")
Directory.CreateDirectory(PageVersionLeft.Version.Path & "PCL") '虽然不知道为啥,有时候真没这文件夹 Directory.CreateDirectory(PageVersionLeft.Version.Path & "PCL") '虽然不知道为啥,有时候真没这文件夹
File.Copy(FileName, PageVersionLeft.Version.Path & "PCL\Logo.png") CopyFile(FileName, PageVersionLeft.Version.Path & "PCL\Logo.png")
Else Else
File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png") File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png")
End If End If
@@ -143,7 +143,7 @@
<local:MyComboBoxItem Content="仅正版登录" /> <local:MyComboBoxItem Content="仅正版登录" />
<local:MyComboBoxItem Content="仅离线登录" /> <local:MyComboBoxItem Content="仅离线登录" />
<local:MyComboBoxItem Content="第三方登录:统一通行证" /> <local:MyComboBoxItem Content="第三方登录:统一通行证" />
<local:MyComboBoxItem Content="第三方登录:Authlib Injector 或 Little Skin" /> <local:MyComboBoxItem Content="第三方登录:Authlib Injector 或 LittleSkin" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock Name="LabServerNide" Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="服务器 ID(必填)" Margin="0,8,25,0" Visibility="Collapsed" /> <TextBlock Name="LabServerNide" Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="服务器 ID(必填)" Margin="0,8,25,0" Visibility="Collapsed" />
<local:MyTextBox x:Name="TextServerNide" Grid.Row="1" Grid.ColumnSpan="2" ShowValidateResult="False" Tag="VersionServerNide" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="服主后台 → 集成说明 中提供的服务器 ID"> <local:MyTextBox x:Name="TextServerNide" Grid.Row="1" Grid.ColumnSpan="2" ShowValidateResult="False" Tag="VersionServerNide" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="服主后台 → 集成说明 中提供的服务器 ID">
@@ -186,7 +186,7 @@
<local:MyButton x:Name="BtnServerNideWeb" Grid.Column="0" MinWidth="140" Text="服主后台" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" /> <local:MyButton x:Name="BtnServerNideWeb" Grid.Column="0" MinWidth="140" Text="服主后台" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnServerNideBbs" Grid.Column="1" MinWidth="140" Text="查看简介" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnServerNideBbs" Grid.Column="1" MinWidth="140" Text="查看简介" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid> </Grid>
<local:MyButton x:Name="BtnServerAuthLittle" Height="35" MinWidth="150" Margin="0,12,0,0" Text="设置为 Little Skin" HorizontalAlignment="Left" ColorType="Highlight" /> <local:MyButton x:Name="BtnServerAuthLittle" Height="35" MinWidth="150" Margin="0,12,0,0" Text="设置为 LittleSkin" HorizontalAlignment="Left" ColorType="Highlight" />
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
@@ -385,11 +385,12 @@ PreFin:
OpenWebsite("https://www.mcbbs.net/thread-729821-1-1.html") OpenWebsite("https://www.mcbbs.net/thread-729821-1-1.html")
End Sub End Sub
'Little Skin 'LittleSkin
Private Sub BtnServerAuthLittle_Click(sender As Object, e As EventArgs) Handles BtnServerAuthLittle.Click Private Sub BtnServerAuthLittle_Click(sender As Object, e As EventArgs) Handles BtnServerAuthLittle.Click
If MyMsgBox("即将把第三方登录设置覆盖为自动使用 LittleSkin 登录,是否继续?", "覆盖确认", "确定", "取消") = 2 Then Exit Sub
TextServerAuthServer.Text = "https://littleskin.cn/api/yggdrasil" TextServerAuthServer.Text = "https://littleskin.cn/api/yggdrasil"
TextServerAuthRegister.Text = "https://littleskin.cn/auth/register" TextServerAuthRegister.Text = "https://littleskin.cn/auth/register"
TextServerAuthName.Text = "Little Skin 登录" TextServerAuthName.Text = "LittleSkin 登录"
End Sub End Sub
#End Region #End Region
@@ -300,9 +300,6 @@
<Compile Include="Pages\PageDownload\PageDownloadOptiFine.xaml.vb"> <Compile Include="Pages\PageDownload\PageDownloadOptiFine.xaml.vb">
<DependentUpon>PageDownloadOptiFine.xaml</DependentUpon> <DependentUpon>PageDownloadOptiFine.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageOther\PageOtherFeedback.xaml.vb">
<DependentUpon>PageOtherFeedback.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageOther\PageOtherTest.xaml.vb"> <Compile Include="Pages\PageOther\PageOtherTest.xaml.vb">
<DependentUpon>PageOtherTest.xaml</DependentUpon> <DependentUpon>PageOtherTest.xaml</DependentUpon>
</Compile> </Compile>
@@ -552,10 +549,6 @@
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageOther\PageOtherFeedback.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageOther\PageOtherTest.xaml"> <Page Include="Pages\PageOther\PageOtherTest.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
@@ -793,22 +786,22 @@
<ItemGroup> <ItemGroup>
<PublishFile Include="NAudio"> <PublishFile Include="NAudio">
<Visible>False</Visible> <Visible>False</Visible>
<PublishState>Exclude</PublishState>
<IncludeHash>True</IncludeHash>
<Group> <Group>
</Group> </Group>
<TargetPath> <TargetPath>
</TargetPath> </TargetPath>
<PublishState>Exclude</PublishState>
<IncludeHash>True</IncludeHash>
<FileType>Assembly</FileType> <FileType>Assembly</FileType>
</PublishFile> </PublishFile>
<PublishFile Include="Newtonsoft.Json"> <PublishFile Include="Newtonsoft.Json">
<Visible>False</Visible> <Visible>False</Visible>
<PublishState>Exclude</PublishState>
<IncludeHash>True</IncludeHash>
<Group> <Group>
</Group> </Group>
<TargetPath> <TargetPath>
</TargetPath> </TargetPath>
<PublishState>Exclude</PublishState>
<IncludeHash>True</IncludeHash>
<FileType>Assembly</FileType> <FileType>Assembly</FileType>
</PublishFile> </PublishFile>
</ItemGroup> </ItemGroup>
@@ -905,5 +898,8 @@
<ItemGroup> <ItemGroup>
<Resource Include="Images\Blocks\OptiFabric.png" /> <Resource Include="Images\Blocks\OptiFabric.png" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<None Include="Resources\java-wrapper.jar" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.