Compare commits

...
9 Commits
Author SHA1 Message Date
龙腾猫跃 5fb5a3b963 2.4.3 2022-11-26 22:39:08 +08:00
龙腾猫跃 5ef1d60e2e 由于联机已被禁用,公开联机部分代码 2022-11-10 20:22:47 +08:00
龙腾猫跃 d091e153a9 删除联机的反馈选项 2022-11-08 19:57:28 +08:00
龙腾猫跃 97c5367108 2.4.2 2022-11-08 19:17:11 +08:00
龙腾猫跃 24cb4599d6 删除联机入口 2022-11-05 21:27:44 +08:00
龙腾猫跃 ef32179598 2.4.1 2022-11-03 22:29:41 +08:00
龙腾猫跃 e9b34ad998 再次更新 licence 2022-10-31 12:03:27 +08:00
龙腾猫跃 2d9a4d9391 Merge pull request #299 from Silverteal/patch-1
Update licence.txt
2022-10-31 11:50:07 +08:00
Silverteal 89f6059ea8 Update licence.txt 2022-10-29 20:39:08 +08:00
63 changed files with 6846 additions and 450 deletions

No files matched your search

-3
View File
@@ -3,9 +3,6 @@ contact_links:
- name: 帮助文档反馈
url: https://github.com/LTCatt/PCL2Help/issues
about: 提交 PCL2 帮助系统(更多 → 帮助)相关的反馈
- name: 联机反馈与交流
url: https://shimowendang.com/docs/KrkEVXz1K0frowAJ#anchor-7qQG
about: 加入联机模块官方 QQ 群反馈联机异常,或询问联机功能的使用方式
- name: 提问
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE
about: 我不想提交反馈,只是想问一些问题
-3
View File
@@ -349,9 +349,6 @@ ModSetup.vb
PageOtherAbout.*
PageOtherTest.*
PageSetupUI.*
# 公开联机代码可能导致安全风险
Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb
Plain Craft Launcher 2/Pages/PageLink/PageLinkHiPer.xaml.vb
# 开发者工具
ModDevelop.vb
# 不公开底层函数库,以免抄袭
+15
View File
@@ -0,0 +1,15 @@
本文件不是法律文件或开源协议。
龙腾猫跃(下文简称为龙猫)承诺在您遵守本文件指引的情况下,不会追究您的法律责任,但裁量您 “是否遵守本文件指引” 的最终权利由龙猫保留。
1、本存储库中的内容以帮助公共研究为目的而公开。
2、在没有附加许可的情况下,龙猫仍然对本存储库的内容保留所有权利,故以下所有允许性表述均无法作出永久性保证。
3、不允许以本存储库的内容作为内容主体创建、发布、传播其衍生作品,且您不可以发布本存储库及其相关作品的修改版。
4、在满足第 3 款,且在可见位置标注内容来源(即本存储库链接)的前提下,您可以使用或引用本存储库的小部分内容或是其实现思路。
5、龙猫可能随时修改本文件,且可能不会提前通知。本文件不是法律文件或开源协议,故本文件的修改不构成与您法律关系的改变。
——————
说人话就是,随便你参考这堆代码的思路,乃至复制一两个函数什么的也可以,别太过火就行,顺便记得声明一下这段是从这里来的。
不过,你不能把它们直接复制下来然后再小修小补,就说这是你自己的东西。也不能把其中一小部分单独抠出来说是你自己的东西。
没有法律顾问,所以这只是明确说明一下,你可以借鉴其中的小部分内容,我也不会且懒得因此找你麻烦。
如果有专业人士愿意帮帮忙把这堆东西写得专业一点我也很乐意……
@@ -15,7 +15,6 @@ Public Class Application
Log(ex, "开发者模式测试出错", LogLevel.Feedback)
End Try
End Sub
#End If
'开始
@@ -1,7 +1,7 @@
Public Class MyButton
'声明
Public Event Click(sender As Object, e As EventArgs) '自定义事件
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
+11 -3
View File
@@ -287,9 +287,9 @@
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
Control.IsHitTestVisible = False
AniStart({
If Control.IsHitTestVisible Then
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
@@ -302,5 +302,13 @@ Partial Public Module ModAnimation
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
Else
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End If
End Sub
End Module
@@ -15,9 +15,9 @@
<my:MyTextBox x:Name="TextCaption" UseLayoutRounding="False" MaxLength="1000" Width="450" Margin="1" />
</Border>
<StackPanel Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,22,20" Orientation="Horizontal">
<my:MyButton ColorType="Normal" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮3" x:Name="Btn3" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮3" x:Name="Btn3" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
</StackPanel>
</StackPanel>
</Grid>
@@ -109,13 +109,13 @@
MyConverter.Result = TextCaption.Text
Close()
End Sub
Private Sub Btn2_Click() Handles Btn2.Click
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
End Sub
Private Sub Btn3_Click() Handles Btn3.Click
Public Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
@@ -20,8 +20,8 @@
<StackPanel x:Name="PanSelection" Orientation="Vertical" />
</my:MyScrollViewer>
<StackPanel Name="PanBtn" Grid.Row="3" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,22,20" Orientation="Horizontal">
<my:MyButton ColorType="Normal" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" IsEnabled="False" />
<my:MyButton ColorType="Normal" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮3" x:Name="Btn3" TextPadding="7" Margin="15,0,0,0" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" IsEnabled="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮3" x:Name="Btn3" TextPadding="7" Margin="15,0,0,0" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
</StackPanel>
</Grid>
@@ -112,13 +112,13 @@
MyConverter.Result = SelectedIndex
Close()
End Sub
Private Sub Btn2_Click() Handles Btn2.Click
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
End Sub
Private Sub Btn3_Click() Handles Btn3.Click
Public Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = Nothing
@@ -20,8 +20,8 @@
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer>
<StackPanel Name="PanBtn" Grid.Row="3" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,22,20" Orientation="Horizontal">
<my:MyButton ColorType="Normal" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" Text="测试按钮3" x:Name="Btn3" TextPadding="7" Margin="15,0,0,0" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮1" x:Name="Btn1" Margin="15,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮2" x:Name="Btn2" Margin="15,0,0,0" TextPadding="7" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="测试按钮3" x:Name="Btn3" TextPadding="7" Margin="15,0,0,0" Visibility="Visible" SnapsToDevicePixels="False" Padding="5,0" Opacity="0" UseLayoutRounding="False" />
</StackPanel>
</Grid>
@@ -104,13 +104,13 @@
MyConverter.Result = 1
Close()
End Sub
Private Sub Btn2_Click() Handles Btn2.Click
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 2
Close()
End Sub
Private Sub Btn3_Click() Handles Btn3.Click
Public Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 3
@@ -137,12 +137,16 @@
'点击事件
Public Event PreviewClick(sender As Object, e As RouteEventArgs)
Private IsMouseDown As Boolean = False
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Checked Then Exit Sub
If Not IsMouseDown Then Exit Sub
Log("[Control] 按下单选按钮:" & Text)
IsMouseDown = False
Dim e As New RouteEventArgs(True)
RaiseEvent PreviewClick(Me, e)
If e.Handled Then Exit Sub
SetChecked(True, True, True)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
+61 -7
View File
@@ -10,6 +10,22 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 270 Then 'Release 2.4.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
FeatureCount += 6
BugCount += 15
End If
If LastVersion < 268 Then 'Release 2.4.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
FeatureCount += 14
BugCount += 33
End If
If LastVersion < 265 Then 'Release 2.3.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
@@ -90,8 +106,26 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 271 Then 'Snapshot 2.4.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
FeatureCount += 6
BugCount += 15
End If
If LastVersion < 269 Then 'Snapshot 2.4.2
If LastVersion = 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法下载 CurseForge 整合包的 Bug"))
FeatureCount += 2
BugCount += 3
End If
If LastVersion < 267 Then 'Snapshot 2.4.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
FeatureCount += 12
BugCount += 22
End If
If LastVersion < 266 Then 'Snapshot 2.4.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "追加新的联机方式(HiPer 联机模块)"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
FeatureCount += 3
@@ -575,11 +609,25 @@ Reopen:
'按键事件
Private Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.IsRepeat Then Exit Sub
'调用弹窗回车
If e.Key = Key.Enter AndAlso PanMsg.Children.Count > 0 Then
CType(PanMsg.Children(0), Object).Btn1_Click()
Exit Sub
'调用弹窗:回车选择第一个,Esc 选择最后一个
If PanMsg.Children.Count > 0 Then
If e.Key = Key.Enter Then
CType(PanMsg.Children(0), Object).Btn1_Click()
Exit Sub
ElseIf e.Key = Key.Escape Then
Dim Msg As Object = PanMsg.Children(0)
If Msg.Btn3.Visibility = Visibility.Visible Then
Msg.Btn3_Click()
ElseIf Msg.Btn2.Visibility = Visibility.Visible Then
Msg.Btn2_Click()
Else
Msg.Btn1_Click()
End If
Exit Sub
End If
End If
'按 ESC 返回上一级
If e.Key = Key.Escape Then TriggerPageBack()
'更改隐藏版本可见性
If e.Key = Key.F11 AndAlso PageCurrent = FormMain.PageType.VersionSelect Then
FrmSelectRight.ShowHidden = Not FrmSelectRight.ShowHidden
@@ -607,8 +655,6 @@ Reopen:
End If
'修复按下 Alt 后误认为弹出系统菜单导致的冻结
If e.SystemKey = Key.LeftAlt OrElse e.SystemKey = Key.RightAlt Then e.Handled = True
'按 ESC 返回上一级
If e.Key = Key.Escape Then TriggerPageBack()
End Sub
Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown
'鼠标侧键返回上一级
@@ -1098,6 +1144,14 @@ Install:
If IsChangingPage Then Exit Sub
PageChangeActual(Val(sender.Tag))
End Sub
Private Sub CancelLink(sender As Object, e As RouteEventArgs) Handles BtnTitleSelect2.PreviewClick
If MyMsgBox("由于联机提供商要求新联机强制付费,且高度商业化,PCL 将暂时关闭联机功能,不再使用该联机模块。" & vbCrLf &
"PCL、HMCL、BakaXL 将合作开发新的跨启动器联机功能,在开发结束后将同步开放,请各位多多理解。",
"联机功能已暂时关闭", "查看详情", "确定") = 1 Then
OpenWebsite("https://www.bilibili.com/read/cv19845645")
End If
e.Handled = True
End Sub
''' <summary>
''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary>
Binary file not shown.

Before

Width:  |  Height:  |  Size: 434 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.1 KiB

After

Width:  |  Height:  |  Size: 999 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 912 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 1001 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 861 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 958 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 988 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 947 B

@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.4.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.0." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.4.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.3." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 265 'Release
Public Const VersionCode As Integer = 270 'Release
#Else
Public Const VersionCode As Integer = 266 'Snapshot
Public Const VersionCode As Integer = 271 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -771,6 +771,8 @@ Public Module ModBase
'还原文件路径
If Not FromPath.Contains(":\") Then FromPath = Path & FromPath
If Not ToPath.Contains(":\") Then ToPath = Path & ToPath
'如果复制同一个文件则跳过
If FromPath = ToPath Then Exit Sub
'读取文件内容
Dim FileBytes As Byte()
Using ReadStream As New FileStream(FromPath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
@@ -1236,7 +1238,7 @@ Re:
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWith(".zip") OrElse CompressFilePath.EndsWith(".jar") Then
'以 zip 方式解压
ZipFile.ExtractToDirectory(CompressFilePath, DestDirectory, If(Encode, Encoding.Default))
ZipFile.ExtractToDirectory(CompressFilePath, DestDirectory, If(Encode, Encoding.GetEncoding("GB18030")))
Return True
ElseIf CompressFilePath.EndsWith(".gz") Then
'以 gz 方式解压
@@ -2301,7 +2303,7 @@ Retry:
RunInNewThread(Sub()
Dim IsInitSuccess As Boolean = True
Try
For i = 4 To 1
For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
@@ -96,7 +96,9 @@ Retry:
''' </summary>
''' <param name="Url">网页的 Url。</param>
''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
''' <param name="BackupUrl">如果第一次尝试失败,换用的备用 URL。</param>
Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "",
Optional IsJson As Boolean = False, Optional BackupUrl As String = Nothing)
Dim RetryCount As Integer = 0
Dim RetryException As Exception = Nothing
Dim StartTime As Long = GetTimeTick()
@@ -107,12 +109,12 @@ Retry:
Return NetGetCodeRequest(Url, Encode, 10000, IsJson, Accept)
Case 1 '慢速重试
Thread.Sleep(500)
Return NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept)
Return NetGetCodeRequest(If(BackupUrl, Url), Encode, 30000, IsJson, Accept)
Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上,才进行重试
Thread.Sleep(500)
Return NetGetCodeRequest(Url, Encode, 4000, IsJson, Accept)
Return NetGetCodeRequest(If(BackupUrl, Url), Encode, 4000, IsJson, Accept)
Else
Throw RetryException
End If
@@ -458,7 +458,9 @@ Done:
If LogMc.Contains("Cannot read field ""ofTelemetry"" because ""net.optifine.Config.gameSettings"" is null") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9)
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("java.lang.ClassNotFoundException: jdk.nashorn.api.scripting.NashornScriptEngineFactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("java.lang.ClassNotFoundException: java.lang.invoke.LambdaMetafactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("The directories below appear to be extracted jar files. Fix this before you continue.") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压)
@@ -468,7 +470,7 @@ Done:
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, If(RegexSeek(LogMc, "(?<=the game will display an error screen and halt[\s\S]+?Exception: )[\s\S]+?(?=\n\tat)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\t - [^\n]+\n)+"), ""), "(?<=\t)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
If LogMc.Contains("Could not reserve enough space") Then
@@ -773,7 +775,7 @@ Redo:
Case CrashReason.使用JDK
ResultString = "游戏似乎因为使用 JDK,或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。"
Case CrashReason.Java版本过高
ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。"
ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用较低版本的 Java,然后再启动游戏。\n如果没有,可以从网络中下载、安装一个。"
Case CrashReason.使用32位Java导致JVM无法分配足够多的内存
If Environment.Is64BitOperatingSystem Then
ResultString = "你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。"
@@ -221,6 +221,7 @@
McDownloadClientUpdateHint(Version, Json)
IsNewClientVersionHinted = True
End If
McVersionHighest = Version.Split(".")(1)
Setup.Set("ToolUpdateReleaseLast", Version)
'解析更新提示(Snapshot)
Version = Json("latest")("snapshot")
@@ -237,7 +238,9 @@
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True)
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json",
BackupUrl:="https://download.mcbbs.net/mc/game/version_manifest.json",
IsJson:=True)
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
@@ -331,6 +334,10 @@
''' 发布时间,格式为“yyyy/mm/dd”。OptiFine 源无此数据。
''' </summary>
Public ReleaseTime As String
''' <summary>
''' 需要的最低 Forge 版本。空字符串为无限制,“28.1.56” 表示版本号,“1161” 表示版本号的最后一位。
''' </summary>
Public RequiredForgeVersion As String
End Class
''' <summary>
@@ -365,21 +372,23 @@
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=Date'>)[^<]+")
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).ToString.Replace("HD U ", "").Replace(".0 ", " "),
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ToString.ToLower.Contains("pre"),
.IsPreview = Name(i).ToLower.Contains("pre"),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ToString.ToLower.Contains("pre"), "preview_", "") &
"OptiFine_" & Name(i).ToString.Replace(" ", "_") & ".jar"}
.NameFile = If(Name(i).ToLower.Contains("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
@@ -391,7 +400,8 @@
''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList",
BackupUrl:="https://download.mcbbs.net/optifine/versionList", IsJson:=True)
Try
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
@@ -400,7 +410,8 @@
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ToLower.Contains("pre"),
.Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
}
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
@@ -473,7 +484,8 @@
''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default)
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default,
BackupUrl:="https://download.mcbbs.net/forge/minecraft")
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
@@ -642,11 +654,14 @@
VersionCode = VersionCode.Substring(VersionCode.IndexOf("universal.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "universal"
Else
ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip,支持范围 182~ (1.3.2 部分 ~)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("client.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "client"
Else
'没有任何下载(1.6.4 有一部分这种情况)
Continue For
End If
'添加进列表
Versions.Add(New DlForgeVersionEntry With {.Category = Category, .Version = Name, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch})
@@ -665,7 +680,8 @@
''' Forge 版本列表,BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input,
BackupUrl:="https://download.mcbbs.net/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -757,7 +773,7 @@
''' </summary>
Public IsLegacy As Boolean
''' <summary>
''' 发布时间,格式为“yyyy/mm/dd HH:mm:ss”。
''' 发布时间,格式为“yyyy/mm/dd HH:mm”。
''' </summary>
Public ReleaseTime As String
''' <summary>
@@ -812,7 +828,7 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm:ss"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.JsonToken = RealEntry
})
Next
@@ -827,7 +843,8 @@
''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json",
BackupUrl:="https://download.mcbbs.net/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -840,7 +857,7 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm:ss"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.JsonToken = RealEntry
})
Next
@@ -913,7 +930,8 @@
''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions",
BackupUrl:="https://download.mcbbs.net/fabric-meta/v2/versions", IsJson:=True)
Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -939,7 +957,7 @@
#Region "DlCfProject | CurseForge 工程"
Private DlCfProjectDb As Dictionary(Of String, String) = Nothing
Private DlCfProjectDb As Dictionary(Of String, DlCfDbEntry) = Nothing
Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject)
''' <summary>
@@ -988,7 +1006,6 @@
Public Id As Integer
Public Name As String
Public McWikiId As Integer = 0
Public Description As String
Public Website As String
Public DateUpdate As Date
@@ -1000,22 +1017,19 @@
Public IsModPack As Boolean
Public FileIndexes As New List(Of Integer)
Public Files As List(Of DlCfFile)
Private _MCBBS As String
Public Property MCBBS As String
Private _MCBBS As Integer?
Public Property MCBBS As Integer?
Get
ReleaseCfDatabase()
If _MCBBS Is Nothing Then
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
Dim Result As String() = DlCfProjectDb(Keyword).ToString.Split("|")
If Result.Length = 3 Then _MCBBS = Result.Last
End If
If DlCfProjectDb.ContainsKey(Keyword) Then _MCBBS = DlCfProjectDb(Keyword).MCBBS
End If
End If
Return _MCBBS
End Get
Set(value As String)
Set(value As Integer?)
_MCBBS = value
End Set
End Property
@@ -1028,20 +1042,42 @@
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
Dim Result As String = DlCfProjectDb(Keyword)
McWikiId = Result.Split("|")(0)
If Not Result.Split("|")(1) = "~" Then '使用原名
_ChineseName = Result.Split("|")(1)
Dim Result = DlCfProjectDb(Keyword)
If Not String.IsNullOrEmpty(Result.ChineseName) Then '使用原名
_ChineseName = Result.ChineseName
End If
End If
End If
End If
Return _ChineseName
End Get
Set(ByVal value As String)
Set(value As String)
_ChineseName = value
End Set
End Property
Private _WikiId As Integer = -1
''' <summary>
''' MCMOD 的页面 ID。若为 0 则代表没有对应页面。
''' </summary>
Public Property WikiId As Integer
Get
ReleaseCfDatabase()
If _WikiId = -1 Then
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
_WikiId = DlCfProjectDb(Keyword).WikiId
Else
_WikiId = 0
End If
End If
End If
Return _WikiId
End Get
Set(value As Integer)
_WikiId = value
End Set
End Property
''' <summary>
''' 从 CurseForge 工程 Json 项中初始化实例。若出错会抛出异常。
@@ -1055,33 +1091,27 @@
DateUpdate = Data("dateModified")
DownloadCount = Data("downloadCount")
IsModPack = Not Website.Contains("/mc-mods/")
'获取常见文件
'获取 Mod Loader 列表
ModLoaders = New List(Of String)
For Each File In If(Data("latestFiles"), {})
Dim NewFile As New DlCfFile(File, IsModPack)
If Not NewFile.IsAvailable Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Next
'获取游戏版本、Mod Loader
ModLoaders = ModLoaders.Distinct.ToList
'用一个偷懒的方式让 Forge 排在 Fabric 的前面
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Forge", "Aorge")).ToList()
ModLoaders.Sort()
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Aorge", "Forge")).ToList()
'获取游戏版本
Dim GameVersions As New List(Of Integer)
ModLoaders = New List(Of String)
For Each File In If(Data("latestFilesIndexes"), {})
Dim Version As String = File("gameVersion")
If Not Version.Contains("1.") Then Continue For
GameVersions.Add(Version.Split(".")(1).Split("-").First)
Select Case If(File("modLoader"), "0").ToString
Case 1
ModLoaders.Add("Forge")
Case 2
ModLoaders.Add("Cauldron")
Case 3
ModLoaders.Add("LiteLoader")
Case 4
ModLoaders.Add("Fabric")
End Select
FileIndexes.Add(File("fileId"))
Next
GameVersions = Sort(GameVersions.Distinct.ToList, AddressOf VersionSortBoolean)
ModLoaders = ModLoaders.Distinct.ToList
ModLoaders.Sort()
If GameVersions.Count = 0 Then
GameVersionDesc = ""
Else
@@ -1098,8 +1128,15 @@
Next
If StartVersion = EndVersion Then
SpaVersions.Add("1." & StartVersion)
ElseIf StartVersion >= McVersionHighest Then
SpaVersions.Add("1." & EndVersion & "+")
ElseIf EndVersion <= 7 Then
SpaVersions.Add("1." & StartVersion & "-")
Exit For
ElseIf StartVersion - EndVersion = 1 Then
SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion)
Else
SpaVersions.Add("1." & StartVersion & "-1." & EndVersion)
SpaVersions.Add("1." & StartVersion & "~1." & EndVersion)
End If
Next
GameVersionDesc = "[" & Join(SpaVersions, ", ") & "] "
@@ -1176,11 +1213,11 @@
Dim NewItem As New MyCfItem With {.Tag = Me}
NewItem.LabTitle.Text = ChineseName
NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "")
NewItem.LabLeft.Text = If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders, " & ") & "] ", "") &
If(ShowVersionDesc, GameVersionDesc, "") &
NewItem.LabLeft.Text = (If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders, "/") & "] ", "") &
If(ShowVersionDesc, GameVersionDesc, "")).Replace("] [", " ") &
Join(CategoryDesc, ",") & " (" &
GetTimeSpanString(DateUpdate - Date.Now) & "更新" &
If(DownloadCount > 0, "," & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载)", DownloadCount & " 次下载)"), "")
GetTimeSpanString(DateUpdate - Date.Now) & "更新," &
If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载", DownloadCount & " 次下载") & ")"
If Thumb Is Nothing Then
NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png"
Else
@@ -1217,8 +1254,9 @@
''' CurseForge 工程列表获取事件。
''' </summary>
Public Sub DlCfProjectSub(Task As LoaderTask(Of DlCfProjectRequest, DlCfProjectResult))
Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim.ToLower
Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim
Task.Input.SearchFilter = RawFilter
RawFilter = RawFilter.ToLower
Log("[Download] CurseForge 工程列表搜索原始文本:" & RawFilter)
'中文请求关键字处理
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]")
@@ -1227,12 +1265,12 @@
ReleaseCfDatabase()
'构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of String))
For Each Entry In DlCfProjectDb
If Entry.Value.ToString.Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
For Each Entry In DlCfProjectDb.Values
If If(Entry.ChineseName, "").Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
SearchEntries.Add(New SearchEntry(Of String) With {
.Item = Entry.Value.ToString.Split("|")(1),
.Item = Entry.ChineseName,
.SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(Entry.Value.ToString.Replace(" (", "|").Split("|")(1), 1)
New KeyValuePair(Of String, Double)(Entry.ChineseName & Entry.CurseForgeId, 1)
}
})
Next
@@ -1242,7 +1280,7 @@
Dim SearchResult As String = ""
For i = 0 To SearchResults.Count - 1
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
SearchResult += SearchResults(i).Item.Replace(" (", "|").Split("|").Last.TrimEnd(")") & " "
SearchResult += SearchResults(i).Item.Replace(" - ", "§").Split("§").First.Replace(" (", "|").Split("|").Last.TrimEnd(")") & " "
Next
Log("[Download] CurseForge 工程列表中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
'去除常见连接词
@@ -1258,12 +1296,12 @@
'驼峰英文请求关键字处理
Dim SpacedKeywords = RegexReplace(Task.Input.SearchFilter, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)")
Dim ConnectedKeywords = Task.Input.SearchFilter.Replace(" ", "")
Dim AllPossibleKeywords = SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchFilter, ConnectedKeywords & " " & RawFilter)
Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchFilter, ConnectedKeywords & " " & RawFilter)).ToLower
'最终处理关键字:分割、去重
Dim RightKeywords As New List(Of String)
For Each Keyword In AllPossibleKeywords.Split(" ")
If Keyword.Trim = "" Then Continue For
If Keyword = "forge" OrElse Keyword = "fabric" OrElse Keyword = "for" Then 'https://github.com/Hex-Dragon/PCL2/issues/208
If Keyword = "forge" OrElse Keyword = "fabric" OrElse Keyword = "for" OrElse Keyword = "mod" Then 'https://github.com/Hex-Dragon/PCL2/issues/208
Log("[Download] 已跳过搜索关键词 " & Keyword, LogLevel.Developer)
Continue For
End If
@@ -1342,16 +1380,42 @@
''' </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))) & ")")
DlCfProjectDb = New Dictionary(Of String, DlCfDbEntry)
For Each Line In DecodeBytes(GetResources("ModData")).Split(vbLf)
Dim Entry = New DlCfDbEntry
Dim SplitedLine = Line.Split("|")
Entry.CurseForgeId = SplitedLine(0)
Entry.WikiId = SplitedLine(1)
Entry.ChineseName = SplitedLine(2)
Entry.MCBBS = If(SplitedLine.Count = 4, SplitedLine(3), Nothing)
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*", " (" &
String.Join(" ", Entry.CurseForgeId.Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
End If
DlCfProjectDb.Add(Entry.Key, Result)
DlCfProjectDb.Add(Entry.CurseForgeId, Entry)
Next
End Sub
Public Class DlCfDbEntry
''' <summary>
''' McMod 的 ID。
''' </summary>
Public WikiId As Integer
''' <summary>
''' 中文译名。若为 Nothing 或空字符串则使用英文名。
''' </summary>
Public ChineseName As String
''' <summary>
''' MCBBS 发布帖编号(例如 195107)。若为 Nothing 则没有发布帖。
''' </summary>
Public MCBBS As Integer?
''' <summary>
''' CurseForge ID(例如 advanced-solar-panels)。
''' </summary>
Public CurseForgeId As String
Public Overrides Function ToString() As String
Return CurseForgeId & "|" & WikiId & "|" & ChineseName & If(MCBBS Is Nothing, "", "|" & MCBBS)
End Function
End Class
#End Region
@@ -1369,6 +1433,7 @@
Public DisplayName As String
Public [Date] As Date
Public GameVersion As String()
Public ModLoaders As New List(Of String)
Public ReleaseType As Integer
Public FileName As String
Public DownloadCount As Integer
@@ -1418,11 +1483,13 @@
End If
Next
End If
'获取游戏版本
'获取游戏版本与 Mod 加载器列表
Dim Versions As New List(Of String)
For Each Version In Data("gameVersions")
If Version.ToString.StartsWith("1.") OrElse Version.ToString.Contains("w") Then
Versions.Add(Version.ToString.Trim.ToLower)
For Each Version In Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower)
If Version.StartsWith("1.") OrElse Version.Contains("w") Then
Versions.Add(Version)
ElseIf Version = "forge" OrElse Version = "fabric" OrElse Version = "quilt" OrElse Version = "rift" Then
ModLoaders.Add(Version.First.ToString.ToUpper & Version.Substring(1))
End If
Next
If Versions.Count > 1 Then
@@ -1430,11 +1497,13 @@
If IsModPack Then GameVersion = {GameVersion(0)}
ElseIf Versions.Count = 1 Then
GameVersion = Versions.ToArray
'ElseIf Data("gameVersion").Count = 1 AndAlso Not Data("gameVersion")(0).ToString.Contains("1.") Then
' GameVersion = {"1.16.4"}
Else
GameVersion = {"未知版本"}
End If
'用一个偷懒的方式让 Forge 排在 Fabric 的前面
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Forge", "Aorge")).ToList()
ModLoaders.Sort()
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Aorge", "Forge")).ToList()
End Sub
''' <summary>
@@ -1450,10 +1519,14 @@
'获取描述信息
Dim Info As String = ""
If Not IsModPack Then
Info += "适用于 " & Join(GameVersion, "、").Replace("-snapshot", " 快照") &
If(ModeDebug AndAlso Dependencies.Count > 0, "," & Dependencies.Count & " 个前置,", ",")
Info += If(ModLoaders.Count > 0, Join(ModLoaders, "/"), "") &
If(GameVersion.Count > 1, If(ModLoaders.Count > 0, " ", "") & Join(GameVersion, "、").Replace("-snapshot", " 快照"), "")
If Info <> "" Then Info = "适用于 " & Info & ","
Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "")
End If
Info += If(DownloadCount > 0, If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,"), "")
'If DownloadCount > 0 Then 'DownloadCount 目前的返回内容完全不正确,经常是 0,干脆不显示了
' Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,")
'End If
Info += GetTimeSpanString([Date] - Date.Now) & "更新"
Info += If(ReleaseType <> 1, "," & ReleaseTypeString, "")
@@ -56,6 +56,7 @@ Public Module ModLaunch
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader
LaunchLoader.Start()
@@ -378,7 +379,7 @@ NextInner:
Return LoginData
End Function
Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
McLaunchLog("登录线程已启动")
McLaunchLog("登录加载已开始")
'校验登录信息
Dim CheckResult As String = McLoginAble(Data.Input)
If Not CheckResult = "" Then Throw New ArgumentException(CheckResult)
@@ -390,7 +391,13 @@ NextInner:
Case McLoginType.Ms
Loader = McLoginMsLoader
Case McLoginType.Legacy
Loader = McLoginLegacyLoader
If PageLinkHiper.HiperState = LoadState.Finished Then
'使用 HiPer 内网验证
Loader = McLoginHiperLoader
Else
'默认的离线验证
Loader = McLoginLegacyLoader
End If
Case McLoginType.Nide
Loader = McLoginNideLoader
Case McLoginType.Auth
@@ -400,6 +407,7 @@ NextInner:
Loader.WaitForExit(Data.Input, McLoginLoader, Data.IsForceRestarting)
Data.Output = CType(Loader, Object).Output
RunInUi(Sub() FrmLaunchLeft.RefreshPage(True, False)) '刷新自动填充列表
McLaunchLog("登录加载已结束")
End Sub
#End Region
@@ -411,6 +419,7 @@ NextInner:
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginHiperLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login HiPer", AddressOf McLoginHiperStart) With {.ReloadTimeout = 60000}
'主加载函数,返回所有需要的登录信息
Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
@@ -545,43 +554,9 @@ LoginFinish:
Data.Progress = 0.1
With Data.Output
.Name = Input.UserName
.Uuid = McLoginLegacyUuid(Input.UserName)
.Uuid = McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName)
.Type = "Legacy"
End With
'根据离线皮肤获取实际使用的 Uuid
Select Case Input.SkinType
Case 0
'默认,不需要处理
Case 1
'Steve
Do Until McSkinSex(Data.Output.Uuid) = "Steve"
If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000"
Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 2
'Alex
Do Until McSkinSex(Data.Output.Uuid) = "Alex"
If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000"
Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 3
'使用正版用户名
Try
If Not Input.SkinName = "" Then
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & Input.SkinName)
Data.Output.Uuid = McLoginMojangUuid(Input.SkinName, False)
End If
Catch ex As Exception
Log(ex, "离线启动时使用的正版皮肤获取失败")
MyMsgBox("由于设置的离线启动时使用的正版皮肤获取失败,游戏将以无皮肤的方式启动。" & vbCrLf & "请检查你的网络是否通畅,或尝试使用 VPN!" & vbCrLf & vbCrLf & "详细的错误信息:" & ex.Message, "皮肤获取失败")
End Try
Case 4
'自定义
Do Until McSkinSex(Data.Output.Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000"
Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
End Select
'将结果扩展到所有项目中
'Data.Output.AccessToken = Setup.Get("CacheMojangAccess") '不能优先使用缓存的 AccessToken,这会导致离线用户名设置失效
'If Data.Output.AccessToken.Length < 300 Then
@@ -596,6 +571,46 @@ LoginFinish:
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
End Sub
Private Sub McLoginHiperStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult))
Dim Input As McLoginLegacy = Data.Input
McLaunchLog("登录方式:联机离线(" & Input.UserName & ")")
Data.Progress = 0.05
'尝试登录
Try
McLaunchLog("登录开始(Login, HiPer)")
Dim LoginJson As JObject = GetJson(NetRequestRetry(
Url:="http://hiperauth.tech/api/yggdrasil-hiper/authserver/authenticate",
Method:="POST",
Data:="{""agent"": {""name"": ""Minecraft"",""version"": 1},""username"":""" & Data.Input.UserName & """,""password"":""" &
McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName) & """,""requestUser"":true}",
ContentType:="application/json; charset=utf-8"))
'将登录结果输出
Data.Output.AccessToken = LoginJson("accessToken").ToString
Data.Output.ClientToken = LoginJson("clientToken").ToString
Data.Output.Name = LoginJson("selectedProfile")("name").ToString
Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString
Data.Output.Type = "Auth"
Data.Output.Email = Data.Input.UserName
McLaunchLog("登录成功(Login, HiPer)")
'保存启动记录
Dim Names As New List(Of String)
If Not Setup.Get("LoginLegacyName") = "" Then Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
Names.Remove(Input.UserName)
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
Catch ex As Exception
Dim AllMessage As String = GetString(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
Dim ThrowEx As Exception = ex
If AllMessage.Contains("403") Then
ThrowEx = New Exception("登录尝试过于频繁,导致被系统暂时屏蔽。请不要操作,等待 10 分钟后再试。", ex)
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
ThrowEx = New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查 HiPer 联机模块的连接状况是否良好,或选择其他登录方式!")
End If
McLaunchLog("登录失败:" & GetString(ThrowEx))
Throw ThrowEx
End Try
End Sub
'Server 登录:三种验证方式的请求
Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -752,10 +767,8 @@ LoginFinish:
If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号,而非游戏角色 ID。" & vbCrLf) &
" - 只注册了账号,但没有加入对应服务器。")
End Select
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") Then
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
ElseIf AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器失败。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
ElseIf ex.Message.StartsWith("$") Then
Throw
Else
@@ -845,7 +858,7 @@ SystemBrowser:
Try
Result = NetRequestMuity("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1)
Catch ex As Exception
If ex.Message.Contains("must sign in again") Then
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then 'Fix Hex-Dragon/PCL2#269
Return {"Relogin", ""}
Else
Throw
@@ -895,7 +908,11 @@ SystemBrowser:
Result = NetRequestMuity("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Catch ex As Net.WebException
If ex.Message.Contains("2148916233") Then
Throw New Exception("$该微软账号尚未购买 Minecraft Java 版或注册 XBox 账户!")
If MyMsgBox("该微软账号尚未购买 Minecraft Java 版,或尚未注册 XBox 账户。" & vbCrLf &
"如果你确定该账号完成了上述步骤,请先在游戏官网登录一次,然后再在启动器登录。", "登录提示", "打开游戏官网", "取消") = 1 Then
OpenWebsite("https://www.minecraft.net/")
End If
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
"该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
@@ -968,7 +985,46 @@ SystemBrowser:
Return {UUID, UserName, Result}
End Function
'根据用户名返回对应 Uuid,需要多线程
'返回符合离线皮肤设置的 UUID
Private Function McLoginLegacyUuidWithCustomSkin(UserName As String, SkinType As Integer, SkinName As String) As String
Dim Uuid As String = McLoginLegacyUuid(UserName)
'根据离线皮肤获取实际使用的 Uuid
Select Case SkinType
Case 0
'默认,不需要处理
Case 1
'Steve
Do Until McSkinSex(Uuid) = "Steve"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 2
'Alex
Do Until McSkinSex(Uuid) = "Alex"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 3
'使用正版用户名
Try
If Not SkinName = "" Then
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False)
End If
Catch ex As Exception
Log(ex, "离线启动时使用的正版皮肤获取失败")
MyMsgBox("由于设置的离线启动时使用的正版皮肤获取失败,游戏将以无皮肤的方式启动。" & vbCrLf & "请检查你的网络是否通畅,或尝试使用 VPN!" & vbCrLf & vbCrLf & "详细的错误信息:" & ex.Message, "皮肤获取失败")
End Try
Case 4
'自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
End Select
Return Uuid
End Function
'根据用户名返回对应 UUID,需要多线程
Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean)
If Name.Trim.Length = 0 Then Return StrFill("", "0", 32)
'从缓存获取
@@ -1017,25 +1073,50 @@ SystemBrowser:
ElseIf McVersionCurrent.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了
'1.12+:至少 Java 8
MinVer = New Version(1, 8, 0, 0)
ElseIf McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本的 1960 癌
'1.11-:最高 Java 12
ElseIf McVersionCurrent.ReleaseTime <= New Date(2013, 5, 1) AndAlso McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本的 1960 癌
'1.5.2-:最高 Java 12
MaxVer = New Version(1, 12, 999, 999)
End If
'OptiFine 检测
If McVersionCurrent.Version.HasOptiFine Then
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'<1.7:至多 Java 8(Java 9 - 10 未测试)
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 8 AndAlso McVersionCurrent.Version.McCodeMain <= 11 Then
'1.8 - 1.11:必须恰好 Java 8(Java 9 - 10 未测试)
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
End If
End If
'Forge 检测
If McVersionCurrent.Version.HasForge Then
If McVersionCurrent.Version.McName = "1.7.2" Then
'1.7.2:必须 Java 7
MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain <> -1 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then
'1.12,Forge 14.23.5.2855 及更低:Java 8
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then
'<1.12,Forge 14.23.5.2855 及更低:Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain <> -1 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then
'1.13 - 1.14,Forge 28.2.23 及更低:Java 8 - 10
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16:Java 8 - 12, 12 - 15未测试
ElseIf McVersionCurrent.Version.McCodeMain <= 15 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'1.15:Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
'1.18+:若安装了 OptiFine,最高 Java 18
MaxVer = New Version(1, 18, 999, 999)
End If
End If
'Fabric 检测
If McVersionCurrent.Version.HasFabric Then
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16:Java 8 - 18
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 18, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
'1.18+:Java 17 - 18
MinVer = New Version(1, 17, 0, 0) : MaxVer = New Version(1, 18, 999, 999)
End If
End If
@@ -1080,13 +1161,28 @@ SystemBrowser:
Private McLaunchArgument As String
''' <summary>
''' 释放 Java Wrapper 并返回文件路径。
''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = PathAppdata & "JavaWrapper.jar"
If Not File.Exists(WrapperPath) OrElse New FileInfo(WrapperPath).Length > 20 * 1024 Then
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
If Not File.Exists(WrapperPath) OrElse New FileInfo(WrapperPath).Length <> 16818 Then
WriteFile(WrapperPath, GetResources("JavaWrapper"))
McLaunchLog("已自动释放 Java Wrapper")
Log("[Java] 已自动释放 Java Wrapper:" & WrapperPath)
End If
Return WrapperPath
End Function
''' <summary>
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
''' </summary>
Public Function GetJavaWrapperDir() As String
Dim WrapperPath As String = PathAppdata.TrimEnd("\")
If Encoding.UTF8.GetByteCount(WrapperPath) <> WrapperPath.Length Then
Log("[Java] AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
WrapperPath = PathTemp.TrimEnd("\")
If Encoding.UTF8.GetByteCount(PathTemp) <> PathTemp.Length Then
Log("[Java] Temp 路径中包含非 ASCII 字符,换用 C 盘根目录")
WrapperPath = "C:\PCL"
End If
End If
Return WrapperPath
End Function
@@ -1107,7 +1203,7 @@ SystemBrowser:
McLaunchLog("旧版 JVM 参数获取成功:")
McLaunchLog(Arguments)
End If
If McVersionCurrent.JsonObject("minecraftArguments") IsNot Nothing Then
If Not String.IsNullOrEmpty(McVersionCurrent.JsonObject("minecraftArguments")) Then '有的版本是空字符串
McLaunchLog("获取旧版 Game 参数")
Arguments += " " & McLaunchArgumentsGameOld(McVersionCurrent)
McLaunchLog("旧版 Game 参数获取成功")
@@ -1173,14 +1269,16 @@ SystemBrowser:
'统一通行证
If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-Dnide8auth.client=true -javaagent:nide8auth.jar=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
DataList.Insert(0, "-Dnide8auth.client=true -javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:authlib-injector.jar=" & Server &
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1190,6 +1288,7 @@ SystemBrowser:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'添加 MainClass
@@ -1237,14 +1336,16 @@ NextVersion:
'统一通行证
If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-javaagent:nide8auth.jar=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
DataList.Insert(0, "-javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:authlib-injector.jar=" & Server &
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1254,6 +1355,7 @@ NextVersion:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1420,7 +1522,7 @@ NextVersion:
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))
'支持库参数
Dim LibList As List(Of McLibToken) = McLibListGet(Version, Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17))
Dim LibList As List(Of McLibToken) = McLibListGet(Version, True)
Loader.Output = LibList
Dim CpStrings As New List(Of String)
Dim OptiFineCp As String = Nothing
@@ -1539,7 +1641,7 @@ NextVersion:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.Default)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json")
Catch ex As Exception
Log(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试")
@@ -1570,7 +1672,7 @@ NextVersion:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.Default)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json")
Catch exx As Exception
Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
@@ -1770,7 +1872,7 @@ IgnoreCustomSkin:
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(Path & "PCL\LatestLaunch.bat", CmdString, Encoding:=Encoding.Default)
WriteFile(Path & "PCL\LatestLaunch.bat", CmdString, Encoding:=Encoding.GetEncoding("GB18030"))
Catch ex As Exception
Log(ex, "输出启动脚本失败")
End Try
@@ -458,9 +458,6 @@ RetryGet:
GoTo RetryGet
End If
'若依然未找到适合的 Java,直接返回
If AllowedJavaList.Count = 0 Then Return Nothing
'检查用户指定的 Java
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
If RelatedVersion IsNot Nothing Then
@@ -484,16 +481,35 @@ RetryGet:
End If
Next
Log("[Java] 发现用户指定的不兼容 Java:" & UserJava.ToString)
If MyMsgBox("你在启动设置中指定了使用下列 Java:" & vbCrLf &
" - " & UserJava.ToString & vbCrLf &
vbCrLf &
"该 Java 可能不兼容当前游戏版本,游戏存在崩溃风险。是否要强制使用该 Java?", "Java 兼容性警告", "取消,让 PCL2 自动选择", "继续") = 2 Then
'弹窗要求选择
Dim Requirement As String = ""
If (MinVersion Is Nothing OrElse MinVersion.Minor = 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 99) Then
Requirement = "最高兼容到 Java " & MaxVersion.Minor & If(MaxVersion.MinorRevision < 99, "." & MaxVersion.MinorRevision & "." & MaxVersion.Revision, "")
ElseIf (MinVersion IsNot Nothing AndAlso MinVersion.Minor > 0) AndAlso (MaxVersion Is Nothing OrElse MaxVersion.Minor >= 99) Then
Requirement = "至少需要 Java " & MinVersion.Minor & If(MinVersion.MinorRevision > 0 OrElse MinVersion.Revision > 0, "." & MinVersion.MinorRevision & "." & MinVersion.Revision, "")
ElseIf (MinVersion IsNot Nothing AndAlso MinVersion.Minor > 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 99) Then
Dim Left As String = MinVersion.Minor & If(MinVersion.MinorRevision > 0 OrElse MinVersion.Revision > 0, "." & MinVersion.MinorRevision & "." & MinVersion.Revision, "")
Dim Right As String = MaxVersion.Minor & If(MaxVersion.MinorRevision < 99, "." & MaxVersion.MinorRevision & "." & MaxVersion.Revision, "")
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
If Setup.Get("LaunchAdvanceJava") Then
'直接跳过弹窗
Hint("设置中指定了使用 Java " & UserJava.VersionCode & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", HintType.Critical)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
ElseIf MyMsgBox("你在启动设置中指定了使用 Java " & UserJava.VersionCode & ",但当前版本" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java,可能会导致游戏崩溃。" & vbCrLf &
vbCrLf &
" - 指定的 Java:" & UserJava.ToString,
"Java 兼容性警告", "让 PCL2 自动选择", "强制使用该 Java") = 2 Then
'强制使用指定的 Java
Log("[Java] 已强制使用用户指定的不兼容 Java")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
End If
End If
'若依然未找到适合的 Java,直接返回
If AllowedJavaList.Count = 0 Then Return Nothing
'检查特定的 Java
For Each Java In AllowedJavaList
If TargetJavaList.Contains(Java) Then
@@ -581,8 +597,8 @@ UserPass:
If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 30, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If
'5. 最次级版本号更接近 51
@@ -773,7 +789,7 @@ UserPass:
""selectedProfile"": ""PCL2"",
""clientToken"": ""23323323323323323323323323323333""
}"
WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.Default)
WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030"))
Log("[Minecraft] 已创建 launcher_profiles.json:" & Folder)
Catch ex As Exception
Log(ex, "创建 launcher_profiles.json 失败(" & Folder & ")", LogLevel.Feedback)
@@ -2311,13 +2327,16 @@ NextVersion:
Dim RealVersion As McVersion
Dim RequiredJar As String = Version.JsonObject("jar")?.ToString
If Version.IsHmclFormatJson OrElse RequiredJar Is Nothing Then
'HMCL 项直接使用自身的 Jar
'根据 Inherit 获取最深层版本
'此外,HMCL 项直接使用自身的 Jar
Dim OriginalVersion As McVersion = Version
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
Loop
'1.17+ 的 Forge 不寻找 Inherit
If Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
Loop
End If
'需要新建对象,否则后面的 Check 会导致 McVersionCurrent 的 State 变回 Original
'复现:启动一个 Snapshot 版本
RealVersion = New McVersion(OriginalVersion.Path)
@@ -2364,6 +2383,11 @@ NextVersion:
'转换为 LibToken
For Each Library As JObject In AllLibs.Children
'清理 null 项(BakaXL 会把没有的项序列化为 null,但会被 Newtonsoft 转换为 JValue,导致 Is Nothing = false;这导致了 #409)
For i = Library.Properties.Count - 1 To 0 Step -1
If Library.Properties(i).Value.Type = JTokenType.Null Then Library.Remove(Library.Properties(i).Name)
Next
'检查是否需要(Rules)
If Not McJsonRuleCheck(Library("rules")) Then Continue For
@@ -2486,33 +2510,36 @@ NextVersion:
'统一通行证文件
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
Dim TargetFile = Version.PathIndie & "nide8auth.jar"
Dim TargetFile = PathAppdata & "nide8auth.jar"
Dim Checker As New FileChecker(MinSize:=173000)
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
End If
End If
'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
Dim TargetFile = Version.PathIndie & "authlib-injector.jar"
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
DownloadInfo = GetJson(NetGetCodeByDownload({"https://download.mcbbs.net/mirrors/authlib-injector/artifact/latest.json", "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
Catch ex As Exception
Log("获取 Authlib-Injector 下载信息失败", LogLevel.Hint)
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
'开始下载
Dim DownloadAddress As String = DownloadInfo("download_url")
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress)
Result.Add(New NetFile({
DownloadAddress.Replace("bmclapi2.bangbang93.com", "download.mcbbs.net"), DownloadAddress
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
Dim TargetFile = PathAppdata & "authlib-injector.jar"
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
DownloadInfo = GetJson(NetGetCodeByDownload({"https://download.mcbbs.net/mirrors/authlib-injector/artifact/latest.json", "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
Catch ex As Exception
Log(ex, "获取 Authlib-Injector 下载信息失败")
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
'开始下载
Dim DownloadAddress As String = DownloadInfo("download_url")
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress)
Result.Add(New NetFile({
DownloadAddress.Replace("bmclapi2.bangbang93.com", "download.mcbbs.net"), DownloadAddress
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
End If
End If
End If
End If
@@ -3804,7 +3831,11 @@ NextEntry:
Else
Select Case McLoginLoader.Input.Type
Case McLoginType.Legacy
Raw = Raw.Replace("{login}", "离线")
If PageLinkHiper.HiperState = LoadState.Finished Then
Raw = Raw.Replace("{login}", "联机离线")
Else
Raw = Raw.Replace("{login}", "离线")
End If
Case McLoginType.Mojang
Raw = Raw.Replace("{login}", "Mojang 正版")
Case McLoginType.Ms
@@ -126,7 +126,7 @@
End If
'解压文件
Dim RetryCount As Integer = 1
Dim Encode = Encoding.Default
Dim Encode = Encoding.GetEncoding("GB18030")
Try
Retry:
'完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
@@ -241,8 +241,12 @@ Retry:
For Each ModJson In Task.Input
'跳过重复的 Mod(疑似 CurseForge Bug)
If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
'根据 modules 判断是资源包还是 Mod
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
Dim IsResourcePack As Boolean = Not ModuleNames.Contains("META-INF") AndAlso ModuleNames.Contains("pack.mcmeta")
'实际的添加
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(
PathMcFolder & "versions\" & VersionName & "\" & If(IsResourcePack, "resourcepacks", "mods") & "\", False))
Task.Progress += 1 / (1 + ModFileList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -276,6 +280,14 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("清理安装文件",
Sub(Task As LoaderTask(Of String, String))
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[Download] 根据设置要求删除原始整合包文件:" & Target)
File.Delete(Target)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
@@ -94,7 +94,6 @@
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse Loader.State = LoadState.Aborted
TimerWindow()
TimerLog()
If State = MinecraftState.Loading Then ProgressUpdate()
'设置窗口标题
For i = 1 To 3
If IsWindowFinished AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
@@ -151,6 +150,7 @@
For Each Str As String In Copyed
GameLog(Str)
Next
If State = MinecraftState.Loading Then ProgressUpdate()
'游戏退出检查
If GameProcess.HasExited Then
WatcherLog("Minecraft 已退出,返回值:" & GameProcess.ExitCode)
@@ -167,7 +167,7 @@
'返回值不为 0 且未结束
WatcherLog("Minecraft 返回值异常,可能已崩溃")
Crashed()
Else
ElseIf State <> MinecraftState.Crashed Then
'正常关闭
State = MinecraftState.Ended
End If
@@ -268,8 +268,18 @@
WatcherLog("Minecraft 窗口已加载:" & WindowHandle.ToInt64)
IsWindowFinished = True
'最大化
Thread.Sleep(3000) '1.7.10 LiteLoader 不延迟会显示错误
If Setup.Get("LaunchArgumentWindowType") = 4 Then ShowWindow(WindowHandle, 3)
If Setup.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread(Sub()
Try
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(1000)
ShowWindow(WindowHandle, 3)
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
End If
ElseIf Not IsWindowAppeared Then
'已找到 FML 窗口
WatcherLog("FML 窗口已加载:" & MinecraftWindows.Keys(0).ToInt64)
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.4.0.0")>
<Assembly: AssemblyFileVersion("2.4.0.0")>
<Assembly: AssemblyVersion("2.4.3.0")>
<Assembly: AssemblyFileVersion("2.4.3.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -137,7 +137,7 @@
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\ModData.json;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
<value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="NAudio" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
@@ -1,8 +1,15 @@
Imports System.IO.Compression
Public Module ModDownloadLib
'如果 OptiFine 与 Forge 同时开始安装,就会导致 Forge 安装失败
''' <summary>
''' 如果 OptiFine 与 Forge 同时开始安装,就会导致 Forge 安装失败,所以在这里添加一个锁。
''' </summary>
Private InstallSyncLock As New Object
''' <summary>
''' 最高的 Minecraft 大版本号,-1 代表尚未获取。
''' </summary>
Public McVersionHighest As Integer = -1
#Region "Minecraft 下载"
@@ -114,7 +121,7 @@ Public Module ModDownloadLib
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")}
End Sub) With {.ProgressWeight = 2, .Show = False})
End If
Loaders.Add(New LoaderDownload("下载原版 Json 文件", New List(Of NetFile) From {
Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 3})
@@ -159,6 +166,7 @@ Public Module ModDownloadLib
End Function
Private Const McDownloadClientLibName As String = "下载原版支持库文件"
Private Const McDownloadClientJsonName As String = "下载原版 Json 文件"
#End Region
@@ -180,7 +188,7 @@ Public Module ModDownloadLib
'建立控件
Dim NewItem As New MyListItem With {.Logo = Logo, .SnapsToDevicePixels = True, .Title = Entry("id").ToString, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60}
If Entry("lore") Is Nothing Then
NewItem.Info = Entry("releaseTime").Value(Of Date).ToString("yyyy/MM/dd")
NewItem.Info = Entry("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
Else
NewItem.Info = Entry("lore").ToString
End If
@@ -378,7 +386,7 @@ Public Module ModDownloadLib
Throw New Exception("未找到用于安装 OptiFine 的 Java")
End If
'添加 Java Wrapper 作为主 Jar
Dim Arguments = "-Duser.home=""" & BaseMcFolderHome & """ -cp """ & Target & """ -jar """ & ExtractJavaWrapper() & """ optifine.Installer"
Dim Arguments = "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """ -Duser.home=""" & BaseMcFolderHome & """ -cp """ & Target & """ -jar """ & ExtractJavaWrapper() & """ optifine.Installer"
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
@@ -518,27 +526,28 @@ Public Module ModDownloadLib
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
'是否已经存在原版文件
If ClientDownloadLoader Is Nothing Then Exit Sub
'等待原版文件下载完成
For Each Loader In ClientDownloadLoader.GetLoaderList
If Loader.Name <> McDownloadClientLibName Then Continue For
If Loader.State = LoadState.Loading Then
Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Loader.WaitForExit()
End If
Exit For
Next
If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
'拷贝原版文件
If IsCustomFolder Then
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
End If
If Not IsCustomFolder Then Exit Sub
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -679,7 +688,9 @@ Public Module ModDownloadLib
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = If(Entry.IsPreview, "测试版", "正式版") & If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime),
.Info = If(Entry.IsPreview, "测试版", "正式版") &
If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) &
If(Entry.RequiredForgeVersion = "", "", ",推荐 Forge 版本:" & Entry.RequiredForgeVersion),
.Logo = "pack://application:,,,/images/Blocks/GrassPath.png"
}
AddHandler NewItem.Click, OnClick
@@ -874,8 +885,8 @@ Public Module ModDownloadLib
'构造版本 Json
Dim VersionJson As New JObject
VersionJson.Add("id", VersionName)
VersionJson.Add("time", DateTime.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm:ss", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("releaseTime", DateTime.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm:ss", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("time", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("type", "release")
VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}"))
VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries"))
@@ -1092,7 +1103,7 @@ Public Module ModDownloadLib
Throw New Exception("未找到用于安装 Forge 的 Java")
End If
'添加 Java Wrapper 作为主 Jar
Dim Arguments = "-cp """ & PathTemp & "Cache\forge_installer.jar;" & Target & """ -jar """ & ExtractJavaWrapper() & """ com.bangbang93.ForgeInstaller """ & McFolder
Dim Arguments = "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """ -cp """ & PathTemp & "Cache\forge_installer.jar;" & Target & """ -jar """ & ExtractJavaWrapper() & """ com.bangbang93.ForgeInstaller """ & McFolder
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
@@ -1327,27 +1338,26 @@ Public Module ModDownloadLib
End If
#End Region
#Region "原版文件"
'是否已经存在原版文件
If ClientDownloadLoader Is Nothing Then Exit Sub
'等待原版文件下载完成
For Each Loader In ClientDownloadLoader.GetLoaderList
If Loader.Name <> McDownloadClientLibName Then Continue For
If Loader.State = LoadState.Loading Then
Log("[Download] Forge 安装正在等待原版文件下载完成")
Loader.WaitForExit()
End If
Exit For
Next
If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
'拷贝原版文件
If IsCustomFolder Then
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
If Not IsCustomFolder Then Exit Sub
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
#End Region
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -1672,6 +1682,7 @@ Public Module ModDownloadLib
Dim Loaders As New List(Of LoaderBase)
'下载 Json
MinecraftName = MinecraftName.Replace("∞", "infinite") '放在 ID 后面避免影响版本文件夹名称
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 Fabric 主文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载
@@ -2071,20 +2082,23 @@ Public Module ModDownloadLib
#Region "处理 Json 文件"
'获取 minecraftArguments
Dim AllArguments As String =
If(MinecraftJson("minecraftArguments"), " ").ToString &
If(OptiFineJson IsNot Nothing, If(OptiFineJson("minecraftArguments"), " ").ToString, " ") &
If(ForgeJson IsNot Nothing, If(ForgeJson("minecraftArguments"), " ").ToString, " ") &
If(MinecraftJson("minecraftArguments"), " ").ToString & " " &
If(OptiFineJson IsNot Nothing, If(OptiFineJson("minecraftArguments"), " ").ToString, " ") & " " &
If(ForgeJson IsNot Nothing, If(ForgeJson("minecraftArguments"), " ").ToString, " ") & " " &
If(LiteLoaderJson IsNot Nothing, If(LiteLoaderJson("minecraftArguments"), " ").ToString, " ")
'分割参数字符串
Dim RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String)
For Each Argument In AllArguments.Split("--")
Argument = Argument.Trim
If Argument <> "" Then SplitArguments.Add(Argument)
For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWith("-") Then
SplitArguments.Add(RawArguments(i))
ElseIf SplitArguments.Count > 0 AndAlso SplitArguments.Last.StartsWith("-") AndAlso Not SplitArguments.Last.Contains(" ") Then
SplitArguments(SplitArguments.Count - 1) = SplitArguments.Last & " " & RawArguments(i)
Else
SplitArguments.Add(RawArguments(i))
End If
Next
SplitArguments = ArrayNoDouble(SplitArguments)
Dim RealArguments As String = Nothing
If SplitArguments.Count > 0 Then
RealArguments = "--" & Join(SplitArguments, " --")
End If
Dim RealArguments As String = Join(ArrayNoDouble(SplitArguments), " ")
'合并
OutputJson = MinecraftJson
If HasOptiFine Then
@@ -139,7 +139,7 @@
PanIntro.Children.Insert(0, CfItem)
'决定按钮显示
BtnIntroWiki.Visibility = If(Project.McWikiId = 0, Visibility.Collapsed, Visibility.Visible)
BtnIntroWiki.Visibility = If(Project.WikiId = 0, Visibility.Collapsed, Visibility.Visible)
BtnIntroMCBBS.Visibility = If(Project.MCBBS Is Nothing, Visibility.Collapsed, Visibility.Visible)
AniControlEnabled -= 1
@@ -165,7 +165,10 @@
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Sub() ModpackInstall(Target, VersionName)) With {.ProgressWeight = 0.1})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub()
If Not ModpackInstall(Target, VersionName) Then Throw New Exception("整合包安装出现异常!")
End Sub) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader)
@@ -189,70 +192,131 @@
End Try
End Sub
'Mod 下载;整合包另存为
Public Shared DownloadFolder = Nothing '仅在本次缓存的下载文件夹
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Try
Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ")
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If Not Project.IsModPack Then
DefaultFolder = DownloadFolder
If McVersionCurrent IsNot Nothing Then
If Not McVersionCurrent.IsLoaded Then McVersionCurrent.Load()
If McVersionCurrent.Modable Then
Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread(
Sub()
Try
Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ")
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If Not Project.IsModPack Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing 'FUTURE: Quilt 支持
If File.ModLoaders.Count > 0 Then '从文件中获取
AllowForge = False : AllowFabric = False
For Each LoaderType In File.ModLoaders
If LoaderType = "Forge" Then AllowForge = True
If LoaderType = "Fabric" Then AllowFabric = True
Next
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
AllowForge = False : AllowFabric = False
For Each LoaderType In Project.ModLoaders
If LoaderType = "Forge" Then AllowForge = True
If LoaderType = "Fabric" Then AllowFabric = True
Next
End If
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
AllowFabric IsNot Nothing AndAlso Not AllowFabric Then
AllowForge = Nothing : AllowFabric = Nothing
End If
Log("[Download] 允许 Forge:" & If(AllowForge, "未知") & ",允许 Fabric:" & If(AllowFabric, "未知"))
'判断某个版本是否符合要求
Dim IsVersionSuitable As Func(Of McVersion, Boolean) =
Function(Version)
If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False
If File.GameVersion.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersion.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
Return False
End Function
'获取 Mod 默认下载位置
If CachedFolder IsNot Nothing Then
DefaultFolder = CachedFolder
Log("[Download] 使用上次下载时的文件夹作为默认下载位置")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = McVersionCurrent.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用当前版本的 mods 文件夹作为默认下载位置(" & McVersionCurrent.Name & ")")
Else
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
If NeedLoad Then
Hint("正在查找适合的游戏版本……")
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If
Dim SuitableVersions As New List(Of McVersion)
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
Next
If SuitableVersions.Count = 0 Then
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中未找到适合这个 Mod 的游戏版本")
Else
Log("[Download] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v)
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
End If
End If
End If
If String.IsNullOrEmpty(DefaultFolder) Then DefaultFolder = Nothing
End If
'获取基本信息
Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
Dim ChineseName As String = If(Project.ChineseName = Project.Name, "",
Project.ChineseName.Replace(" (", "Å").Split("Å").First.Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":"))
Dim FileName As String
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
FileName = If(ChineseName = "", "", "[" & ChineseName & "] ") & File.FileName
Case 1
FileName = If(ChineseName = "", "", ChineseName & "-") & File.FileName
Case 2
FileName = File.FileName & If(ChineseName = "", "", "-" & ChineseName)
Case Else
FileName = File.FileName
End Select
Dim Target As String
If File.FileName.EndsWith(".litemod") Then
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.litemod"), DefaultFolder)
Else
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.jar"), DefaultFolder)
End If
If Not Target.Contains("\") Then Exit Sub
Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " "
If Target <> DefaultFolder AndAlso Not Project.IsModPack Then DownloadFolder = GetPathFromFullPath(Target)
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(1)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback)
End Try
'获取基本信息
Dim ChineseName As String = If(Project.ChineseName = Project.Name, "",
Project.ChineseName.Replace(" (", "Å").Split("Å").First.Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":"))
Dim FileName As String
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
FileName = If(ChineseName = "", "", "[" & ChineseName & "] ") & File.FileName
Case 1
FileName = If(ChineseName = "", "", ChineseName & "-") & File.FileName
Case 2
FileName = File.FileName & If(ChineseName = "", "", "-" & ChineseName)
Case Else
FileName = File.FileName
End Select
RunInUi(
Sub()
'弹窗要求选择保存位置
Dim Target As String
If File.FileName.EndsWith(".litemod") Then
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.litemod"), DefaultFolder)
Else
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.jar"), DefaultFolder)
End If
If Not Target.Contains("\") Then Exit Sub
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " "
If Target <> DefaultFolder AndAlso Not Project.IsModPack Then CachedFolder = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(1)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback)
End Try
End Sub, "Download CFDetail Save")
End Sub
Private Sub BtnIntroCf_Click(sender As Object, e As EventArgs) Handles BtnIntroCf.Click
OpenWebsite(Project.Website)
End Sub
Private Sub BtnIntroWiki_Click(sender As Object, e As EventArgs) Handles BtnIntroWiki.Click
OpenWebsite("https://www.mcmod.cn/class/" & Project.McWikiId & ".html")
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
End Sub
Private Sub BtnIntroMCBBS_Click(sender As Object, e As EventArgs) Handles BtnIntroMCBBS.Click
OpenWebsite("https://www.mcbbs.net/thread-" & Project.MCBBS & "-1-1.html")
@@ -65,11 +65,11 @@
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").ToString()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").ToString()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
@@ -536,11 +536,11 @@
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 15, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").ToString()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").ToString()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
@@ -571,17 +571,39 @@
''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFineGetError() As String
'If Not SelectedMinecraftId.Contains("1.") Then Return "没有可用版本"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then
'If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If SelectedForge IsNot Nothing AndAlso VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then Return "与 Forge 不兼容"
'检查 Forge 1.13 - 1.14.3:全部不兼容
If SelectedForge IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then
Return "与 Forge 不兼容"
End If
'检查最低 Forge 版本
Dim MinimalForgeVersion As String = "9999.9999"
For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Not OptiFineVersion.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Continue For '不是同一个大版本
If SelectedForge Is Nothing OrElse IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then
Return Nothing
Else
'设置用于显示的最低 Forge 版本
MinimalForgeVersion = If(VersionSortBoolean(MinimalForgeVersion, OptiFineVersion.RequiredForgeVersion),
OptiFineVersion.RequiredForgeVersion, MinimalForgeVersion)
End If
Next
Return "没有可用版本"
If MinimalForgeVersion = "9999.9999" Then
Return "没有可用版本"
Else
Return "需要 Forge " & If(MinimalForgeVersion.Contains("."), "", "#") & MinimalForgeVersion & " 或更高版本"
End If
End Function
'检查某个 OptiFine 是否与某个 Forge 兼容(最低 Forge 版本是否达到需求)
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX
VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse
(Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX
VersionSortInteger(Forge.Version.Split(".").Last, OptiFine.RequiredForgeVersion) >= 0)
End Function
'限制展开
@@ -595,9 +617,11 @@
Private Sub OptiFine_Loaded() Handles LoadOptiFine.StateChanged
Try
If DlOptiFineListLoader.State <> LoadState.Finished Then Exit Sub
'获取版本列表
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
@@ -618,7 +642,9 @@
'选择与清除
Private Sub OptiFine_Selected(sender As MyListItem, e As EventArgs)
SelectedOptiFine = sender.Tag
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing
OptiFabric_Loaded()
Forge_Loaded()
CardOptiFine.IsSwaped = True
SelectReload()
End Sub
@@ -627,6 +653,7 @@
SelectedOptiFabric = Nothing
CardOptiFine.IsSwaped = True
e.Handled = True
Forge_Loaded()
SelectReload()
End Sub
@@ -743,6 +770,7 @@
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, Version) Then Continue For
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next
Catch ex As Exception
@@ -754,12 +782,15 @@
Private Sub Forge_Selected(sender As MyListItem, e As EventArgs)
SelectedForge = sender.Tag
CardForge.IsSwaped = True
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedOptiFine = Nothing
OptiFine_Loaded()
SelectReload()
End Sub
Private Sub Forge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnForgeClear.MouseLeftButtonUp
SelectedForge = Nothing
CardForge.IsSwaped = True
e.Handled = True
OptiFine_Loaded()
SelectReload()
End Sub
@@ -774,7 +805,7 @@
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabric.State, Object).Error.Message
For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId Then
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite") Then
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
'If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
Return Nothing
@@ -15,7 +15,7 @@
</local:MyListItem>
<local:MyListItem x:Name="ItemHand" IsScaleAnimationEnabled="False" Type="RadioBox" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="手动安装包"
LogoScale="1.02" Logo="M292.693 787.627c0 30.72-24.746 55.466-55.466 55.466s-55.467-24.746-55.467-55.466 24.747-55.467 55.467-55.467c30.72-0.853 55.466 24.747 55.466 55.467z M1000.96 241.493c-2.56-5.973-4.267-11.946-6.827-17.92-0.853-6.826-4.266-12.8-8.533-17.92-7.68-9.386-18.773-15.36-31.573-15.36-6.827 0-13.654 1.707-19.627 5.12l-15.36 15.36-17.067 17.067-21.333 21.333L749.227 381.44c-14.507 14.507-38.4 14.507-52.907 0l-54.613-54.613c-14.507-14.507-14.507-38.4 0-52.907l132.266-132.267 14.507-14.506 20.48-20.48 16.213-16.214c3.414-5.973 5.12-11.946 5.12-19.626 0-12.8-5.973-24.747-16.213-32.427-5.973-4.267-11.947-6.827-18.773-7.68-5.12-2.56-10.24-4.267-16.214-5.973-36.693-12.8-76.8-19.627-117.76-19.627-7.68 0-14.506 0-22.186 0.853-188.587 11.947-337.92 168.107-337.92 360.96 0 16.214 0.853 32.427 3.413 48.64L56.32 663.04c-73.387 74.24-73.387 193.707 0 267.093l33.28 33.28c73.387 73.387 193.707 73.387 267.093 0l240.64-241.493c21.334 4.267 42.667 5.973 64 5.973 190.294 0 346.454-146.773 360.107-333.653 0.853-8.533 0.853-17.92 0.853-27.307 0.854-44.373-6.826-86.186-21.333-125.44zM658.773 639.147c-28.16 0-54.613-4.267-79.36-11.094-4.266 7.68-10.24 14.507-16.213 21.334l-258.56 258.56c-43.52 43.52-115.2 43.52-158.72 0l-29.013-29.014c-43.52-44.373-43.52-115.2 0-158.72l212.48-212.48 46.08-46.08c5.973-5.973 12.8-11.093 19.626-15.36-8.533-26.453-12.8-54.613-12.8-83.626v-1.707c0-152.747 123.734-275.627 276.48-275.627 18.774 0 37.547 1.707 55.467 5.974L597.333 207.36c-52.053 52.053-52.053 137.387 0 189.44l29.867 29.867c52.053 52.053 137.387 52.053 189.44 0L930.987 312.32c2.56 16.213 4.266 33.28 4.266 50.347 0 152.746-123.733 276.48-276.48 276.48z" />
<TextBlock x:Name="LabHand" Visibility="Collapsed" Text="手动安装包" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<TextBlock x:Name="LabHand" Visibility="Collapsed" Text="▼ 手动安装包" Padding="11,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft"
LogoScale="0.98" Logo="M989.7 510.8l-202.3-101c-10.8-5.4-17.7-16.5-17.7-28.6V172.7c0-26.7-16.6-50.6-41.6-59.9L550.5 46.3c-24.2-9-50.8-9-74.9 0.1l-176.9 66.8c-24.9 9.4-41.4 33.2-41.4 59.9v207.1c0 12.1-6.9 23.2-17.7 28.6l-204 101.9C13.9 521.6 0.1 543.8 0.2 568.1l0.5 226c0 23.2 12.6 44.5 32.9 55.8l223.8 124.6 1.2 0.7c18.9 10.5 41.9 10.4 60.8-0.2l2-1.1L497 873.2c9.9-5.7 22.1-5.6 32 0.1l176.7 102.5c18.9 10.7 42 10.8 61 0.3l3-1.7L992.4 851c20.4-11.3 33-32.8 33-56l-0.3-226.9c0-24.3-13.7-46.5-35.4-57.3zM321 192l115.3 46.1c27 10.8 44.7 36.9 44.7 66v163c0 5.9-6.2 9.8-11.6 7.2L339 409.5c-10.9-5.4-17.7-16.5-17.8-28.6L321 192z m-63.7 703.4L82.5 809.6c-10.9-5.4-17.9-16.5-17.9-28.7l-0.4-189.5L217.9 668c24.1 12 39.4 36.7 39.4 63.6v163.8z m64-274.3c-20.1 10.1-43.7 10-63.8 0l-0.2-0.1-149.1-75 149.1-74.4 16.8-8.4c9.2-4.6 20-4.5 29.1 0.3l18.1 9.4 129.8 64.3c5.8 2.9 6 11.1 0.2 14.2l-130 69.7z m141.9 203.8l-141.8 70.6-0.8-163.6c-0.1-27 15.1-51.8 39.2-63.9l108.8-54.5c5.3-2.7 11.6 1.2 11.6 7.1l0.8 175.6c0 12.1-6.9 23.2-17.8 28.7zM385 144l128-48 128 48-103 38.6c-16.1 6-33.8 6-49.9 0L385 144z m320 48l0.6 187.8c0 12.2-6.8 23.3-17.7 28.7l-131.4 65.7c-5.3 2.7-11.6-1.2-11.6-7.2V304.1c0-29.1 17.7-55.2 44.7-66L705 192z m0.7 710.3l-143.8-77.2c-10.4-5.6-16.9-16.4-16.9-28.2v-176c0-5.9 6.3-9.8 11.6-7.2l109.3 54.6c24 12 39.2 36.5 39.3 63.4l0.5 170.6z m-2-280.5l-129.2-70.5c-5.7-3.1-5.5-11.3 0.3-14.2l131-65.3 16.1-8.5c9.1-4.8 19.9-4.9 29.1-0.3l18.7 9.3L916.9 546l-146.2 76.4c-21.1 11-46.2 10.8-67-0.6z m66 279.4l-0.6-169.1c-0.1-27 15.1-51.7 39.3-63.8L961 592v188.7c0 11.9-6.6 22.7-17 28.3l-174.3 92.2z">
<!--Logo="M469.333333 213.333333V128a42.666667 42.666667 0 1 1 85.333334 0v85.333333h127.829333C847.722667 213.333333 981.333333 347.029333 981.333333 512.149333v319.936A106.496 106.496 0 0 1 874.730667 938.666667h-85.461334c-48.661333 0-107.221333-29.290667-136.469333-68.266667l-64-85.333333c-6.144-8.170667-23.957333-17.066667-34.24-17.066667h-85.12c-10.282667 0-28.096 8.896-34.24 17.066667l-64 85.333333c-29.226667 38.976-87.808 68.266667-136.469333 68.266667H149.269333A106.496 106.496 0 0 1 42.666667 832.085333V512.149333C42.666667 347.029333 176.277333 213.333333 341.504 213.333333H469.333333z m213.162667 85.333334H341.504A213.333333 213.333333 0 0 0 128 512.149333v319.936c0 11.818667 9.450667 21.248 21.269333 21.248h85.461334c21.802667 0 55.082667-16.64 68.202666-34.133333l64-85.333333c22.272-29.696 65.408-51.2 102.506667-51.2h85.12c37.098667 0 80.213333 21.504 102.506667 51.2l64 85.333333c13.12 17.493333 46.4 34.133333 68.202666 34.133333h85.461334a21.162667 21.162667 0 0 0 21.269333-21.248V512.149333A213.333333 213.333333 0 0 0 682.496 298.666667zM362.666667 469.333333h42.666666a42.666667 42.666667 0 1 1 0 85.333334h-42.666666v42.666666a42.666667 42.666667 0 1 1-85.333334 0v-42.666666h-42.666666a42.666667 42.666667 0 1 1 0-85.333334h42.666666v-42.666666a42.666667 42.666667 0 1 1 85.333334 0v42.666666z m341.333333-21.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m0 213.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m-106.666667-106.666666a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z m213.333334 0a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z">-->
@@ -51,28 +51,17 @@
<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:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.3" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" />
<local:MyComboBoxItem Content="1.19" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.18.1" />
<local:MyComboBoxItem Content="1.18" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.17" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.16.4" />
<local:MyComboBoxItem Content="1.16.3" />
<local:MyComboBoxItem Content="1.16.2" />
<local:MyComboBoxItem Content="1.16.1" />
<local:MyComboBoxItem Content="1.16" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.15" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.14" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.13" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.12" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
@@ -83,9 +72,10 @@
<local:MyComboBoxItem Content="1.5.2" />
</local:MyComboBox>
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="5" MaxDropDownHeight="320" Margin="10,0,0,0">
<local:MyComboBoxItem Content="Forge 或 Fabric" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
</local:MyComboBox>
</Grid>
<Grid Margin="0,4,0,6" Height="35">
@@ -3,6 +3,7 @@
'初始化加载器信息
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject Mod", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private Shared Function LoaderInput() As DlCfProjectRequest
@@ -47,42 +47,21 @@
<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:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.3" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" />
<local:MyComboBoxItem Content="1.19" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.18.1" />
<local:MyComboBoxItem Content="1.18" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.17" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.16.4" />
<local:MyComboBoxItem Content="1.16.3" />
<local:MyComboBoxItem Content="1.16.2" />
<local:MyComboBoxItem Content="1.16.1" />
<local:MyComboBoxItem Content="1.16" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.15.1" />
<local:MyComboBoxItem Content="1.15" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.14.3" />
<local:MyComboBoxItem Content="1.14.2" />
<local:MyComboBoxItem Content="1.14.1" />
<local:MyComboBoxItem Content="1.14" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.13.1" />
<local:MyComboBoxItem Content="1.13" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.12.1" />
<local:MyComboBoxItem Content="1.12" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.11" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.10" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.9" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.8" />
<local:MyComboBoxItem Content="1.7.10" />
<local:MyComboBoxItem Content="1.7.2" />
<local:MyComboBoxItem Content="1.6.4" />
@@ -3,6 +3,7 @@
'初始化加载器信息
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject ModPack", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private Shared Function LoaderInput() As DlCfProjectRequest
@@ -83,12 +83,21 @@
'加载
Dim Image As New MyBitmap(Address)
ImgBack.Tag = Address
'大小检查
Dim Scale As Integer = Image.Pic.Width / 64
If Image.Pic.Width < 32 OrElse Image.Pic.Height < 32 Then
ImgFore.Source = Nothing : ImgBack.Source = Nothing
Throw New Exception("图片大小不足,长为 " & Image.Pic.Height & ",宽为 " & Image.Pic.Width)
End If
'头发层(附加层)
If Image.Pic.Width >= 64 AndAlso Image.Pic.Height >= 32 Then
'如果图片中有透明像素,或是头部颜色和透明区均不一样,则加载附加层
If (Image.Pic.GetPixel(1, 1).A = 0 OrElse Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1).A = 0 OrElse Image.Pic.GetPixel(Image.Pic.Width - 2, 2).A = 0) OrElse
(Image.Pic.GetPixel(1, 1) <> Image.Pic.GetPixel(41, 9) AndAlso Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1) <> Image.Pic.GetPixel(41, 9) AndAlso Image.Pic.GetPixel(Image.Pic.Width - 2, 2) <> Image.Pic.GetPixel(41, 9)) Then
ImgFore.Source = New CroppedBitmap(Image, New Int32Rect(40, 8, 8, 8))
If (Image.Pic.GetPixel(1, 1).A = 0 OrElse '如果图片中有任何透明像素(避免纯色白底)
Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1).A = 0 OrElse
Image.Pic.GetPixel(Image.Pic.Width - 2, Image.Pic.Height / 2 - 2).A = 0) OrElse
(Image.Pic.GetPixel(1, 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso '或是头部颜色和透明区均不一样
Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso
Image.Pic.GetPixel(Image.Pic.Width - 2, Image.Pic.Height / 2 - 2) <> Image.Pic.GetPixel(Scale * 41, Scale * 9)) Then
ImgFore.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 40, Scale * 8, Scale * 8, Scale * 8))
Else
ImgFore.Source = Nothing
End If
@@ -96,13 +105,8 @@
ImgFore.Source = Nothing
End If
'脸层
If Image.Pic.Width >= 32 AndAlso Image.Pic.Height >= 32 Then
ImgBack.Source = New CroppedBitmap(Image, New Int32Rect(8, 8, 8, 8))
Log("[Skin] 载入头像成功:" & Loader.Name)
Else
ImgBack.Source = Nothing
Throw New Exception("图片大小不足,长为 " & Image.Pic.Height & ",宽为 " & Image.Pic.Width)
End If
ImgBack.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 8, Scale * 8, Scale * 8, Scale * 8))
Log("[Skin] 载入头像成功:" & Loader.Name)
Catch ex As Exception
Log(ex, "载入头像失败(" & If(Address, "null") & "," & Loader.Name & ")", LogLevel.Hint)
End Try
@@ -224,7 +228,10 @@ Retry:
RunInUiWait(Sub()
Try
Dim CapeNames As New Dictionary(Of String, String) From {
{"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"}, {"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}
{"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"},
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -711,7 +711,11 @@ ExitRefresh:
'修改登陆方式
Select Case Setup.Get("LoginType")
Case McLoginType.Legacy
LabLaunchingMethod.Text = "离线登录"
If PageLinkHiper.HiperState = LoadState.Finished Then
LabLaunchingMethod.Text = "联机离线登录"
Else
LabLaunchingMethod.Text = "离线登录"
End If
Case McLoginType.Mojang
LabLaunchingMethod.Text = "Mojang 正版登录"
Case McLoginType.Ms
@@ -32,12 +32,9 @@
''' <summary>
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginLegacy
If FrmLoginLegacy Is Nothing Then
Return New McLoginLegacy With {.UserName = "", .SkinType = Setup.Get("LaunchSkinType"), .SkinName = Setup.Get("LaunchSkinID")}
Else
Return New McLoginLegacy With {.UserName = FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim, .SkinType = Setup.Get("LaunchSkinType"), .SkinName = Setup.Get("LaunchSkinID")}
End If
Public Shared Function GetLoginData() As McLoginData
Dim UserName As String = If(FrmLoginLegacy Is Nothing, "", FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim)
Return New McLoginLegacy With {.UserName = UserName, .SkinType = Setup.Get("LaunchSkinType"), .SkinName = Setup.Get("LaunchSkinID")}
End Function
''' <summary>
''' 当前页面的登录信息是否有效。
@@ -13,7 +13,7 @@
<TextBlock TextWrapping="Wrap" Text="PCL2 作者并不会从速聚的付费业务中获得任何分成、奖金等报酬,请不要瞎说。"
Margin="0,0,0,6" />
<local:MyListItem Title="速聚官网" Info="打开速聚的官方网站"
Type="Clickable" EventType="打开网页" EventData="https://www.the.bb/zh-cn"
Type="Clickable" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html"
PaddingRight="20" Logo="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyListItem Title="授权协议书" Info="查看速聚与 PCL2 间的授权协议书"
Type="Clickable" EventType="打开网页" EventData="https://shimo.im/docs/0l3NVXYzeXhb903R"
@@ -221,7 +221,7 @@
<TextBlock x:Name="LabFinishTitle" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="1"
Text="已加入 Herobrine 的房间" FontSize="20" Foreground="{DynamicResource ColorBrush3}" />
<TextBlock x:Name="LabFinishDesc" Grid.Column="3" Grid.ColumnSpan="3" Grid.Row="2" Margin="0,10,0,12"
Text="打开 MC 的多人游戏页面,然后稍等片刻,房间就会出现在服务器列表的最下方。"
Text="描述文本。"
FontSize="14" LineHeight="19" MaxWidth="400" TextWrapping="Wrap" Foreground="{StaticResource ColorBrushGray2}" />
<local:MyButton x:Name="BtnFinishCopy" Grid.Column="4" Grid.Row="3" Margin="0,0,15,0" Text="复制联机码" Padding="13,8" />
<local:MyButton x:Name="BtnFinishExit" Grid.Column="5" Grid.Row="3" Text="退出" Padding="13,8" />
@@ -230,7 +230,7 @@
</Grid>
</Grid>
<Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5">
<local:MyTextButton Text="联机服务由 速聚 授权提供" EventType="打开网页" EventData="https://www.the.bb/zh-cn" />
<local:MyTextButton Text="联机服务由 速聚 授权提供" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html" />
</Grid>
</Grid>
</local:MyPageRight>
@@ -0,0 +1,952 @@
Public Class PageLinkHiper
Public Const RequestVersion As Char = "2"
'记录的启动情况
Public Shared IsServerSide As Boolean
Private Shared HostIp As String
Private Shared HostPort As Integer
#Region "初始化"
'加载器初始化
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, InitLoader, AutoRun:=False)
'注册自定义的 OnStateChanged
AddHandler InitLoader.OnStateChangedUi, AddressOf OnLoadStateChanged
End Sub
Private IsLoad As Boolean = False
Private Sub OnLoaded() Handles Me.Loaded
If IsLoad Then Exit Sub
IsLoad = True
'启动监视线程
If Not IsWatcherStarted Then RunInNewThread(AddressOf WatcherThread, "Hiper Watcher")
'读取索引码
Try
Dim Time As String = Setup.Get("LinkHiperCertTime")
If Time = "" Then
Log("[HiPer] 没有缓存凭证")
ElseIf Date.Parse(Time) > Date.Now Then
TextCert.Text = Setup.Get("LinkHiperCertLast")
Log("[HiPer] 缓存凭证尚未过期:" & Time)
CurrentSubpage = Subpages.PanSelect
Else
Log("[HiPer] 缓存凭证已过期:" & Time)
LabCertTitle.Text = "输入索引码"
LabCertDesc.Text = "你的 HiPer 索引码已经过期,请输入新的索引码。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
End If
Catch ex As Exception
Log(ex, "读取缓存凭证失败")
Setup.Set("LinkHiperCertTime", "")
End Try
End Sub
#End Region
#Region "加载步骤"
Public Shared PathHiper As String = PathAppdata & "联机模块\"
Public Shared WithEvents InitLoader As New LoaderCombo(Of Integer)("HiPer 初始化", {
New LoaderTask(Of Integer, Integer)("网络环境:连通检测", AddressOf InitPingCheck) With {.Block = False, .ProgressWeight = 0.5},
New LoaderTask(Of Integer, Integer)("网络环境:IP 检测", AddressOf InitIpCheck) With {.Block = False, .ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("检查网络环境", AddressOf InitCheck) With {.ProgressWeight = 0.5},
New LoaderTask(Of Integer, List(Of NetFile))("获取所需文件", AddressOf InitGetFile) With {.ProgressWeight = 4},
New LoaderDownload("下载所需文件", New List(Of NetFile)) With {.ProgressWeight = 4},
New LoaderTask(Of Integer, Integer)("启动联机模块", AddressOf InitLaunch) With {.ProgressWeight = 7}
})
'检查网络状态
Private Shared Sub InitPingCheck(Task As LoaderTask(Of Integer, Integer))
PingTime = 0
Try
Log("[HiPer] 网络检测:连通检测开始")
Dim StartTime = Date.Now.Ticks
Dim Result As String = NetGetCodeByClient("https://www.baidu.com/duty/", Encoding.UTF8, 20000, "")
Dim DuringTime As Integer = (Date.Now.Ticks - StartTime) / 10000
If Result.Contains("百度") Then
Log("[HiPer] 网络检测:连通检测成功(" & DuringTime & "ms)")
PingTime = DuringTime
Else
Log("[HiPer] 网络检测:连通检测失败(获取的内容有误)")
PingTime = -1
End If
Catch ex As ThreadInterruptedException
Catch ex As Exception
Log(ex, "连通检测失败")
PingTime = -1
End Try
End Sub
Private Shared Sub InitIpCheck()
IpCheckStatus = LoadState.Loading
Try
Log("[HiPer] 网络检测:IP 地址检测开始")
Dim IpCheckResult As String = NetRequestOnce("https://ipinfo.io/json", "GET", "", "application/json", 10000)
Dim Country As String = GetJson(IpCheckResult)("country")
IpIsInChina = Country = "CN"
IpCheckStatus = LoadState.Finished
Log("[HiPer] 网络检测:IP 地址检测结果:" & Country)
Catch ex As ThreadInterruptedException
IpCheckStatus = LoadState.Aborted
Catch ex As Exception
Log(ex, "IP 地址检测失败")
IpCheckStatus = LoadState.Failed
IpIsInChina = True
End Try
End Sub
Private Shared PingTime As Integer, IpCheckStatus As LoadState = LoadState.Loading, IpIsInChina As Boolean
Private Shared Sub InitCheck(Task As LoaderTask(Of Integer, Integer))
'检查协议
If Not Setup.Get("LinkEula") Then
Reopen:
Select Case MyMsgBox("PCL2 的联机服务由速聚授权提供。" & vbCrLf & "在使用前,你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
Case 1
Setup.Set("LinkEula", True)
Case 2
Throw New Exception("$你拒绝了用户服务协议……")
Case 3
OpenWebsite("https://mp.weixin.qq.com/mp/appmsgalbum?__biz=MzkxMTMyODk3Mg==&action=getalbum&album_id=2585385685407514625&scene=173&from_msgid=2247483720&from_itemidx=1&count=3&nolastread=1#wechat_redirect")
GoTo Reopen
End Select
End If
'等待网络环境检查加载器结束
SetLoadDesc("正在检查网络环境……", "检查网络环境")
Do While Task.State = LoadState.Loading AndAlso Not (PingTime <> 0 AndAlso IpCheckStatus <> LoadState.Loading)
Thread.Sleep(50)
Loop
'获取网络环境检查结果
If IpCheckStatus = LoadState.Finished AndAlso Not IpIsInChina Then
If MyMsgBox("检测到你的 IP 不在中国,这会导致联机变得非常不稳定。" & vbCrLf &
"如果你正开着加速器或者 VPN,请先关闭它们,然后再继续……", "警告", "继续", "取消", IsWarn:=True, ForceWait:=True) = 2 Then
Throw New Exception("$请在关闭加速器或者 VPN 后点击重试。")
End If
Task.Progress = 0.5
InitIpCheck() '重新进行检查
End If
'没有联网
If IpCheckStatus = LoadState.Failed AndAlso PingTime = -1 Then
Throw New Exception("$PCL2 没法连上网……" & vbCrLf & "如果你改变了网络环境,请重启 PCL2。")
End If
End Sub
'获取所需文件
Private Shared Sub InitGetFile(Task As LoaderTask(Of Integer, List(Of NetFile)))
'初始化
SetLoadDesc("正在初始化……", "初始化")
Directory.CreateDirectory(PathHiper)
WriteFile(PathHiper & "HiPer 联机模块.vbs", "createobject(""wscript.shell"").run """"""" & PathHiper & "HiPer 联机模块.exe"""" v"", 0", Encoding:=Encoding.GetEncoding("GB18030")) '准备启动脚本
'获取索引码文件
SetLoadDesc("正在获取索引码文件……", "获取索引码文件")
Dim Cert As String = RunInUiWait(Function() FrmLinkHiper.TextCert.Text)
Log("[Hiper] 联机索引码:" & Cert)
If Cert = Setup.Get("LinkHiperCertLast") AndAlso File.Exists(PathHiper & "cert.yml") Then
Log("[Hiper] 索引码与上次输入的一致,跳过获取步骤")
Else
Dim CertRaw As String
Try
CertRaw = NetRequestOnce("https://cert.mcer.cn/" & Cert & ".yml", "GET", "", "")
Catch ex As Exception
If GetString(ex).Contains("(404)") Then
Throw New CertOutdatedException '索引码无效或已过期
ElseIf GetString(ex).Contains("too many requests") Then
Throw New Exception("你的尝试太频繁了,请暂时啥都别点,等两分钟后再试……")
Else
Throw
End If
End Try
If Not CertRaw.Contains("WARNING <<< AUTO SYNC AREA") Then Throw New Exception("获取到的索引码文件内容有误!")
WriteFile(PathHiper & "cert.yml", CertRaw)
Setup.Set("LinkHiperCertLast", Cert)
Setup.Set("LinkHiperCertTime", "")
End If
Task.Progress = 0.25
'获取 CPU 架构
SetLoadDesc("正在获取 CPU 架构……", "获取 CPU 架构")
Dim Architecture As String
Select Case GetType(String).Assembly.GetName().ProcessorArchitecture
Case Reflection.ProcessorArchitecture.X86
Architecture = "386"
Case Reflection.ProcessorArchitecture.Amd64
Architecture = "amd64"
Case Reflection.ProcessorArchitecture.Arm
Architecture = "arm64"
Case Else
Architecture = "arm64"
Log("[Hiper] 当前 CPU 架构为 " & GetStringFromEnum(GetType(String).Assembly.GetName().ProcessorArchitecture) & ",没有最适合的项,这可能会导致联机模块无法启动!", LogLevel.Debug)
End Select
Log("[Hiper] CPU 架构:" & Architecture)
'检查更新:hiper.exe
SetLoadDesc("正在检查联机模块本体更新……", "检查联机模块本体更新")
Dim RequiredFiles As New List(Of NetFile)
Dim Checksums As String = Nothing, ChecksumHiper As String = Nothing
If File.Exists(PathHiper & "HiPer 联机模块.exe") Then
Try
Checksums = NetGetCodeByDownload({
"http://mirror.hiper.cn.s2.the.bb/packages.sha1",
"http://mirror.hiper.cn.s3.the.bb:175/packages.sha1",
"https://gitcode.net/to/hiper/-/raw/master/packages.sha1",
"https://cert.mcer.cn/mirror/packages.sha1"
})
Catch ex As Exception
Log(ex, "获取联机模块更新信息失败,将会强制启动联机模块", LogLevel.Hint)
GoTo FinishHiperFileCheck
End Try
ChecksumHiper = RegexSeek(Checksums, "[0-9a-f]{40}(?= windows-" & Architecture & "/hiper.exe)")
If ChecksumHiper Is Nothing Then
Log("[Hiper] 未找到联机模块更新信息,将会强制启动联机模块", LogLevel.Hint)
GoTo FinishHiperFileCheck
End If
Log("[Hiper] hiper.exe 的所需 SHA1:" & ChecksumHiper)
If ChecksumHiper = GetAuthSHA1(PathHiper & "HiPer 联机模块.exe") Then
Log("[Hiper] hiper.exe 文件校验通过,无需重新下载")
GoTo FinishHiperFileCheck
End If
End If
Log("[Hiper] 需要重新下载 hiper.exe")
RequiredFiles.Add(New NetFile({"http://mirror.hiper.cn.s2.the.bb/windows-" & Architecture & "/hiper.exe",
"http://mirror.hiper.cn.s3.the.bb:175/windows-" & Architecture & "/hiper.exe",
"https://gitcode.net/to/hiper/-/raw/master/windows-" & Architecture & "/hiper.exe?inline=false",
"https://cert.mcer.cn/mirror/windows-" & Architecture & "/hiper.exe"},
PathHiper & "HiPer 联机模块.exe",
New FileChecker(Hash:=ChecksumHiper, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing,所以 Checksum 可以为 Nothing
FinishHiperFileCheck:
Task.Progress = 0.5
'检查更新:wintun.dll
Dim ChecksumWintun As String = Nothing
If File.Exists(PathHiper & "wintun.dll") Then
Try
If Checksums Is Nothing Then
Checksums = NetGetCodeByDownload({
"http://mirror.hiper.cn.s2.the.bb/packages.sha1",
"http://mirror.hiper.cn.s3.the.bb:175/packages.sha1",
"https://gitcode.net/to/hiper/-/raw/master/packages.sha1",
"https://cert.mcer.cn/mirror/packages.sha1"
})
End If
Catch ex As Exception
Log(ex, "获取联机模块更新信息失败,将会强制启动联机模块", LogLevel.Hint)
GoTo FinishWintunFileCheck
End Try
ChecksumWintun = RegexSeek(Checksums, "[0-9a-f]{40}(?= windows-" & Architecture & "/wintun.dll)")
If ChecksumWintun Is Nothing Then
Log("[Hiper] 未找到联机模块更新信息,将会强制启动联机模块", LogLevel.Hint)
GoTo FinishWintunFileCheck
End If
Log("[Hiper] wintun.dll 的所需 SHA1:" & ChecksumWintun)
If ChecksumWintun = GetAuthSHA1(PathHiper & "wintun.dll") Then
Log("[Hiper] wintun.dll 文件校验通过,无需重新下载")
GoTo FinishWintunFileCheck
End If
End If
Log("[Hiper] 需要重新下载 wintun.dll")
RequiredFiles.Add(New NetFile({"http://mirror.hiper.cn.s2.the.bb/windows-" & Architecture & "/wintun.dll",
"http://mirror.hiper.cn.s3.the.bb:175/windows-" & Architecture & "/wintun.dll",
"https://gitcode.net/to/hiper/-/raw/master/windows-" & Architecture & "/wintun.dll?inline=false",
"https://cert.mcer.cn/mirror/windows-" & Architecture & "/wintun.dll"},
PathHiper & "wintun.dll",
New FileChecker(Hash:=ChecksumWintun, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing,所以 Checksum 可以为 Nothing
FinishWintunFileCheck:
Task.Progress = 0.75
'检查更新:MCB
If Not IsServerSide Then
SetLoadDesc("正在检查联机模块组件更新……", "检查联机模块组件更新")
Dim ChecksumMcb As String = Nothing
If File.Exists(PathHiper & "MCB 联机模块.exe") Then
Try
Checksums = NetGetCodeByDownload({
"http://mirror.hiper.cn.s2.the.bb/utils/minecraft-broadcast/packages.sha1",
"http://mirror.hiper.cn.s3.the.bb:175/utils/minecraft-broadcast/packages.sha1",
"https://gitcode.net/to/hiper/-/raw/master/utils/minecraft-broadcast/packages.sha1",
"https://cert.mcer.cn/mirror/utils/minecraft-broadcast/packages.sha1"
})
Catch ex As Exception
Log(ex, "获取联机模块组件更新信息失败,将会强制启动联机模块组件", LogLevel.Hint)
GoTo FinishMcbFileCheck
End Try
ChecksumMcb = RegexSeek(Checksums, "[0-9a-f]{40}(?= mcb-windows-" & Architecture & ".exe)")
If ChecksumMcb Is Nothing Then
Log("[Hiper] 未找到联机模块组件更新信息,将会强制启动联机模块组件", LogLevel.Hint)
GoTo FinishMcbFileCheck
End If
Log("[Hiper] mcb.exe 的所需 SHA1:" & ChecksumMcb)
If ChecksumMcb = GetAuthSHA1(PathHiper & "MCB 联机模块.exe") Then
Log("[Hiper] mcb.exe 文件校验通过,无需重新下载")
GoTo FinishMcbFileCheck
End If
End If
Log("[Hiper] 需要重新下载 mcb.exe")
RequiredFiles.Add(New NetFile({
"http://mirror.hiper.cn.s2.the.bb/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe",
"http://mirror.hiper.cn.s3.the.bb:175/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe",
"https://gitcode.net/to/hiper/-/raw/master/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe?inline=false",
"https://cert.mcer.cn/mirror/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe"},
PathHiper & "MCB 联机模块.exe",
New FileChecker(Hash:=ChecksumMcb, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing,所以 Checksum 可以为 Nothing
FinishMcbFileCheck:
End If
'添加 point.yml
RequiredFiles.Add(New NetFile({"https://cert.mcer.cn/point.yml"}, PathHiper & "point.yml", New FileChecker(MinSize:=200)))
'开始下载
SetLoadDesc("正在下载联机模块……", "下载联机模块")
Task.Output = RequiredFiles
End Sub
Public Class CertOutdatedException
Inherits Exception
End Class
'启动联机模块
Private Shared Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
'关闭运行中的 HiPer,然后再刷新凭证文件
SetLoadDesc("正在关闭运行中的联机模块……", "关闭运行中的联机模块")
HiperStop(True)
'准备凭证文件
SetLoadDesc("正在准备索引码文件……", "准备索引码文件")
Dim CertFile As String = ReadFile(PathHiper & "cert.yml")
'添加防火墙配置
If IsServerSide Then
CertFile += ("\n\ninbound:\n port: " & HostPort & "\n proto: tcp\n host: any").Replace("\n", vbCrLf)
Else
CertFile += ("\n\noutbound:\n port: " & HostPort & "\n proto: tcp\n host: " & HostIp).Replace("\n", vbCrLf)
End If
CertFile += "\nlogging:\n format: json".Replace("\n", vbCrLf)
'更新 point.yml 段
Const SyncAreaRegex As String = "(?<=#[ ]*WARNING >>> AUTO SYNC AREA)[\s\S]+?(?=#[ ]*WARNING <<< AUTO SYNC AREA)"
CertFile = CertFile.Replace(RegexSeek(CertFile, SyncAreaRegex), RegexSeek(ReadFile(PathHiper & "point.yml"), SyncAreaRegex))
WriteFile(PathHiper & "config.yml", CertFile)
AllNodes = RegexSearch(CertFile.Replace(vbLf, "cr"), "(?<="")[0-9]+.[0-9]+.[0-9]+.[0-9]+(?=""( )?:( )?cr - "")").Distinct.
Where(Function(l) Not (l = "6.6.1.1" OrElse l = "6.6.2.2" OrElse l = "6.6.3.3")).ToList
If AllNodes.Count < 2 Then Throw New Exception("$索引码文件格式有误,未找到节点 IP!")
Task.Progress = 0.05
'尝试启动
HiperStart(Task) '启动失败会直接抛出异常
Task.Progress = 0.2
'检查连接情况
SetLoadDesc("正在连接到联机节点 (1/2)……" & If(IpIsInChina, "", vbCrLf & "由于网络不在中国,可能要花费很长时间。"), "检查联机节点")
If Not IsServerSide AndAlso HostIp = HiperIp Then Throw New Exception("$还搁这自己连自己?!不是吧?!")
Dim PingNodeResults As New List(Of Integer)
Dim UnpingedNodes As New List(Of String)(AllNodes)
Do Until PingNodeResults.Count >= 2 OrElse Task.IsAborted
Dim SelectedNode = RandomOne(UnpingedNodes)
Dim PingNode = Ping(SelectedNode, 4000)
If PingNode = -1 Then
Task.Progress += (If(PingNodeResults.Count = 0, 0.58, 0.88) - Task.Progress) * 0.3
Else
SetLoadDesc("正在连接到联机节点 (2/2)……" & If(IpIsInChina, "", vbCrLf & "由于网络不在中国,可能要花费很长时间。"), "检查联机节点")
Task.Progress = 0.6
PingNodeResults.Add(PingNode)
UnpingedNodes.Remove(SelectedNode)
End If
Loop
PingNodes = PingNodeResults.Min
Task.Progress = 0.9
'与房主 Ping 一下看看
If Not IsServerSide Then
SetLoadDesc("正在连接到房主……", "检查房主")
HostPing = -1 '实际上不使用本次 Ping 的结果,因为它真的偏大……
Do
Dim PingHost = Ping(HostIp, 4000, False)
If PingHost = -1 Then
Thread.Sleep(500)
Else
Exit Do
End If
Loop Until Task.IsAborted
'在等待 2 秒后再次触发 Ping,以刷新显示的 Ping
RunInNewThread(Sub()
Thread.Sleep(2000)
TaskPingHost.Start(True, IsForceRestart:=True)
End Sub, "HiPer Delayed Ping")
End If
'刷新完成页面
SetLoadDesc("正在加载完成页面……", "加载完成页面")
RunInUiWait(AddressOf FrmLinkHiper.WatcherTimer1)
End Sub
Private Shared PingNodes As Integer, AllNodes As List(Of String)
#End Region
#Region "进程管理"
Private Shared _HiperState As LoadState = LoadState.Waiting
Public Shared Property HiperState As LoadState
Get
Return _HiperState
End Get
Set(value As LoadState)
_HiperState = value
RunInUi(Sub() If FrmLinkLeft IsNot Nothing Then CType(FrmLinkLeft.ItemHiper.Buttons(0), MyIconButton).Visibility = If(HiperState = LoadState.Finished OrElse HiperState = LoadState.Loading, Visibility.Visible, Visibility.Collapsed))
End Set
End Property
Public Shared Sub ModuleStopManually() '关闭联机模块按钮
HiperExit(False)
End Sub
Private Shared HiperIp As String = Nothing
Private Shared HiperProcessId As Integer = -1, McbProcessId As Integer = -1
Private Shared HiperCertTime As Date = Date.Now
''' <summary>
''' 若程序正在运行,则结束程序进程,同时初始化状态数据。返回是否关闭了相关进程。
''' </summary>
Public Shared Function HiperStop(SleepWhenKilled As Boolean) As Boolean
HiperStop = False
'修改凭证
Dim ConfigContent As String = ReadFile(PathHiper & "config.yml")
If Not ConfigContent.Contains("enable: false") Then
WriteFile(PathHiper & "config.yml", ConfigContent & vbCrLf & "enable: false")
End If
'关闭所有进程
For Each ProcessObject In Process.GetProcesses
Dim IsHiper As Boolean = ProcessObject.ProcessName = "HiPer 联机模块"
Dim IsMcb As Boolean = ProcessObject.ProcessName = "MCB 联机模块"
If Not IsHiper AndAlso Not IsMcb Then Continue For
HiperStop = True
Try
If IsMcb Then
ProcessObject.Kill()
Log("[HiPer] 已结束进程 PID " & ProcessObject.Id & ":" & ProcessObject.ProcessName)
If HiperStop AndAlso SleepWhenKilled Then Thread.Sleep(1000) '等待 1 秒确认进程已退出
Else 'IsHiper
If SleepWhenKilled Then
Thread.Sleep(4000) '等待 4 秒确认进程已退出
If Not ProcessObject.HasExited Then
ProcessObject.Kill()
Log("[HiPer] 已结束进程 PID " & ProcessObject.Id & ":" & ProcessObject.ProcessName)
End If
End If
End If
Catch ex As Exception
Log(ex, "结束进程失败(" & ProcessObject.Id & "," & ProcessObject.ProcessName & ")")
End Try
Next
'初始化
HiperState = LoadState.Waiting
HiperProcessId = -1 : McbProcessId = -1
HiperCertTime = Nothing
End Function
''' <summary>
''' 启动程序,并等待初始化完成后退出运行,同时更新 HiperIp。
''' 若启动失败,则会直接抛出异常。
''' 若程序正在运行,则会先停止其运行。
''' </summary>
Public Shared Sub HiperStart(Task As LoaderTask(Of Integer, Integer))
Try
SetLoadDesc("正在启动联机模块……", "启动联机模块")
PossibleFailReason = Nothing
'启动 Hiper
Log("[Hiper] 启动 Hiper 进程")
DeleteDirectory(PathHiper & "logs") '清理日志
Dim HiperInfo = New ProcessStartInfo With {
.FileName = "wscript",
.Arguments = """" & PathHiper & "HiPer 联机模块.vbs""",
.Verb = "runas" '需要管理员权限
}
Dim HiperVbsProcess As New Process() With {.StartInfo = HiperInfo}
HiperVbsProcess.Start()
'查找真正的 Hiper 进程
SetLoadDesc("联机模块正在启动……", "联机模块加载")
Do
Dim GotProcesses = Process.GetProcesses.
Where(Function(l) l.ProcessName = "HiPer 联机模块" AndAlso Math.Abs((l.StartTime - Date.Now).TotalMinutes) < 1)
If GotProcesses.Count > 0 Then
HiperProcessId = GotProcesses.First.Id
Log("[Hiper] 已发现 Hiper 进程,PID:" & HiperProcessId)
Exit Do
End If
Thread.Sleep(50)
Loop While Task.State = LoadState.Loading AndAlso Not Task.IsAborted
If HiperProcessId = -1 Then Throw New Exception("联机模块未能成功启动!")
HiperState = LoadState.Loading
Task.Progress = 0.15
'抓取日志
Dim LogLine As Integer = 0
Do
Thread.Sleep(100)
If Not File.Exists(PathHiper & "logs\hiper.log") Then Continue Do
Dim LogLines As String() = ReadFile(PathHiper & "logs\hiper.log").TrimEnd(vbLf).Split(vbLf)
For i = LogLine To LogLines.Count - 1
HiperLogLine(LogLines(i), Task)
Next
LogLine = LogLines.Count
Loop While HiperState = LoadState.Loading AndAlso Not Task.IsAborted AndAlso Process.GetProcesses.Any(Function(l) l.Id = HiperProcessId)
'输出
If HiperState = LoadState.Finished Then
Log("[Hiper] Hiper 启动完成")
ElseIf PossibleFailReason IsNot Nothing AndAlso PossibleFailReason.Contains("索引码已过期") Then
Throw New CertOutdatedException()
Else
Throw New Exception(If(PossibleFailReason, "联机模块因未知原因启动失败!"))
End If
'启动 MCB
Task.Progress = 0.25
If Not IsServerSide Then
Try
Log("[Hiper] 启动 MCB 进程")
Dim McbInfo = New ProcessStartInfo With {
.FileName = PathHiper & "MCB 联机模块.exe", .WorkingDirectory = PathHiper,
.UseShellExecute = False, .CreateNoWindow = True,
.RedirectStandardError = True, .RedirectStandardOutput = True,
.Arguments = "-addr " & HostIp & ":" & HostPort & " -motd ""PCL2 联机房间"""
}
Dim McbProcess As New Process() With {.StartInfo = McbInfo}
McbProcess.Start()
McbProcessId = McbProcess.Id
Catch ex As Exception
Throw New Exception("联机模块组件启动失败", ex)
End Try
End If
Catch ex As Exception
Try
HiperStop(True) '由于启动失败停止进程
Catch
End Try
HiperState = LoadState.Failed
Throw
End Try
End Sub
'Hiper 日志
Private Shared Sub HiperLogLine(Content As String, Task As LoaderTask(Of Integer, Integer))
'检查报错
Dim ContentTest As String = Content.ToLower
Dim ErrorMessage As String = Nothing
Dim ContentJson As JObject = Nothing
If Content.StartsWith("{""") AndAlso Content.EndsWith("}") Then
ContentJson = GetJson(Content)
ContentTest = If(ContentJson("error"), ContentJson("msg")).ToString.ToLower
ErrorMessage = ContentJson("error")
End If
If ContentTest.Contains("hiper certificate for this host is expired") Then
PossibleFailReason = "$你的索引码已过期,请更换新的索引码!"
ElseIf ContentTest.Contains("error creating interface: access is denied") Then
PossibleFailReason = "$没有获得管理员权限,无法创建网络通道!"
ElseIf ContentTest.Contains("cannot create a file when that file already exists") Then
PossibleFailReason = "$请不要重复开启多个联机模块!"
ElseIf Content.Contains("failed to load config") Then
PossibleFailReason = "$索引码文件内容存在错误!"
ElseIf Content.Contains("system cannot find the file specified") Then
PossibleFailReason = "$创建网络通道失败!" & vbCrLf & "如果你曾启动过 VPN 软件,请先打开那个软件,然后关掉它,最后再重试。虽然不知道为啥,但这样大概管用……"
End If
If PossibleFailReason Is Nothing AndAlso ErrorMessage IsNot Nothing Then PossibleFailReason = ErrorMessage
'检查结束
If ContentJson IsNot Nothing Then
Dim Message As String = ContentJson("msg")
If Message = "HiPer interface is active" Then
HiperIp = ContentJson("network").ToString.Split("/").First
If IsServerSide Then HostIp = HiperIp
Log("[Hiper] Hiper 启动完成,IP:" & HiperIp)
HiperState = LoadState.Finished
ElseIf Message = "Validity of client certificate" Then
Dim VaildTime As String = ContentJson("valid")
Date.TryParseExact(VaildTime, "yyyy-MM-dd HH:mm:ss", Globalization.CultureInfo.InvariantCulture, Globalization.DateTimeStyles.None, HiperCertTime)
Log("[Hiper] 索引码到期时间:" & HiperCertTime.ToString)
Setup.Set("LinkHiperCertTime", HiperCertTime.ToString)
End If
End If
'写入日志
If ModeDebug OrElse Content.Contains("""error""") Then Log("[Hiper] " & Content)
End Sub
Private Shared PossibleFailReason As String = Nothing
#End Region
#Region "监视线程"
'主 Timer 线程
Private IsWatcherStarted As Boolean = False
Private Sub WatcherThread()
Dim Sec15 As Integer = 0
Do While True
Try
For i = 1 To 5
Thread.Sleep(200)
If InitLoader.State = LoadState.Loading Then
RunInUi(AddressOf UpdateProgress)
End If
Next
Thread.Sleep(1000)
Sec15 += 1
WatcherTimer1()
If Sec15 = 15 Then
Sec15 = 0
WatcherTimer15()
End If
Catch ex As Exception
Log(ex, "联机模块主时钟出错", LogLevel.Feedback)
Thread.Sleep(20000)
End Try
Loop
End Sub
'每 1 秒执行的 Timer
Private Sub WatcherTimer1()
If HiperState <> LoadState.Finished Then Exit Sub
RunInUi(Sub()
'索引码剩余时间
Dim Span As TimeSpan = HiperCertTime - Date.Now
If Span.TotalDays >= 30 Then
LabFinishTime.Text = "> 30 天"
ElseIf Span.TotalDays >= 4 Then
LabFinishTime.Text = Span.Days & " 天"
ElseIf Span.TotalDays >= 1 Then
LabFinishTime.Text = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
ElseIf Span.TotalMinutes >= 10 Then
LabFinishTime.Text = Span.Hours & ":" & Span.Minutes.ToString.PadLeft(2, "0") & "'"
Else
LabFinishTime.Text = Span.Minutes & "'" & Span.Seconds.ToString.PadLeft(2, "0") & """"
End If
'提示索引码即将到期
If Span.TotalSeconds <= 5 * 60 AndAlso Span.TotalSeconds > 5 * 60 - 1 AndAlso Setup.Get("LinkHiperCertWarn") Then
MyMsgBox("你的索引码还有不到 5 分钟就要过期了!" & vbCrLf & "你可以在设置中关闭这个提示……", "索引码即将过期", "我知道了……")
ShowWindowToTop(Handle)
Beep()
End If
'检查索引码到期
If Span.TotalSeconds < 2 Then
LabCertTitle.Text = "索引码已过期"
LabCertDesc.Text = "你的 HiPer 索引码已经过期,请输入新的索引码。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
TextCert.Text = ""
HiperExit(True)
ShowWindowToTop(Handle)
Beep()
Exit Sub
End If
'网络质量
Dim QualityScore As Integer = If(IpIsInChina, 0, -2)
QualityScore -= Math.Ceiling((Math.Min(PingTime, 600) + Math.Min(PingNodes, 600)) / 80)
Select Case QualityScore
Case Is >= -1
LabFinishQuality.Text = "优秀"
Case Is >= -2
LabFinishQuality.Text = "优良"
Case Is >= -3
LabFinishQuality.Text = "良好"
Case Is >= -5
LabFinishQuality.Text = "一般"
Case Is >= -7
LabFinishQuality.Text = "较差"
Case Else
LabFinishQuality.Text = "很差"
End Select
'Ping
If HostPing <> -1 Then
If FrmLinkHiper IsNot Nothing AndAlso FrmLinkHiper.LabFinishPing.IsLoaded Then
FrmLinkHiper.LabFinishPing.Text = HostPing & "ms"
End If
End If
End Sub)
End Sub
'每 15 秒执行的 Timer
Private Shared HostPing As Integer = -1
Private Sub WatcherTimer15()
If Not (HiperState = LoadState.Finished OrElse HiperState = LoadState.Loading) Then Exit Sub
'检查 HiPer 崩溃
Try
Process.GetProcessById(HiperProcessId)
Catch
Dim LogLines = ReadFile(PathHiper & "logs\hiper.log").TrimEnd(vbLf).Split(vbLf)
HiperExit(False)
MyMsgBox("由于联机模块异常退出,已退出联机房间。" & vbCrLf & vbCrLf &
"联机模块最后的日志:" & vbCrLf & Join(LogLines.Skip(LogLines.Count - 3).ToList, vbCrLf), "联机断开")
End Try
'下面的部分需要完全完成加载
If HiperState <> LoadState.Finished Then Exit Sub
'检查 MCB 崩溃
Try
If Not IsServerSide Then Process.GetProcessById(McbProcessId)
Catch
HiperExit(False)
MyMsgBox("由于 MCB 联机模块异常退出,已退出联机房间。", "联机断开")
End Try
'重新检查 Ping
If Not IsServerSide Then
Dim PingHostFailedCount As Integer = 0
Do
TaskPingHost.WaitForExit(True, IsForceRestart:=True)
If TaskPingHost.Output = -1 Then
PingHostFailedCount += 1
Log("[HiPer] Ping 房主失败(第 " & PingHostFailedCount & " 次)")
If PingHostFailedCount >= 3 Then
HiperExit(False) : MyMsgBox("与房主断开连接,已退出联机房间。", "联机断开") : Exit Sub
End If
Else
If PingHostFailedCount > 0 Then Log("[HiPer] Ping 房主已恢复成功(" & HostPing & "ms)")
Exit Do
End If
Loop While True
End If
End Sub
#End Region
#Region "PanCert | 索引码输入页面"
'检测输入
Private Sub TextCert_ValidateChanged(sender As Object, e As EventArgs) Handles TextCert.ValidateChanged
BtnCertDone.IsEnabled = TextCert.ValidateResult = ""
End Sub
Private Sub TextCert_KeyUp(sender As Object, e As KeyEventArgs) Handles TextCert.KeyUp
If e.Key = Key.Enter AndAlso BtnCertDone.IsEnabled Then BtnCertDone_Click() '允许回车确认
End Sub
'确认
Private Sub BtnCertDone_Click() Handles BtnCertDone.Click
CurrentSubpage = Subpages.PanSelect
End Sub
#End Region
#Region "PanSelect | 种类选择页面"
'返回
Private Sub BtnSelectReturn_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectReturn.MouseLeftButtonUp
LabCertTitle.Text = "输入索引码"
LabCertDesc.Text = "你需要获取索引码才能使用 HiPer。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
CurrentSubpage = Subpages.PanCert
End Sub
'创建房间
Private Sub BtnSelectCreate_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectCreate.MouseLeftButtonUp
'获取端口号
Dim PortInput As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {
New ValidateInteger(2, 65535),
New ValidateExceptSame({"55555", "55557"}, "端口不能为 %!")
}, "在 MC 的暂停画面选择【对局域网开放】", "输入端口号", "确定", "取消")
If PortInput Is Nothing Then Exit Sub
'开始
RoomCreate(Val(PortInput))
End Sub
Private Sub RoomCreate(Port As Integer)
'记录信息
HostIp = Nothing : HostPort = Port
IsServerSide = True
'启动
InitLoader.Start(IsForceRestart:=True)
End Sub
'加入房间
Private Sub BtnSelectJoin_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectJoin.MouseLeftButtonUp
'获取信息
Dim Code As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateLength(8, 99)}, "",
"输入联机码", "确定", "取消")
If Code Is Nothing Then Exit Sub
'记录信息
If Not Code.EndsWith(RequestVersion) OrElse Not Code.StartsWith("P") Then GoTo WrongCode
Dim Ip As String, Port As Integer
Try
Dim IpAndPort As Long = RadixConvert(Code.Substring(1, Code.Length - 2).ToUpper, 36, 10)
'IpAndPort = HostPort + IpParts(0) * 65536 + IpParts(1) * 65536 * 256 + IpParts(2) * 65536 * 256 * 256 + IpParts(3) * 65536 * 256 * 256 * 256
Ip = Math.Floor(IpAndPort / (65536L * 256 * 256 * 256))
IpAndPort = IpAndPort Mod (65536L * 256 * 256 * 256)
Ip = Math.Floor(IpAndPort / (65536L * 256 * 256)) & "." & Ip
IpAndPort = IpAndPort Mod (65536L * 256 * 256)
Ip = Math.Floor(IpAndPort / (65536L * 256)) & "." & Ip
IpAndPort = IpAndPort Mod (65536L * 256)
Ip = Math.Floor(IpAndPort / (65536L)) & "." & Ip
Port = IpAndPort Mod 65536
Catch
GoTo WrongCode
End Try
'启动
RoomJoin(Ip, Port)
Exit Sub
WrongCode:
If Not Code.StartsWith("P") AndAlso Code.Length >= 49 Then Hint("你输入的可能是 IOI 的联机码,请在左侧的联机方式中选择 IOI!", HintType.Critical) : Exit Sub
If Code.StartsWith("P") AndAlso Not Code.EndsWith(RequestVersion) Then Hint("你的 PCL2 版本与房主的 PCL2 版本不一致!", HintType.Critical) : Exit Sub
Hint("你输入的联机码无效!", HintType.Critical)
End Sub
Private Sub RoomJoin(Ip As String, Port As Integer)
'记录信息
HostIp = Ip : HostPort = Port
IsServerSide = False
'启动
InitLoader.Start(IsForceRestart:=True)
End Sub
#End Region
#Region "PanLoad | 加载中页面"
'承接状态切换的 UI 改变
Private Sub OnLoadStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
Select Case NewState
Case LoadState.Loading
UpdateProgress(0)
If IsServerSide Then
LabLoadTitle.Text = "正在创建联机房间"
Log("[Hiper] 正在创建联机房间,端口 " & HostPort)
Else
LabLoadTitle.Text = "正在加入联机房间"
Log("[Hiper] 正在加入联机房间,目标 IP " & HostIp & ":" & HostPort)
End If
LabLoadDesc.Text = "正在初始化……"
LoadStep = "准备初始化"
Case LoadState.Failed
UpdateProgress(1)
If IsServerSide Then
LabLoadTitle.Text = "创建联机房间失败"
Else
LabLoadTitle.Text = "加入联机房间失败"
End If
Dim RealException As Exception = If(Loader.Error.InnerException, Loader.Error)
If TypeOf RealException Is CertOutdatedException Then
LabCertTitle.Text = "索引码无效"
LabCertDesc.Text = "你的 HiPer 索引码无效或者已经过期!" & vbCrLf & "请重新输入索引码。"
HiperExit(True)
ElseIf RealException.Message.StartsWith("$") Then
LabLoadDesc.Text = RealException.Message.TrimStart("$") & vbCrLf &
"点击镐子重试,或者点击灰色的 × 取消。"
Else
LabLoadDesc.Text = LoadStep & "失败:" & GetString(RealException) & vbCrLf &
"点击镐子重试,或者点击灰色的 × 取消。"
End If
Log(Loader.Error, "HiPer 联机尝试失败")
Case LoadState.Finished
UpdateProgress(1)
CurrentSubpage = Subpages.PanFinish
BtnFinishPing.Visibility = If(IsServerSide, Visibility.Collapsed, Visibility.Visible)
LineFinishPing.Visibility = If(IsServerSide, Visibility.Collapsed, Visibility.Visible)
BtnFinishCopy.Visibility = If(IsServerSide, Visibility.Visible, Visibility.Collapsed)
If IsServerSide Then
LabFinishTitle.Text = "已创建联机房间"
LabFinishDesc.Text = "已在端口 " & HostPort & " 创建了联机房间。" & vbCrLf & "点击下方的复制联机码按钮,然后把联机码发给朋友吧!"
Else
LabFinishTitle.Text = "已加入联机房间"
LabFinishDesc.Text = "启动游戏,进入多人游戏页面后稍等片刻,房间就会出现在服务器列表的最下方。" & vbCrLf & "如果提示无效会话,不要退出联机房间,重新启动游戏即可!"
End If
LabFinishIp.Text = HostIp & ":" & HostPort
Log("[Hiper] 已完成连接")
End Select
End Sub
Private Shared LoadStep As String = "准备初始化"
Private Shared Sub SetLoadDesc(Intro As String, [Step] As String)
Log("[Hiper] 连接步骤:" & Intro)
LoadStep = [Step]
RunInUiWait(Sub()
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.LabLoadDesc.IsLoaded Then Exit Sub
FrmLinkHiper.LabLoadDesc.Text = Intro
FrmLinkHiper.UpdateProgress()
End Sub)
End Sub
'承接重试
Private Sub CardLoad_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles CardLoad.MouseLeftButtonUp
If Not InitLoader.State = LoadState.Failed Then Exit Sub
InitLoader.Start(IsForceRestart:=True)
End Sub
'取消加载
Private Sub CancelLoad() Handles BtnLoadCancel.Click
If InitLoader.State = LoadState.Loading Then
CurrentSubpage = Subpages.PanSelect
InitLoader.Abort()
Else
InitLoader.State = LoadState.Waiting
End If
HiperStop(False)
End Sub
'进度改变
Private Sub UpdateProgress(Optional Value As Double = -1)
If Value = -1 Then Value = InitLoader.Progress
Dim DisplayingProgress As Double = ColumnProgressA.Width.Value
If Math.Round(Value - DisplayingProgress, 3) = 0 Then Exit Sub
If DisplayingProgress > Value Then
ColumnProgressA.Width = New GridLength(Value, GridUnitType.Star)
ColumnProgressB.Width = New GridLength(1 - Value, GridUnitType.Star)
AniStop("Hiper Progress")
Else
Dim NewProgress As Double = If(Value = 1, 1, (Value - DisplayingProgress) * 0.2 + DisplayingProgress)
AniStart({
AaGridLengthWidth(ColumnProgressA, NewProgress - ColumnProgressA.Width.Value, 300, Ease:=New AniEaseOutFluent),
AaGridLengthWidth(ColumnProgressB, (1 - NewProgress) - ColumnProgressB.Width.Value, 300, Ease:=New AniEaseOutFluent)
}, "Hiper Progress")
End If
End Sub
Private Sub CardResized() Handles CardLoad.SizeChanged
RectProgressClip.Rect = New Rect(0, 0, CardLoad.ActualWidth, 12)
End Sub
#End Region
#Region "PanFinish | 加载完成页面"
'复制 IP
Private Sub BtnFinishIp_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishIp.MouseLeftButtonUp
ClipboardSet(LabFinishIp.Text)
End Sub
'退出
Private Sub BtnFinishExit_Click(sender As Object, e As EventArgs) Handles BtnFinishExit.Click
If IsServerSide AndAlso MyMsgBox("你确定要关闭联机房间吗?", "确认退出", "确定", "取消", IsWarn:=True) = 2 Then Exit Sub
HiperExit(False)
End Sub
'复制联机码
Private Sub BtnFinishCopy_Click(sender As Object, e As EventArgs) Handles BtnFinishCopy.Click
Dim IpParts = HostIp.Split(".").Select(Function(l) Val(l)).ToList
Dim IpAndPort As Long = HostPort + IpParts(0) * 65536 + IpParts(1) * 65536 * 256 + IpParts(2) * 65536 * 256 * 256 + IpParts(3) * 65536 * 256 * 256 * 256
ClipboardSet("P" & RadixConvert(IpAndPort, 10, 36) & RequestVersion, False)
Hint("已复制联机码!", HintType.Finish)
End Sub
'Ping 房主
Private Sub BtnFinishPing_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishPing.MouseLeftButtonUp
LabFinishPing.Text = "检测中"
If TaskPingHost.State = LoadState.Loading Then Exit Sub
TaskPingHost.Start(True, IsForceRestart:=True)
End Sub
Private Shared TaskPingHost As New LoaderTask(Of Boolean, Integer)("HiPer Ping Host",
Sub(Task As LoaderTask(Of Boolean, Integer))
HostPing = -1
HostPing = Ping(HostIp, 5000, Task.Input)
End Sub)
#End Region
#Region "子页面管理"
Public Enum Subpages
PanCert
PanSelect
PanFinish
End Enum
Private _CurrentSubpage As Subpages = Subpages.PanCert
Public Property CurrentSubpage As Subpages
Get
Return _CurrentSubpage
End Get
Set(value As Subpages)
If _CurrentSubpage = value Then Exit Property
_CurrentSubpage = value
Log("[Hiper] 子页面更改为 " & GetStringFromEnum(value))
PageOnContentExit()
If value = Subpages.PanSelect Then
LabSelectCode.Text = "(" & TextCert.Text.Substring(0, Math.Min(TextCert.Text.Length, 3)) & "…)"
End If
End Set
End Property
Private Sub PageLinkHiper_OnPageEnter() Handles Me.PageEnter
FrmLinkHiper.PanCert.Visibility = If(CurrentSubpage = Subpages.PanCert, Visibility.Visible, Visibility.Collapsed)
FrmLinkHiper.PanSelect.Visibility = If(CurrentSubpage = Subpages.PanSelect, Visibility.Visible, Visibility.Collapsed)
FrmLinkHiper.PanFinish.Visibility = If(CurrentSubpage = Subpages.PanFinish, Visibility.Visible, Visibility.Collapsed)
End Sub
Private Shared Sub HiperExit(ExitToCertPage As Boolean)
Log("[Hiper] 要求退出 Hiper(当前加载器状态为 " & GetStringFromEnum(InitLoader.State) & ")")
HiperStop(False)
If InitLoader.State = LoadState.Loading Then InitLoader.Abort()
If InitLoader.State = LoadState.Failed Then InitLoader.State = LoadState.Waiting
RunInUi(Sub()
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.IsLoaded Then Exit Sub
FrmLinkHiper.CurrentSubpage = If(ExitToCertPage, Subpages.PanCert, Subpages.PanSelect)
FrmLinkHiper.PageOnContentExit()
End Sub)
End Sub
#End Region
End Class
@@ -44,7 +44,7 @@
<local:MyLoading Text="正在加载联机模块" Margin="20,20,20,17" x:Name="Load" ShowProgress="True" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
<Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5">
<local:MyTextButton Text="联机服务由 速聚 授权提供" EventType="打开网页" EventData="https://www.the.bb/zh-cn" />
<local:MyTextButton Text="联机服务由 速聚 授权提供" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html" />
</Grid>
</Grid>
</local:MyPageRight>
File diff suppressed because it is too large. Load diff
@@ -18,7 +18,6 @@
<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" />
<local:MyListItem x:Name="ItemVote" IsScaleAnimationEnabled="False" Type="Clickable" Tag="4" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="新功能投票"
EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8"
LogoScale="0.92" Logo="M979 1024H45c-24.9 0-45-20.1-45-45s20.1-45 45-45h934c24.9 0 45 20.1 45 45s-20.1 45-45 45zM135 887C60.6 887 0 826.4 0 752V334c0-74.4 60.6-135 135-135s135 60.6 135 135v418c0 74.4-60.6 135-135 135z m0-598c-24.8 0-45 20.2-45 45v418c0 24.8 20.2 45 45 45s45-20.2 45-45V334c0-24.8-20.2-45-45-45zM512 887c-74.4 0-135-60.6-135-135V532c0-74.4 60.6-135 135-135s135 60.6 135 135v220c0 74.4-60.6 135-135 135z m0-400c-24.8 0-45 20.2-45 45v220c0 24.8 20.2 45 45 45s45-20.2 45-45V532c0-24.8-20.2-45-45-45zM889 887c-74.4 0-135-60.6-135-135V135C754 60.6 814.6 0 889 0s135 60.6 135 135v617c0 74.4-60.6 135-135 135z m0-797c-24.8 0-45 20.2-45 45v617c0 24.8 20.2 45 45 45s45-20.2 45-45V135c0-24.8-20.2-45-45-45z" />
</StackPanel>
</local:MyPageLeft>
@@ -122,9 +122,17 @@
FrmOtherHelp.SearchBox.Text = ""
End Sub
'打开反馈
'打开网页
Public Shared Sub TryFeedback() Handles ItemFeedback.Click
If CanFeedback(True) Then Feedback(True, False)
If Not CanFeedback(True) Then Exit Sub
If MyMsgBox("是否要打开反馈列表网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"提醒", "打开", "取消") = 2 Then Exit Sub
Feedback(True, False)
End Sub
Public Shared Sub TryVote() Handles ItemVote.Click
If MyMsgBox("是否要打开新功能投票网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"提醒", "打开", "取消") = 2 Then Exit Sub
OpenWebsite("https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8?discussions_q=category%3A%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8+sort%3Adate_created")
End Sub
End Class
@@ -211,24 +211,28 @@
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="高级设置" IsSwaped="True" CanSwap="True">
<StackPanel Margin="25,40,25,15">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<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" />
<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" />
</Grid>
<local:MyCheckBox Margin="0,10,0,4" Text="关闭文件校验" x:Name="CheckAdvanceAssets" Tag="LaunchAdvanceAssets" Grid.Column="1" ToolTip="在启动 Minecraft 时,不校验 libraries 文件夹、第三方登录库与版本主 jar 文件,不更改 assets 文件夹。&#xA;如果你没有修改相关文件,请勿勾选此项。&#xA;更推荐在版本设置中关闭特定版本的校验,而不是在这里关闭所有版本的校验。" ToolTipService.ShowDuration="2333333" />
</StackPanel>
<Grid Margin="25,40,25,15">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<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" />
<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" />
<StackPanel Margin="0,10,0,4" Orientation="Horizontal" Grid.Row="3" Grid.ColumnSpan="2">
<local:MyCheckBox Text="忽略 Java 兼容性警告" x:Name="CheckAdvanceJava" Tag="LaunchAdvanceJava" Margin="0,0,60,0"
ToolTip="如果在设置中手动选择了与当前版本不兼容的 Java,则自动跳过兼容性警告弹窗,强制使用手动选择的 Java。" ToolTipService.ShowDuration="2333333" />
<local:MyCheckBox Text="关闭文件校验" x:Name="CheckAdvanceAssets" Tag="LaunchAdvanceAssets"
ToolTip="在启动时不校验 libraries 文件夹、第三方登录库与版本主 jar 文件,不更改 assets 文件夹。&#xA;如果你没有修改相关文件,请勿勾选此项。&#xA;更推荐在版本设置中关闭特定版本的校验,而不是在这里关闭所有版本的校验。" ToolTipService.ShowDuration="2333333" />
</StackPanel>
</Grid>
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
@@ -48,6 +48,7 @@
TextAdvanceJvm.Text = Setup.Get("LaunchAdvanceJvm")
TextAdvanceGame.Text = Setup.Get("LaunchAdvanceGame")
CheckAdvanceAssets.Checked = Setup.Get("LaunchAdvanceAssets")
CheckAdvanceJava.Checked = Setup.Get("LaunchAdvanceJava")
Catch ex As NullReferenceException
Log(ex, "启动设置项存在异常,已被自动重置", LogLevel.Msgbox)
@@ -74,6 +75,7 @@
Setup.Reset("LaunchSkinID")
Setup.Reset("LaunchAdvanceJvm")
Setup.Reset("LaunchAdvanceGame")
Setup.Reset("LaunchAdvanceJava")
Setup.Reset("LaunchAdvanceAssets")
Setup.Reset("LaunchArgumentJavaAll")
@@ -102,7 +104,7 @@
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
@@ -23,6 +23,7 @@
<RowDefinition Height="27" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表获取" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1">
@@ -45,7 +46,9 @@
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="5" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1" />
<TextBlock VerticalAlignment="Top" Grid.Row="6" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" />
<TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xA;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="6" Grid.Column="1" VerticalAlignment="Center" />
<!--<local:MyCheckBox Text="若版本列表并非从官方源获取,显示版本列表可能过期的提示" Grid.ColumnSpan="2" Grid.Row="3" x:Name="CheckDownloadOutOfDate" Tag="ToolDownloadOutOfDate" Height="22" Margin="0,2,0,8" />-->
<local:MyCheckBox Margin="0,2,0,4" Text="安装 CurseForge 整合包时保留原始压缩包" Grid.Row="7" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack"
ToolTip="安装 CurseForge 整合包后,在版本文件夹下保留用于安装的 原始整合包.zip 文件" />
</Grid>
</StackPanel>
</local:MyCard>
@@ -56,6 +56,7 @@
SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed")
ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion")
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack")
'Minecraft 更新提示
CheckUpdateRelease.Checked = Setup.Get("ToolUpdateRelease")
@@ -84,6 +85,7 @@
Setup.Reset("ToolDownloadSpeed")
Setup.Reset("ToolDownloadVersion")
Setup.Reset("ToolDownloadTranslate")
Setup.Reset("ToolDownloadKeepModpack")
Setup.Reset("ToolUpdateRelease")
Setup.Reset("ToolUpdateSnapshot")
Setup.Reset("ToolHelpChinese")
@@ -105,7 +107,7 @@
End Sub
'将控件改变路由到设置改变
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadKeepModpack.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change
@@ -206,7 +208,7 @@
If MyMsgBox("若选择此项,即使在将来出现严重问题时,你也无法获取相关通知。" & vbCrLf &
"例如,如果发现某个版本游戏存在严重 Bug,你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf &
"一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "继续", "取消") = 2 Then
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemActivity.SelectedItem = e.RemovedItems(0)
End If
End If
@@ -217,7 +219,7 @@
If MyMsgBox("若选择此项,即使在启动器将来出现严重问题时,你也无法获取更新并获得修复。" & vbCrLf &
"例如,如果官方修改了登录方式,从而导致现有启动器无法登录,你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf &
"一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "继续", "取消") = 2 Then
"除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemUpdate.SelectedItem = e.RemovedItems(0)
End If
End If
@@ -736,7 +736,6 @@
<ItemGroup>
<Resource Include="Resources\Font.ttf" />
<None Include="Resources\Help.zip" />
<None Include="Resources\ModData.json" />
<None Include="Resources\NAudio.dll" />
</ItemGroup>
<ItemGroup>
@@ -868,9 +867,6 @@
<Resource Include="Images\Heads\DoodleHuang.png" />
<Resource Include="Images\Heads\wiki.png" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\noin.png" />
</ItemGroup>
<ItemGroup>
<WCFMetadata Include="Connected Services\" />
</ItemGroup>
@@ -900,5 +896,17 @@
<ItemGroup>
<None Include="Resources\java-wrapper.jar" />
</ItemGroup>
<ItemGroup>
<Resource Include="Resources\ModData.txt" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Skins\Ari.png" />
<Resource Include="Images\Skins\Efe.png" />
<Resource Include="Images\Skins\Kai.png" />
<Resource Include="Images\Skins\Makena.png" />
<Resource Include="Images\Skins\Noor.png" />
<Resource Include="Images\Skins\Sunny.png" />
<Resource Include="Images\Skins\Zuri.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>
Binary file not shown.
@@ -1 +0,0 @@
{"better-gui-scaling":"4908|更好的界面缩放 (Better GUI Scaling)","jei-lotr":"4481|~","reskillable-psi-compat":"5768|~","mob-origins":"3603|生物起源*","lods-of-emone":"3166|很多钱 (Lods of Emone)","loottweaker":"2304|~","fnars-roguelike-dungeons":"5339|冒险地牢-Fnar版 (Roguelike Dungeons -- Fnar's Edition)","hunterillager":"2735|邪猎者 (HunterIllager)|936480","all-the-tweaks":"6194|~","health-overlay":"1871|更美观的血条*","nyfs-quivers-expanded":"6622|~","zettai-psi":"5769|~","titles":"4909|头衔*","capes":"4482|~","fabric-language-scala":"3167|~","better-storage":"534|更好的储存*","better-default-biomes":"3604|更好的默认生物群系*","make-zoom-zoom":"1440|更快的加载 (MakeZoomZoom)","runelic":"6195|~","auto-feeder-helmet":"1872|自动进食头盔*","projecte":"577|等价交换重制版 (ProjectE)|1109380","rediscovered":"2305|特性重现*|359096","attack-speed-enchantment":"4483|攻击速度附魔*","playerex":"5340|~","pocket-apocalypse-mod":"2737|便携式天灾 (Pocket Apocalypse mod)","kaimyentity":"3605|KAI我的实体 (KAIMyEntity)|1170874","re-chiseled-compat":"7051|~","alexs-cloud-storage":"6196|云存储 (Cloud Storage)","zoomify":"6624|~","fluid-physics":"3168|流体物理*","minecraft-virtual-machines":"1441|Minecraft虚拟机*","psicaster":"5770|~","cc-tweaked-fabric":"1873|~","skiing":"4910|~","kitchen-mod":"2306|厨房 (The Kitchen Mod)|295019","data-attributes":"5341|~","cavern2":"1442|洞穴 II (Cavern II)|782780","minecraft-comes-alive-mca":"100|虚拟人生/凡家物语 (Minecraft Comes Alive)|727273","natures-minerals":"4484|~","compass":"2738|指南针 (compass)|1067220","auto-leveling":"7052|~","tablechair":"3606|桌椅 (TableChair)","golemania":"6625|~","playeranimator":"7487|~","cave-biomes":"4911|~","atomic-bomb-1-16":"4050|枪,炮,原子弹! (Guns, Rockets and Atomic Explosions)","tweakermore":"5771|~","hardcore-buoyance":"5342|~","simple-farming":"1874|简单农业*|988997","visuality":"6197|~","notenoughids":"1443|增加ID上限 (NotEnoughIDs)","legacy-display":"5772|~","balm-fabric":"4485|~","tinkers-evolution":"2739|匠魂进化 (Tinkers' Evolution)|1118159","packed-inventory":"7053|~","apathy-mod":"7488|~","digimobs":"1000|数码宝贝*","tatami":"4912|~","se-sign-shop":"4051|简单经济:牌子商店 (SE: Sign Shop)","zettai-grimoires":"3169|~","baubles-reborn":"2308|饰品栏重置版*","bigger-packets-please":"1875|~","vulkanmod":"6626|~","when-dungeons-arise-fabric":"3607|地牢浮现之时 (When Dungeons Arise)","ecologics":"6198|丰富的生态*","resource-hogs":"4486|资源猪 (Resourse Hogs)|1037377","pchan3-steamship-steamboat-pirates":"274|飞艇与汽船 (SteamShip - SteamBoat and Pirates)","auudio-fabric":"7489|~","storage-boats-mod":"1001|存储船 (Storage Boat Mod)|798267","final-fantasy-12-mod":"4913|~","gregtech-ce-unofficial":"5343|格雷科技社区版:非官方版 (GregTech CE: Unofficial)","avaritia-recipe-generator":"1444|可视化无尽配方编辑器*","thaumic-expansion":"749|神秘膨胀*","crafting-on-a-stick":"7055|~","tinkers-exporter":"2740|匠魂数据导出器*|1071348","sledgehammer":"6627|~","mob-scarecrows":"6199|~","eggtab-forge":"5344|独立刷怪蛋列表 (Egg Tab)","animal-feeding-trough":"3608|动物喂养槽*","mojangster":"4914|加载界面动画 (Mojangster (Animated Loading Screen))","mo-withers":"1002|更多凋灵 (Mo' Withers)","Traincraft":"317|火车工业*","advanced-xray-fabric-edition":"4487|高级透视 (Advanced XRay)","lockyz-extra-dimensions-mod":"1876|更多维度世界 (Lockyz Extra Dimensions)","trapcraft":"1445|陷阱*|260090","the-backrooms":"5773|后室*","pams-brewcraft":"2309|潘马斯酿造工艺 (Pam's Brewcraft)","quilt-loading-screen":"6628|Quilt加载画面*","wiki-zoomer":"3609|~","binnies-mods":"472|宾尼的模组合集 (Binnie's Mods)","anvil-tweaks":"4915|~","always-a-wither-skull":"5345|必得凋灵骷髅头颅 (Always a Wither Skull)","fancymenu-fabric":"4053|~|1367170","farlanders":"2741|更多末影人 (The Farlanders)|425192","mob-properties":"620|怪物属性*","amethyst-imbuement":"6629|~","psi-combat-magic":"1877|~","runorama":"3170|全景截图背景*|910751","easy-shulker-boxes":"7491|~","the-autologin-mod-for-authme-server":"1004|自动登录 (AutoLogin)","trolls-community":"6200|~","creatures-from-the-snow-forge":"5774|雪地里的生物! (Creatures From The Snow!)","asphaltmod":"4916|沥青 (Asphalt Mod)|1012064","dirtcraft":"2310|泥土工艺 (DirtCraft)","anvil-restoration":"5346|铁砧修复*","halogen":"4054|卤素*","vials":"2742|瓶瓶罐罐*","item-stages":"3171|物品阶段*","mod-name-tooltip":"1446|模组名称显示*","dtphc":"1878|动态的树:潘马斯附属 (Dynamic Trees - Pam's Harvestcraft Compat)","water-power":"361|水力科技*|190676","ring-of-attraction-fabric":"4489|吸引戒指 (Ring of Attraction)","g4mespeed":"6201|~","collisions-lib":"5775|~","zetamod":"4055|泽塔 (ZetaForged/Zeta's Mod)","hide-hands":"Line truncated
File diff suppressed because it is too large. Load diff
Binary file not shown.
-8
View File
@@ -1,8 +0,0 @@
1、本存储库中的内容以帮助公共研究为目的而公开,你可以使用其中的小部分内容或是思路,但需要在适当位置标注来源。
2、不得以本存储库的内容作为内容主体进行衍生。
3、除上述说明之外,保留所有权利。
说人话就是,随便你参考这堆代码的思路,乃至复制一两个函数什么的也可以,别复制得太过火就行,最好记得声明一下这段是从这里来的。
不过,你不能把这堆代码直接复制下来,然后在这个基础上小修小补,就说这是你自己的东西;也不能把这堆代码里的一小部分单独抠出来,说是你自己的东西。
这不是一个开源协议,只是明确说明一下你可以借鉴其中的小部分内容,我也不会且懒得因此找你麻烦。
没有法律顾问,但你懂我的意思就行了,嗯。如果有专业人士愿意帮帮忙把这堆东西写得专业一点我也很乐意……