Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a84601d99c | ||
|
|
a5a3800957 | ||
|
|
baba653a67 | ||
|
|
5733cbdb0e | ||
|
|
6e1072d042 | ||
|
|
efe58c9748 | ||
|
|
5b58e3868d | ||
|
|
0a48feba18 | ||
|
|
7d89b90ae1 | ||
|
|
f6cae4ea23 | ||
|
|
a09baee5f8 | ||
|
|
fa3d5bc09b | ||
|
|
c169532794 | ||
|
|
37313e4d6e | ||
|
|
dd9cdaf15f | ||
|
|
6a2f95e96f | ||
|
|
d682b59803 | ||
|
|
02347239b4 | ||
|
|
dc4eda533c | ||
|
|
d86ad945a6 | ||
|
|
12be800391 | ||
|
|
c47b80df36 | ||
|
|
43b0acba08 | ||
|
|
c1cad542c2 | ||
|
|
09f9b8f1e5 | ||
|
|
4241060010 | ||
|
|
0dab617b64 | ||
|
|
515b7e89c5 | ||
|
|
d83f98b34a | ||
|
|
e2030970a3 | ||
|
|
e623d3464a | ||
|
|
81346f0821 | ||
|
|
810c6e8618 | ||
|
|
a5199d32ed | ||
|
|
b058e7722d | ||
|
|
4beef0fb5d | ||
|
|
eb195373ea | ||
|
|
65ca2e0cf4 | ||
|
|
09e420ad6b | ||
|
|
95429cc9cc | ||
|
|
5a78a46b28 | ||
|
|
3ae624d4fb | ||
|
|
91f39f2afd | ||
|
|
65da5b67f7 | ||
|
|
268cb092dd | ||
|
|
9728af60d0 | ||
|
|
7affc1e24f | ||
|
|
3076f3a6b7 | ||
|
|
02c8b7211b | ||
|
|
5843649cfa | ||
|
|
f78250020e | ||
|
|
031cd898f6 | ||
|
|
1b272a6f06 | ||
|
|
f2e9be66c1 | ||
|
|
c719803849 | ||
|
|
2b485233cb | ||
|
|
5198298336 | ||
|
|
a1a2d53d31 | ||
|
|
ec6784d57d | ||
|
|
83ebc61d8a | ||
|
|
63d48b09e3 | ||
|
|
4a25b066d2 |
No files matched your search
@@ -8,7 +8,7 @@ body:
|
||||
label: "检查项"
|
||||
description: "请逐个检查下列项目,并勾选确认。"
|
||||
options:
|
||||
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是网络环境不佳[(解决方法)](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr),并非 PCL 的问题,请 **不要** 提交反馈。[下载其他启动器](https://www.mcbbs.net/forum.php?mod=forumdisplay&fid=43&filter=typeid&typeid=908)"
|
||||
- label: "**我已尝试使用其他启动器,其他启动器没有出现问题。** 如果其他启动器也存在问题,证明是网络环境不佳[(解决方法)](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-0hDr),并非 PCL 的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
|
||||
required: false
|
||||
- label: "我知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题可能是 PCL 导致的,和网络环境无关。"
|
||||
required: true
|
||||
@@ -38,4 +38,4 @@ body:
|
||||
description: "上传 PCL 文件夹中的 Log1~5.txt。[日志在哪?](https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-fvZW)"
|
||||
placeholder: "先点击这个文本框,然后再将文件直接拖拽到文本框中以上传。"
|
||||
validations:
|
||||
required: true
|
||||
required: true
|
||||
@@ -277,7 +277,7 @@
|
||||
<Setter Property="ScrollViewer.PanningMode" Value="VerticalFirst"/>
|
||||
<Setter Property="Stylus.IsFlicksEnabled" Value="False"/>
|
||||
<Setter Property="UndoLimit" Value="15" />
|
||||
<Setter Property="MaxLength" Value="10000" />
|
||||
<Setter Property="MaxLength" Value="1000" />
|
||||
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
|
||||
<Setter Property="Template">
|
||||
<Setter.Value>
|
||||
|
||||
@@ -19,7 +19,6 @@ Public Class Application
|
||||
|
||||
'开始
|
||||
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
|
||||
ApplicationStartTick = GetTimeTick()
|
||||
SecretOnApplicationStart()
|
||||
Try
|
||||
'检查参数调用
|
||||
@@ -28,11 +27,11 @@ Public Class Application
|
||||
'自动更新
|
||||
UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
|
||||
Environment.Exit(Result.Cancel)
|
||||
'ElseIf e.Args(0).StartsWith("--link") Then
|
||||
'ElseIf e.Args(0).StartsWithF("--link") Then
|
||||
' '稍作等待后切换到联机页面
|
||||
' Thread.Sleep(1000)
|
||||
' FormMain.IsLinkRestart = True
|
||||
ElseIf e.Args(0).StartsWith("--memory") Then
|
||||
ElseIf e.Args(0).StartsWithF("--memory") Then
|
||||
'内存优化
|
||||
Dim Ram = My.Computer.Info.AvailablePhysicalMemory
|
||||
Try
|
||||
@@ -47,9 +46,12 @@ Public Class Application
|
||||
Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量(K)
|
||||
End If
|
||||
#If DEBUG Then
|
||||
ElseIf e.Args(0) = "--make" Then
|
||||
'制作更新包
|
||||
UpdateMake(e.Args(1))
|
||||
ElseIf e.Args(0) = "--edit1" Then
|
||||
ExeEdit(e.Args(1), True)
|
||||
Environment.Exit(Result.Cancel)
|
||||
ElseIf e.Args(0) = "--edit2" Then
|
||||
ExeEdit(e.Args(1), False)
|
||||
Environment.Exit(Result.Cancel)
|
||||
#End If
|
||||
End If
|
||||
@@ -101,9 +103,10 @@ Public Class Application
|
||||
'日志初始化
|
||||
LogStart()
|
||||
'添加日志
|
||||
Log("[Start] 程序版本:" & VersionDisplayName & "(" & VersionCode & ")")
|
||||
Log("[Start] 识别码:" & UniqueAddress & If(ThemeCheckOne(9), ",已解锁反馈主题", ""))
|
||||
Log("[Start] 程序路径:" & PathWithName)
|
||||
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode})")
|
||||
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
|
||||
Log($"[Start] 程序路径:{PathWithName}")
|
||||
Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
|
||||
'检测压缩包运行
|
||||
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
|
||||
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
|
||||
@@ -112,13 +115,11 @@ Public Class Application
|
||||
Setup.Load("SystemDebugMode")
|
||||
Setup.Load("SystemDebugAnim")
|
||||
Setup.Load("ToolDownloadThread")
|
||||
Setup.Load("ToolDownloadCert")
|
||||
'网络配置初始化
|
||||
ServicePointManager.Expect100Continue = True
|
||||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
|
||||
ServicePointManager.DefaultConnectionLimit = 1024
|
||||
'ServicePointManager.ServerCertificateValidationCallback = New Security.RemoteCertificateValidationCallback(Function() As Boolean
|
||||
' Return True
|
||||
' End Function)
|
||||
'计时
|
||||
Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
|
||||
ApplicationStartTick = GetTimeTick()
|
||||
@@ -172,7 +173,7 @@ Public Class Application
|
||||
Private Shared ReadOnly AssemblyJsonLock As New Object
|
||||
Private Shared ReadOnly AssemblyDialogLock As New Object
|
||||
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
|
||||
If args.Name.StartsWith("NAudio") Then
|
||||
If args.Name.StartsWithF("NAudio") Then
|
||||
SyncLock AssemblyNAudioLock
|
||||
If AssemblyNAudio Is Nothing Then
|
||||
Log("[Start] 加载 DLL:NAudio")
|
||||
@@ -180,7 +181,7 @@ Public Class Application
|
||||
End If
|
||||
Return AssemblyNAudio
|
||||
End SyncLock
|
||||
ElseIf args.Name.StartsWith("Newtonsoft.Json") Then
|
||||
ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then
|
||||
SyncLock AssemblyJsonLock
|
||||
If AssemblyJson Is Nothing Then
|
||||
Log("[Start] 加载 DLL:Json")
|
||||
@@ -188,7 +189,7 @@ Public Class Application
|
||||
End If
|
||||
Return AssemblyJson
|
||||
End SyncLock
|
||||
ElseIf args.Name.StartsWith("Ookii.Dialogs.Wpf") Then
|
||||
ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then
|
||||
SyncLock AssemblyDialogLock
|
||||
If AssemblyDialog Is Nothing Then
|
||||
Log("[Start] 加载 DLL:Dialogs")
|
||||
@@ -219,7 +220,7 @@ Public Class Application
|
||||
Names.Remove(sender.Tag)
|
||||
Setup.Set("LoginLegacyName", Join(Names, "¨"))
|
||||
FrmLoginLegacy.ComboName.ItemsSource = Names
|
||||
FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "")
|
||||
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
|
||||
Case Else
|
||||
'第三方
|
||||
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
|
||||
@@ -237,12 +238,12 @@ Public Class Application
|
||||
Select Case Token
|
||||
Case "Nide"
|
||||
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
|
||||
FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
|
||||
FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
|
||||
FrmLoginNide.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
|
||||
FrmLoginNide.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
|
||||
Case "Auth"
|
||||
FrmLoginAuth.ComboName.ItemsSource = Dict.Keys
|
||||
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
|
||||
FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
|
||||
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
|
||||
FrmLoginAuth.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
|
||||
End Select
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
@@ -138,7 +138,7 @@
|
||||
Log("[Control] 按下按钮:" & Text)
|
||||
RaiseEvent Click(sender, e)
|
||||
If Not String.IsNullOrEmpty(Tag) Then
|
||||
If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then
|
||||
If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
|
||||
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
Public Class MyIconButton
|
||||
|
||||
'声明
|
||||
Public Event Click(sender As Object, e As EventArgs) '自定义事件
|
||||
'自定义事件
|
||||
Public Event Click(sender As Object, e As EventArgs)
|
||||
|
||||
'自定义属性
|
||||
|
||||
|
||||
@@ -210,7 +210,7 @@
|
||||
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
|
||||
'添加新 Logo
|
||||
If Not _Logo = "" Then
|
||||
If _Logo.ToLower.StartsWith("http") Then
|
||||
If _Logo.StartsWithF("http", True) Then
|
||||
'网络图片
|
||||
PathLogo = New Image With {
|
||||
.Tag = Me,
|
||||
@@ -220,7 +220,7 @@
|
||||
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
|
||||
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
|
||||
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
|
||||
ElseIf _Logo.ToLower.EndsWith(".png") OrElse _Logo.ToLower.EndsWith(".jpg") Then
|
||||
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then
|
||||
'位图
|
||||
Dim Bitmap = New MyBitmap(_Logo)
|
||||
PathLogo = New Canvas With {
|
||||
@@ -328,7 +328,7 @@
|
||||
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
|
||||
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
|
||||
If Not IsNothing(PathLogo) Then
|
||||
If _Logo.EndsWith(".png") Then
|
||||
If _Logo.EndsWithF(".png", True) Then
|
||||
PathLogo.Margin = New Thickness(4, 5, 3, 5)
|
||||
Else
|
||||
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
|
||||
|
||||
@@ -58,11 +58,12 @@
|
||||
Interop.ComponentDispatcher.PopModal()
|
||||
'动画
|
||||
AniStart({
|
||||
AaCode(Sub()
|
||||
If WaitingMyMsgBox.Count = 0 Then
|
||||
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
End If
|
||||
End Sub, 30),
|
||||
AaCode(
|
||||
Sub()
|
||||
If Not WaitingMyMsgBox.Any() Then
|
||||
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
End If
|
||||
End Sub, 30),
|
||||
AaOpacity(Me, -Opacity, 80, 20),
|
||||
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
|
||||
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
|
||||
|
||||
@@ -63,11 +63,12 @@
|
||||
Interop.ComponentDispatcher.PopModal()
|
||||
'动画
|
||||
AniStart({
|
||||
AaCode(Sub()
|
||||
If WaitingMyMsgBox.Count = 0 Then
|
||||
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
End If
|
||||
End Sub, 30),
|
||||
AaCode(
|
||||
Sub()
|
||||
If Not WaitingMyMsgBox.Any() Then
|
||||
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
End If
|
||||
End Sub, 30),
|
||||
AaOpacity(Me, -Opacity, 80, 20),
|
||||
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
|
||||
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
|
||||
|
||||
@@ -56,11 +56,12 @@
|
||||
Interop.ComponentDispatcher.PopModal()
|
||||
'动画
|
||||
AniStart({
|
||||
AaCode(Sub()
|
||||
If WaitingMyMsgBox.Count = 0 Then
|
||||
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
End If
|
||||
End Sub, 30),
|
||||
AaCode(
|
||||
Sub()
|
||||
If Not WaitingMyMsgBox.Any() Then
|
||||
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
|
||||
End If
|
||||
End Sub, 30),
|
||||
AaOpacity(Me, -Opacity, 80, 20),
|
||||
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
|
||||
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
|
||||
|
||||
@@ -89,7 +89,7 @@
|
||||
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
|
||||
'初次运行加载器
|
||||
If PageLoaderAutoRun Then
|
||||
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
|
||||
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
|
||||
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
|
||||
Else
|
||||
Dim Input = Nothing
|
||||
@@ -107,7 +107,7 @@
|
||||
'重试
|
||||
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
|
||||
If Not PageLoaderAutoRun Then Exit Sub
|
||||
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
|
||||
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
|
||||
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
|
||||
Else
|
||||
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
|
||||
|
||||
@@ -128,7 +128,7 @@ Public Class MyResizer
|
||||
|
||||
Private Declare Function GetMonitorInfo Lib "user32" (hMonitor As IntPtr, lpmi As MONITORINFO) As Boolean
|
||||
|
||||
Friend Declare Function MonitorFromWindow Lib "User32" (handle As IntPtr, flags As Integer) As IntPtr
|
||||
Private Declare Function MonitorFromWindow Lib "User32" (handle As IntPtr, flags As Integer) As IntPtr
|
||||
|
||||
Private Sub connectMouseHandlers(element As UIElement)
|
||||
AddHandler element.MouseLeftButtonDown, AddressOf Me.element_MouseLeftButtonDown
|
||||
|
||||
@@ -8,10 +8,12 @@
|
||||
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
|
||||
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
|
||||
Dim SourceType = e.Source.GetType
|
||||
If Content.TemplatedParent Is Nothing AndAlso
|
||||
((GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
|
||||
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
|
||||
GetType(ComboBoxItem).IsAssignableFrom(SourceType)) Then
|
||||
If Content.TemplatedParent Is Nothing AndAlso (
|
||||
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
|
||||
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
|
||||
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
|
||||
TypeOf e.Source Is CheckBox
|
||||
) Then
|
||||
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
@@ -134,7 +134,7 @@
|
||||
<Grid x:Name="PanTitleInner" Visibility="Collapsed" Margin="-16,0,0,0" Opacity="0" HorizontalAlignment="Left" Width="{Binding ActualWidth, ElementName=PanTitle, Mode=OneWay}">
|
||||
<local:MyIconButton HorizontalAlignment="Left" Theme="White" x:Name="BtnTitleInner" Margin="12,0,0,0" Height="28" Width="28"
|
||||
LogoScale="0.87" Logo="M1097.162313 584.707482 250.272424 584.707482 562.833701 896.95123C591.749274 925.859979 591.749274 972.659975 562.833701 1001.568724 533.91812 1030.477473 487.058315 1030.477473 458.142742 1001.568724L21.580946 565.451235C6.757449 550.631234-0.361728 531.131238 0.028357 511.679985L0.028357 511.631236 0.028357 511.582486C-0.361728 492.13124 6.757449 472.582488 21.580946 457.762487L458.142742 21.644997C487.058315-7.215002 533.91812-7.215002 562.833701 21.644997 591.749274 50.553746 591.749274 97.4025 562.833701 126.262499L250.272424 438.55499 1097.162313 438.55499C1137.585605 438.55499 1170.304578 471.266238 1170.304578 511.631236 1170.304578 551.947483 1137.585605 584.707482 1097.162313 584.707482L1097.162313 584.707482Z" />
|
||||
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,0,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
|
||||
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,60,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
|
||||
</Grid>
|
||||
</Grid>
|
||||
<Grid x:Name="PanLeft" Grid.Row="1" HorizontalAlignment="Left" SnapsToDevicePixels="True">
|
||||
|
||||
@@ -10,6 +10,29 @@ Public Class FormMain
|
||||
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
|
||||
'统计更新日志条目
|
||||
#If BETA Then
|
||||
If LastVersion < 321 Then 'Release 2.7.1
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
|
||||
BugCount += 1
|
||||
End If
|
||||
If LastVersion < 319 Then 'Release 2.7.0
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
|
||||
FeatureCount += 10
|
||||
BugCount += 10
|
||||
End If
|
||||
If LastVersion < 317 Then 'Release 2.6.15
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
|
||||
FeatureCount += 2
|
||||
BugCount += 2
|
||||
End If
|
||||
If LastVersion < 315 Then 'Release 2.6.14
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))
|
||||
FeatureCount += 17
|
||||
BugCount += 16
|
||||
End If
|
||||
If LastVersion < 313 Then 'Release 2.6.13
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
|
||||
FeatureCount += 6
|
||||
@@ -71,64 +94,43 @@ Public Class FormMain
|
||||
FeatureCount += 35
|
||||
BugCount += 36
|
||||
End If
|
||||
If LastVersion < 281 Then 'Release 2.4.9
|
||||
If LastVersion = 279 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
|
||||
FeatureCount += 1
|
||||
BugCount += 5
|
||||
End If
|
||||
If LastVersion < 279 Then 'Release 2.4.8
|
||||
FeatureCount += 1
|
||||
BugCount += 10
|
||||
End If
|
||||
If LastVersion < 276 Then 'Release 2.4.7
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
|
||||
FeatureCount += 25
|
||||
BugCount += 56
|
||||
End If
|
||||
If LastVersion < 272 Then 'Release 2.4.4
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修改部分配色,让整体边框变得更淡"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
|
||||
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
|
||||
FeatureCount += 13
|
||||
BugCount += 23
|
||||
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"))
|
||||
FeatureCount += 13
|
||||
BugCount += 9
|
||||
End If
|
||||
If LastVersion < 260 Then 'Release 2.3.2
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
|
||||
FeatureCount += 22
|
||||
BugCount += 4
|
||||
End If
|
||||
If LastVersion < 257 Then 'Release 2.3.0
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug"))
|
||||
FeatureCount += 4
|
||||
BugCount += 4
|
||||
End If
|
||||
#Else
|
||||
'5: FEAT+
|
||||
'4: IMP+ FEAT*
|
||||
'3:BUG+ IMP* FEAT-
|
||||
'2:BUG* IMP-
|
||||
'1:BUG-
|
||||
If LastVersion < 322 Then 'Snapshot 2.7.2
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
|
||||
FeatureCount += 18
|
||||
BugCount += 18
|
||||
End If
|
||||
If LastVersion < 320 Then 'Snapshot 2.7.1
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
|
||||
BugCount += 1
|
||||
End If
|
||||
If LastVersion < 318 Then 'Snapshot 2.7.0
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
|
||||
FeatureCount += 10
|
||||
BugCount += 10
|
||||
End If
|
||||
If LastVersion < 316 Then 'Snapshot 2.6.15
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
|
||||
FeatureCount += 2
|
||||
BugCount += 2
|
||||
End If
|
||||
If LastVersion < 314 Then 'Snapshot 2.6.14
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))
|
||||
FeatureCount += 17
|
||||
BugCount += 16
|
||||
End If
|
||||
If LastVersion < 312 Then 'Snapshot 2.6.13
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
|
||||
FeatureCount += 6
|
||||
@@ -229,116 +231,29 @@ Public Class FormMain
|
||||
FeatureCount += 5
|
||||
BugCount += 5
|
||||
End If
|
||||
If LastVersion < 282 Then 'Snapshot 2.4.9
|
||||
FeatureCount += 1
|
||||
BugCount += 5
|
||||
If LastVersion = 280 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
|
||||
End If
|
||||
If LastVersion < 280 Then 'Snapshot 2.4.8
|
||||
FeatureCount += 1
|
||||
BugCount += 10
|
||||
End If
|
||||
If LastVersion < 278 Then 'Snapshot 2.4.7
|
||||
If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug"))
|
||||
BugCount += 2
|
||||
End If
|
||||
If LastVersion < 277 Then 'Snapshot 2.4.6
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
|
||||
FeatureCount += 8
|
||||
BugCount += 21
|
||||
End If
|
||||
If LastVersion < 275 Then 'Snapshot 2.4.5
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
|
||||
FeatureCount += 17
|
||||
BugCount += 35
|
||||
End If
|
||||
If LastVersion < 273 Then 'Snapshot 2.4.4
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
|
||||
If LastVersion = 271 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法同时开启多个 Minecraft 客户端的 Bug"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
|
||||
FeatureCount += 7
|
||||
BugCount += 8
|
||||
End If
|
||||
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)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
|
||||
FeatureCount += 3
|
||||
BugCount += 11
|
||||
End If
|
||||
If LastVersion < 264 Then 'Snapshot 2.3.5
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动部分 Forge 版本的 Bug"))
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
|
||||
FeatureCount += 2
|
||||
BugCount += 3
|
||||
End If
|
||||
If LastVersion < 263 Then 'Snapshot 2.3.4
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
|
||||
FeatureCount += 11
|
||||
BugCount += 5
|
||||
End If
|
||||
If LastVersion < 262 Then 'Snapshot 2.3.3
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "修复无法使用 Mod、整合包搜索功能的 Bug"))
|
||||
BugCount += 1
|
||||
End If
|
||||
If LastVersion < 261 Then 'Snapshot 2.3.2
|
||||
FeatureCount += 8
|
||||
BugCount += 4
|
||||
End If
|
||||
If LastVersion < 259 Then 'Snapshot 2.3.1
|
||||
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
|
||||
FeatureCount += 14
|
||||
End If
|
||||
If LastVersion < 258 Then 'Snapshot 2.3.0
|
||||
FeatureCount += 4
|
||||
BugCount += 4
|
||||
End If
|
||||
#End If
|
||||
'整理更新日志文本
|
||||
Dim ContentList As New List(Of String)
|
||||
Dim SortedFeatures = Sort(FeatureList, Function(Left As KeyValuePair(Of Integer, String), Right As KeyValuePair(Of Integer, String)) As Boolean
|
||||
Return Left.Key > Right.Key
|
||||
End Function)
|
||||
If SortedFeatures.Count = 0 AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then
|
||||
ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
|
||||
End If
|
||||
Dim SortedFeatures = Sort(FeatureList, Function(Left, Right) Left.Key > Right.Key)
|
||||
If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
|
||||
For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
|
||||
ContentList.Add(SortedFeatures(i).Value)
|
||||
Next
|
||||
If SortedFeatures.Count > 10 Then FeatureCount += SortedFeatures.Count - 10
|
||||
If FeatureCount > 0 OrElse BugCount > 0 Then
|
||||
ContentList.Add(If(FeatureCount > 0, "其他 " & FeatureCount & " 项小调整与修改", "") &
|
||||
If(FeatureCount > 0 AndAlso BugCount > 0, ",", "") &
|
||||
If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
|
||||
",详见完整更新日志")
|
||||
If(FeatureCount > 0 AndAlso BugCount > 0, ",", "") &
|
||||
If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
|
||||
",详见完整更新日志")
|
||||
End If
|
||||
Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ")
|
||||
'输出更新日志
|
||||
RunInNewThread(Sub()
|
||||
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
|
||||
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
|
||||
End If
|
||||
End Sub, "UpdateLog Output")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
|
||||
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
|
||||
End If
|
||||
End Sub, "UpdateLog Output")
|
||||
End Sub
|
||||
|
||||
'窗口加载
|
||||
@@ -490,7 +405,6 @@ Public Class FormMain
|
||||
|
||||
Log("[Start] 第三阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
|
||||
End Sub
|
||||
'Private Declare Function ChangeWindowMessageFilter Lib "user32.dll" (message As Integer, action As Integer) As Boolean
|
||||
'根据打开次数触发的事件
|
||||
Private Sub RunCountSub()
|
||||
Setup.Set("SystemCount", Setup.Get("SystemCount") + 1)
|
||||
@@ -528,6 +442,8 @@ Public Class FormMain
|
||||
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
|
||||
End If
|
||||
#End If
|
||||
'被移除的窗口设置选项
|
||||
If Setup.Get("LaunchArgumentWindowType") = 5 Then Setup.Set("LaunchArgumentWindowType", 1)
|
||||
'修改主题设置项名称
|
||||
If LowerVersionCode <= 207 Then
|
||||
Dim UnlockedTheme As New List(Of String) From {"2"}
|
||||
@@ -751,7 +667,7 @@ Public Class FormMain
|
||||
If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
|
||||
End Sub
|
||||
Private Sub TriggerPageBack()
|
||||
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then
|
||||
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall AndAlso FrmDownloadInstall.IsInSelectPage Then
|
||||
FrmDownloadInstall.ExitSelectPage()
|
||||
Else
|
||||
PageBack()
|
||||
@@ -788,7 +704,7 @@ Public Class FormMain
|
||||
Try
|
||||
Dim Str As String = e.Data.GetData(DataFormats.Text)
|
||||
Log("[System] 接受文本拖拽:" & Str)
|
||||
If Str.StartsWith("authlib-injector:yggdrasil-server:") Then
|
||||
If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
|
||||
'Authlib 拖拽
|
||||
e.Handled = True
|
||||
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
|
||||
@@ -831,7 +747,7 @@ Public Class FormMain
|
||||
'正在主页,需要刷新左边栏
|
||||
FrmLaunchLeft.RefreshPage(True, False)
|
||||
End If
|
||||
ElseIf Str.StartsWith("file:///") Then
|
||||
ElseIf Str.StartsWithF("file:///") Then
|
||||
'文件拖拽(例如从浏览器下载窗口拖入)
|
||||
Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
|
||||
e.Handled = True
|
||||
@@ -859,7 +775,7 @@ Public Class FormMain
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Dim FilePath As String = FilePathList.First
|
||||
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Count > 0, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
|
||||
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
|
||||
'基础检查
|
||||
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
|
||||
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
|
||||
@@ -906,7 +822,7 @@ Public Class FormMain
|
||||
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
|
||||
ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
|
||||
'未处于 Mod 管理页面
|
||||
If MyMsgBox($"是否要将这些文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
|
||||
If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
|
||||
Else
|
||||
'处于 Mod 管理页面
|
||||
Install:
|
||||
@@ -994,7 +910,6 @@ Install:
|
||||
Left -= 10000
|
||||
ShowInTaskbar = False
|
||||
Visibility = Visibility.Hidden
|
||||
'SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
|
||||
Log("[System] 窗口已隐藏,位置:(" & Left & "," & Top & ")")
|
||||
Else
|
||||
'取消隐藏
|
||||
@@ -1017,16 +932,9 @@ Install:
|
||||
Topmost = False
|
||||
SetForegroundWindow(Handle)
|
||||
Focus()
|
||||
'ShowWindow(Handle, 1) 'SW_RESTORE
|
||||
'SetWindowPos(Handle, 0, 0, 0, 0, 0, 3) 'InsertAfter: TOP, NOMOVE & NOSIZE
|
||||
'SetFocus(Handle)
|
||||
Log("[System] 窗口已置顶,位置:(" & Left & ", " & Top & "), " & Width & " x " & Height)
|
||||
End Sub)
|
||||
End Sub
|
||||
'Private Declare Function SetFocus Lib "user32" (hWnd As IntPtr) As IntPtr
|
||||
'Private Declare Function SetWindowPos Lib "user32" (hWnd As IntPtr, hWndInsertAfter As IntPtr, x As Integer, y As Integer, cx As Integer, cy As Integer, flags As UInteger) As Boolean
|
||||
'Private Declare Function AttachThreadInput Lib "user32" (attachFrom As IntPtr, attachTo As IntPtr, isAttach As Boolean) As Boolean
|
||||
'Private Declare Function SendMessage Lib "user32" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As IntPtr
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -1282,8 +1190,11 @@ Install:
|
||||
''' 通过点击返回按钮或手动触发返回来改变页面。
|
||||
''' </summary>
|
||||
Public Sub PageBack() Handles BtnTitleInner.Click
|
||||
If PageStack.Count = 0 Then Exit Sub
|
||||
PageChangeActual(PageStack(0))
|
||||
If PageStack.Any() Then
|
||||
PageChangeActual(PageStack(0))
|
||||
Else
|
||||
PageChange(PageType.Launch)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'实际处理页面切换
|
||||
@@ -1302,27 +1213,13 @@ Install:
|
||||
PageChangeExit()
|
||||
Else
|
||||
'即将切换到一个子页面
|
||||
If PageStack.Count = 0 Then
|
||||
'主页面 → 子页面,进入
|
||||
PanTitleInner.Visibility = Visibility.Visible
|
||||
PanTitleMain.IsHitTestVisible = False
|
||||
PanTitleInner.IsHitTestVisible = True
|
||||
PageNameRefresh(Stack)
|
||||
AniStart({
|
||||
AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
|
||||
AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
|
||||
AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
|
||||
AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
|
||||
AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
|
||||
}, "FrmMain Titlebar FirstLayer")
|
||||
PageStack.Insert(0, PageCurrent)
|
||||
Else
|
||||
If PageStack.Any Then
|
||||
'子页面 → 另一个子页面,更新
|
||||
AniStart({
|
||||
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
|
||||
AaCode(Sub() LabTitleInner.Text = PageName,, True),
|
||||
AaOpacity(LabTitleInner, 1, 150, 30)
|
||||
}, "FrmMain Titlebar SubLayer")
|
||||
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
|
||||
AaCode(Sub() LabTitleInner.Text = PageName,, True),
|
||||
AaOpacity(LabTitleInner, 1, 150, 30)
|
||||
}, "FrmMain Titlebar SubLayer")
|
||||
If PageStack.Contains(Stack) Then
|
||||
'返回到更上层的子页面
|
||||
Do While PageStack.Contains(Stack)
|
||||
@@ -1332,6 +1229,20 @@ Install:
|
||||
'进入更深层的子页面
|
||||
PageStack.Insert(0, PageCurrent)
|
||||
End If
|
||||
Else
|
||||
'主页面 → 子页面,进入
|
||||
PanTitleInner.Visibility = Visibility.Visible
|
||||
PanTitleMain.IsHitTestVisible = False
|
||||
PanTitleInner.IsHitTestVisible = True
|
||||
PageNameRefresh(Stack)
|
||||
AniStart({
|
||||
AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
|
||||
AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
|
||||
AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
|
||||
AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
|
||||
AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
|
||||
}, "FrmMain Titlebar FirstLayer")
|
||||
PageStack.Insert(0, PageCurrent)
|
||||
End If
|
||||
End If
|
||||
#End Region
|
||||
@@ -1438,9 +1349,7 @@ Install:
|
||||
''' 退出子界面。
|
||||
''' </summary>
|
||||
Private Sub PageChangeExit()
|
||||
If PageStack.Count = 0 Then
|
||||
'主页面 → 主页面,无事发生
|
||||
Else
|
||||
If PageStack.Any Then
|
||||
'子页面 → 主页面,退出
|
||||
PanTitleMain.Visibility = Visibility.Visible
|
||||
PanTitleMain.IsHitTestVisible = True
|
||||
@@ -1453,6 +1362,8 @@ Install:
|
||||
AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
|
||||
}, "FrmMain Titlebar FirstLayer")
|
||||
PageStack.Clear()
|
||||
Else
|
||||
'主页面 → 主页面,无事发生
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -1463,23 +1374,22 @@ Install:
|
||||
End Sub
|
||||
Private Sub PanMainLeft_Resize(NewWidth As Double)
|
||||
Dim Delta As Double = NewWidth - RectLeftBackground.Width
|
||||
If Math.Abs(Delta) < 0.1 Then Exit Sub
|
||||
If AniControlEnabled = 0 Then
|
||||
If Math.Abs(Delta) > 0.1 AndAlso AniControlEnabled = 0 Then
|
||||
If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏
|
||||
If NewWidth > 0 Then
|
||||
'宽度足够,显示
|
||||
AniStart({
|
||||
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
|
||||
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
|
||||
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
|
||||
}, "FrmMain LeftChange", True)
|
||||
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
|
||||
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
|
||||
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
|
||||
}, "FrmMain LeftChange", True)
|
||||
Else
|
||||
'宽度不足,隐藏
|
||||
AniStart({
|
||||
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
|
||||
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
|
||||
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
|
||||
}, "FrmMain LeftChange", True)
|
||||
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
|
||||
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
|
||||
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
|
||||
}, "FrmMain LeftChange", True)
|
||||
End If
|
||||
Else
|
||||
RectLeftBackground.Width = NewWidth
|
||||
@@ -1573,7 +1483,11 @@ Install:
|
||||
''' </summary>
|
||||
Public Sub BackToTop() Handles BtnExtraBack.Click
|
||||
Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
|
||||
RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
|
||||
If RealScroll IsNot Nothing Then
|
||||
RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
|
||||
Else
|
||||
Log("[UI] 无法返回顶部,未找到合适的 RealScroll", LogLevel.Hint)
|
||||
End If
|
||||
End Sub
|
||||
Private Function BtnExtraBack_ShowCheck() As Boolean
|
||||
Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
|
||||
@@ -1581,9 +1495,7 @@ Install:
|
||||
End Function
|
||||
Private Function BtnExtraBack_GetRealChild() As MyScrollViewer
|
||||
If PanMainRight.Child Is Nothing OrElse TypeOf PanMainRight.Child IsNot MyPageRight Then Return Nothing
|
||||
Dim Scroll = CType(PanMainRight.Child, MyPageRight).PanScroll
|
||||
If Scroll Is Nothing OrElse Scroll.Visibility <> Visibility.Visible Then Return Nothing
|
||||
Return Scroll
|
||||
Return CType(PanMainRight.Child, MyPageRight).PanScroll
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -869,7 +869,7 @@ NextAni:
|
||||
Loop
|
||||
|
||||
'如果当前动画组都执行完毕则删除
|
||||
If Entry.Data.Count = 0 Then
|
||||
If Not Entry.Data.Any() Then
|
||||
'为了避免新添加的动画影响顺序,不能 RemoveAt(i)
|
||||
'为了允许动画在执行中添加同名动画组,不能按名字移除
|
||||
For Current = 0 To AniGroups.Count - 1
|
||||
|
||||
@@ -11,12 +11,12 @@ Public Module ModBase
|
||||
#Region "声明"
|
||||
|
||||
'下列版本信息由更新器自动修改
|
||||
Public Const VersionBaseName As String = "2.6.13" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.6.13." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const VersionBaseName As String = "2.7.2" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.7.2." & VersionBranchCode '标准格式的四段式版本号
|
||||
#If BETA Then
|
||||
Public Const VersionCode As Integer = 313 'Release
|
||||
Public Const VersionCode As Integer = 321 'Release
|
||||
#Else
|
||||
Public Const VersionCode As Integer = 312 'Snapshot
|
||||
Public Const VersionCode As Integer = 322 'Snapshot
|
||||
#End If
|
||||
'自动生成的版本信息
|
||||
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
|
||||
@@ -58,7 +58,7 @@ Public Module ModBase
|
||||
''' <summary>
|
||||
''' 程序的打开计时。
|
||||
''' </summary>
|
||||
Public ApplicationStartTick As Long
|
||||
Public ApplicationStartTick As Long = GetTimeTick()
|
||||
''' <summary>
|
||||
''' 程序打开时的时间。
|
||||
''' </summary>
|
||||
@@ -76,6 +76,10 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
|
||||
''' <summary>
|
||||
''' 是否使用 GBK 编码。
|
||||
''' </summary>
|
||||
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
|
||||
''' <summary>
|
||||
''' 操作系统版本。Win10 为 10.0。
|
||||
''' </summary>
|
||||
Public OsVersion As Version = Environment.OSVersion.Version
|
||||
@@ -110,6 +114,14 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public Const IconButtonDelete As String = "M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z"
|
||||
''' <summary>
|
||||
''' 图标按钮,禁止,1x
|
||||
''' </summary>
|
||||
Public Const IconButtonStop As String = "M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z"
|
||||
''' <summary>
|
||||
''' 图标按钮,勾选,1x
|
||||
''' </summary>
|
||||
Public Const IconButtonCheck As String = "M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"
|
||||
''' <summary>
|
||||
''' 图标按钮,笔,1x
|
||||
''' </summary>
|
||||
Public Const IconButtonEdit As String = "M732.64 64.32C688.576 21.216 613.696 21.216 569.6 64.32L120.128 499.52c-17.6 12.896-26.432 30.144-30.848 51.68L32 870.048c0 25.856 8.8 56 26.432 73.248 17.632 17.216 17.632 48.704 88.64 48.704h13.248l326.08-56c22.016-4.32 39.68-12.928 52.864-30.176l449.472-435.2c22.048-21.536 35.264-47.36 35.264-77.536 0-30.176-13.216-56-35.264-77.568l-256.096-251.2zM139.712 903.776l56-326.912 311.04-295.136 267.104 269.44-310.976 295.168-323.168 57.44zM844.576 467.84l-273.984-260.672 61.856-59.84c8.832-8.512 26.528-8.512 39.776 0l234.24 226.496c4.384 4.288 8.832 12.8 8.832 17.088s-4.416 8.544-8.864 12.8l-61.856 64.128z"
|
||||
@@ -158,9 +170,13 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public Const IconButtonUser As String = "M660.338 528.065c63.61-46.825 105.131-121.964 105.131-206.83 0-141.7-115.29-256.987-256.997-256.987-141.706 0-256.998 115.288-256.998 256.987 0 85.901 42.52 161.887 107.456 208.562-152.1 59.92-260.185 207.961-260.185 381.077 0 21.276 17.253 38.53 38.53 38.53 21.278 0 38.53-17.254 38.53-38.53 0-183.426 149.232-332.671 332.667-332.671 1.589 0 3.113-0.207 4.694-0.244 0.8 0.056 1.553 0.244 2.362 0.244 183.434 0 332.664 149.245 332.664 332.671 0 21.276 17.255 38.53 38.533 38.53 21.277 0 38.53-17.254 38.53-38.53 0-174.885-110.354-324.13-264.917-382.809z m-331.803-206.83c0-99.22 80.72-179.927 179.935-179.927s179.937 80.708 179.937 179.927c0 99.203-80.721 179.91-179.937 179.91s-179.935-80.708-179.935-179.91z"
|
||||
''' <summary>
|
||||
''' 图标按钮,微软,0.9x
|
||||
''' 图标按钮,盾牌,1x
|
||||
''' </summary>
|
||||
Public Const IconButtonMs As String = "M0,0h5v5h-5ZM6,0h5v5h-5v-5ZM0,6h5v5h-5v-5ZM6,6h5v5h-5v-5Z"
|
||||
Public Const IconButtonShield As String = "M511.488256 95.184408c35.310345 22.516742 95.184408 55.78011 167.34033 84.437781 75.738131 29.681159 148.405797 40.93953 191.392304 45.033483v353.615193c0 73.691154-50.662669 164.781609-136.123938 244.101949C649.65917 901.181409 558.568716 942.12094 512 942.12094c-46.568716 0-137.65917-40.93953-222.096952-119.748126C204.441779 742.54073 153.77911 651.450275 153.77911 577.247376v-353.103448c42.474763-4.093953 116.165917-15.352324 191.904048-45.545227 75.226387-30.192904 133.565217-63.456272 165.805098-83.414293M512 0c-4.093953 0-8.187906 1.535232-11.258371 3.582209l-14.84058 10.234882c-1.023488 0.511744-67.550225 47.592204-170.410794 88.531735-100.813593 39.916042-198.556722 41.963018-199.58021 41.963018l-25.075462 0.511744c-10.746627 0.511744-18.934533 8.187906-18.934533 18.422789v414.000999c0 216.97951 286.064968 446.24088 440.09995 446.24088s440.09995-229.261369 440.09995-445.729136V163.758121c0-10.234883-8.69965-18.422789-18.934533-18.422789l-24.563718-0.511744c-1.023488 0-98.766617-2.046977-199.58021-41.963018-103.372314-40.93953-170.410795-88.01999-170.922538-88.531734L523.258371 3.582209c-3.070465-2.558721-7.164418-3.582209-11.258371-3.582209z M743.308346 410.930535l-260.477761 260.477761c-15.864068 15.864068-41.963018 15.864068-57.827087 0l-144.823588-144.823588c-15.864068-15.864068-15.864068-41.963018 0-57.827087 8.187906-8.187906 18.422789-11.770115 29.169415-11.770115 10.234883 0 20.981509 4.093953 29.169416 11.770115l115.654173 115.654173L685.993003 352.591704c15.864068-15.864068 41.963018-15.864068 57.827087 0 15.352324 16.375812 15.352324 42.474763-0.511744 58.338831z"
|
||||
''' <summary>
|
||||
''' 图标按钮,离线,0.85x
|
||||
''' </summary>
|
||||
Public Const IconButtonOffline As String = "M533.293176 788.841412a60.235294 60.235294 0 1 1 85.202824 85.202823l-42.616471 42.586353c-129.355294 129.385412-339.124706 129.385412-468.510117 0-129.385412-129.385412-129.385412-339.124706 0-468.510117l42.586353-42.616471a60.235294 60.235294 0 1 1 85.202823 85.202824l-42.61647 42.586352a210.823529 210.823529 0 1 0 298.164706 298.164706l42.586352-42.61647z m255.548236-255.548236l42.61647-42.586352a210.823529 210.823529 0 1 0-298.164706-298.164706l-42.586352 42.61647a60.235294 60.235294 0 1 1-85.202824-85.202823l42.616471-42.586353c129.355294-129.385412 339.124706-129.385412 468.510117 0 129.385412 129.385412 129.385412 339.124706 0 468.510117l-42.586353 42.616471a60.235294 60.235294 0 1 1-85.202823-85.202824zM192.542118 192.542118a60.235294 60.235294 0 0 1 85.202823 0l553.712941 553.712941a60.235294 60.235294 0 0 1-85.202823 85.202823L192.542118 277.744941a60.235294 60.235294 0 0 1 0-85.202823z"
|
||||
''' <summary>
|
||||
''' 图标,音符,1x
|
||||
''' </summary>
|
||||
@@ -467,11 +483,11 @@ Public Module ModBase
|
||||
Const Digits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/+="
|
||||
'零与负数的处理
|
||||
If String.IsNullOrEmpty(Input) Then Return "0"
|
||||
Dim IsNegative As Boolean = Input.StartsWith("-")
|
||||
Dim IsNegative As Boolean = Input.StartsWithF("-")
|
||||
If IsNegative Then Input = Input.TrimStart("-")
|
||||
'转换为十进制
|
||||
Dim RealNum As Long = 0, Scale As Long = 1
|
||||
For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOf(l))
|
||||
For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOfF(l))
|
||||
RealNum += Digit * Scale
|
||||
Scale *= FromRadix
|
||||
Next
|
||||
@@ -610,82 +626,53 @@ Public Module ModBase
|
||||
End Sub
|
||||
|
||||
'Ini 文件
|
||||
Private Class IniCache
|
||||
Public FileContent As String = ""
|
||||
Public KVCache As New Dictionary(Of String, String)
|
||||
End Class
|
||||
Private ReadOnly IniCacheList As New Dictionary(Of String, IniCache)
|
||||
Private ReadOnly IniCache As New Dictionary(Of String, Dictionary(Of String, String))
|
||||
''' <summary>
|
||||
''' 清除某 Ini 文件的运行时缓存。
|
||||
''' 清除某 ini 文件的运行时缓存。
|
||||
''' </summary>
|
||||
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
|
||||
Public Sub IniClearCache(FileName As String)
|
||||
'还原文件路径
|
||||
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
|
||||
'检索缓存
|
||||
If IniCacheList.ContainsKey(FileName) Then IniCacheList.Remove(FileName)
|
||||
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
|
||||
If IniCache.ContainsKey(FileName) Then IniCache.Remove(FileName)
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 获取 Ini 文件内容,这可能会使用到缓存。
|
||||
''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
|
||||
''' 在文件不存在或读取失败时返回 Nothing。
|
||||
''' </summary>
|
||||
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
|
||||
Private Function IniGetContent(FileName As String) As IniCache
|
||||
Private Function IniGetContent(FileName As String) As Dictionary(Of String, String)
|
||||
Try
|
||||
'还原文件路径
|
||||
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
|
||||
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
|
||||
'检索缓存
|
||||
If IniCacheList.ContainsKey(FileName) Then
|
||||
'返回缓存中的信息
|
||||
Dim Cache As New IniCache
|
||||
IniCacheList.TryGetValue(FileName, Cache)
|
||||
Return Cache '防止ByRef导致缓存变更
|
||||
Else
|
||||
Dim Ini As IniCache
|
||||
If File.Exists(FileName) Then
|
||||
'返回文件信息并且记入缓存
|
||||
Dim Cache As String = (vbCrLf & ReadFile(FileName) & vbCrLf).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf).Replace(vbNullChar, "")
|
||||
Ini = New IniCache With {.FileContent = Cache}
|
||||
Else
|
||||
'返回空文件信息
|
||||
Ini = New IniCache With {.FileContent = ""}
|
||||
End If
|
||||
If Not IniCacheList.ContainsKey(FileName) Then IniCacheList.Add(FileName, Ini) '避免多线程异步执行此方法时造成多次添加项
|
||||
Return Ini
|
||||
End If
|
||||
If IniCache.ContainsKey(FileName) Then Return IniCache(FileName)
|
||||
'读取文件
|
||||
If Not File.Exists(FileName) Then Return Nothing
|
||||
Dim Ini As New Dictionary(Of String, String)
|
||||
For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
|
||||
Dim Index As Integer = Line.IndexOfF(":")
|
||||
If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键,见 #3616
|
||||
Next
|
||||
IniCache(FileName) = Ini
|
||||
Return Ini
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取文件失败:" & FileName, LogLevel.Hint)
|
||||
Return New IniCache With {.FileContent = ""}
|
||||
Log(ex, $"生成 ini 文件缓存失败({FileName})", LogLevel.Hint)
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 读取Ini文件,这可能会使用到缓存。
|
||||
''' 读取 ini 文件。这可能会使用到缓存。
|
||||
''' </summary>
|
||||
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
|
||||
''' <param name="Key">键。</param>
|
||||
''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
|
||||
Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
|
||||
Try
|
||||
'获取目前文件
|
||||
Dim NowIni As IniCache = IniGetContent(FileName)
|
||||
If IsNothing(NowIni) Then Return DefaultValue
|
||||
'使用缓存
|
||||
If NowIni.KVCache.ContainsKey(Key) Then Return If(NowIni.KVCache(Key), DefaultValue)
|
||||
'没有缓存,读取文件
|
||||
If NowIni.FileContent.Contains(vbCrLf & Key & ":") Then
|
||||
Dim Ret As String = Mid(NowIni.FileContent, NowIni.FileContent.IndexOf(vbCrLf & Key & ":") + 3)
|
||||
Ret = If(Ret.Contains(vbCrLf), Mid(Ret, 1, Ret.IndexOf(vbCrLf)), Ret).Replace(Key & ":", "")
|
||||
NowIni.KVCache.Add(Key, If(Ret = vbLf, "", Ret))
|
||||
Return If(Ret = vbLf, "", Ret)
|
||||
Else
|
||||
Return DefaultValue
|
||||
End If
|
||||
Catch ex As Exception
|
||||
'读取失败
|
||||
Return DefaultValue
|
||||
End Try
|
||||
Dim Content = IniGetContent(FileName)
|
||||
If Content Is Nothing OrElse Not Content.ContainsKey(Key) Then Return DefaultValue
|
||||
Return Content(Key)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 写入ini文件,这会更新缓存。
|
||||
''' 写入 ini 文件,这会更新缓存。
|
||||
''' </summary>
|
||||
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
|
||||
''' <param name="Key">键。</param>
|
||||
@@ -693,47 +680,41 @@ Public Module ModBase
|
||||
''' <remarks></remarks>
|
||||
Public Sub WriteIni(FileName As String, Key As String, Value As String)
|
||||
Try
|
||||
|
||||
'还原文件路径
|
||||
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
|
||||
If IsNothing(Value) Then Value = ""
|
||||
Value = Value.Replace(vbCrLf, "")
|
||||
'创建文件夹
|
||||
If Not Directory.Exists(GetPathFromFullPath(FileName)) Then Directory.CreateDirectory(GetPathFromFullPath(FileName))
|
||||
'预处理
|
||||
Key = Key.Replace(vbCr, "").Replace(vbLf, "").Replace(":", "")
|
||||
Value = Value.Replace(vbCr, "").Replace(vbLf, "") '允许 Value 中包含冒号
|
||||
'获取目前文件
|
||||
Dim NowFile As String = IniGetContent(FileName).FileContent
|
||||
If Not NowFile.EndsWith(vbCrLf) Then NowFile += vbCrLf
|
||||
'如果值一样就不处理
|
||||
If NowFile.Contains(vbCrLf & Key & ":" & Value & vbCrLf) Then Exit Sub
|
||||
'处理文件
|
||||
Dim FindResult As String = ReadIni(FileName, Key)
|
||||
If FindResult = "" AndAlso Not NowFile.Contains(vbCrLf & Key & ":") Then
|
||||
'不存在这个键
|
||||
NowFile = NowFile & vbCrLf & Key & ":" & Value & vbCrLf
|
||||
Else
|
||||
'存在这个键
|
||||
NowFile = NowFile.Replace(vbCrLf & Key & ":" & FindResult & vbCrLf, vbCrLf & Key & ":" & Value & vbCrLf)
|
||||
End If
|
||||
WriteFile(FileName, NowFile)
|
||||
'刷新目前缓存
|
||||
IniCacheList(FileName).FileContent = NowFile
|
||||
IniCacheList(FileName).KVCache.Remove(Key)
|
||||
IniCacheList(FileName).KVCache.Add(Key, Value)
|
||||
|
||||
Dim Content As Dictionary(Of String, String) = IniGetContent(FileName)
|
||||
If Content Is Nothing Then Content = New Dictionary(Of String, String)
|
||||
If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Exit Sub '如果值一样就不处理
|
||||
'更新缓存
|
||||
Content(Key) = Value
|
||||
'写入文件
|
||||
Dim FileContent As New StringBuilder
|
||||
For Each Pair In Content
|
||||
FileContent.Append(Pair.Key)
|
||||
FileContent.Append(":")
|
||||
FileContent.Append(Pair.Value)
|
||||
FileContent.Append(vbCrLf)
|
||||
Next
|
||||
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
|
||||
WriteFile(FileName, FileContent.ToString)
|
||||
Catch ex As Exception
|
||||
Log(ex, "写入文件失败:" & FileName & "/" & Key & ": " & Value)
|
||||
Log(ex, $"写入文件失败({FileName} -> {Key}:{Value})")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'路径处理
|
||||
''' <summary>
|
||||
''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。不包含路径将会抛出异常。
|
||||
''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
|
||||
''' 取决于原路径格式,路径以 / 或 \ 结尾。
|
||||
''' 不包含路径将会抛出异常。
|
||||
''' </summary>
|
||||
Public Function GetPathFromFullPath(FilePath As String) As String
|
||||
If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Throw New Exception("不包含路径:" & FilePath)
|
||||
If FilePath.EndsWith("\") OrElse FilePath.EndsWith("/") Then
|
||||
If FilePath.EndsWithF("\") OrElse FilePath.EndsWithF("/") Then
|
||||
'是文件夹路径
|
||||
Dim IsRight As Boolean = FilePath.EndsWith("\")
|
||||
Dim IsRight As Boolean = FilePath.EndsWithF("\")
|
||||
FilePath = Left(FilePath, Len(FilePath) - 1)
|
||||
GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
|
||||
If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath)
|
||||
@@ -748,11 +729,13 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public Function GetFileNameFromPath(FilePath As String) As String
|
||||
FilePath = FilePath.Replace("/", "\")
|
||||
If FilePath.EndsWith("\") Then Throw New Exception("不包含文件名:" & FilePath)
|
||||
Dim FileName As String = FilePath.Split("\").Last.Split("?").First '去掉网络参数后的 ?
|
||||
If FileName.Length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
|
||||
If FileName.Length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
|
||||
Return FileName
|
||||
If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
|
||||
If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
|
||||
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
|
||||
Dim length As Integer = FilePath.Length
|
||||
If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
|
||||
If length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
|
||||
Return FilePath
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
|
||||
@@ -760,7 +743,7 @@ Public Module ModBase
|
||||
Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String
|
||||
Dim Name As String = GetFileNameFromPath(FilePath)
|
||||
If Name.Contains(".") Then
|
||||
Return Name.Substring(0, Name.LastIndexOf("."))
|
||||
Return Name.Substring(0, Name.LastIndexOfF("."))
|
||||
Else
|
||||
Return Name
|
||||
End If
|
||||
@@ -769,8 +752,8 @@ Public Module ModBase
|
||||
''' 从文件夹路径获取文件夹名。
|
||||
''' </summary>
|
||||
Public Function GetFolderNameFromPath(FolderPath As String) As String
|
||||
If FolderPath.EndsWith(":\") OrElse FolderPath.EndsWith(":\\") Then Return FolderPath.Substring(0, 1)
|
||||
If FolderPath.EndsWith("\") OrElse FolderPath.EndsWith("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
|
||||
If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") Then Return FolderPath.Substring(0, 1)
|
||||
If FolderPath.EndsWithF("\") OrElse FolderPath.EndsWithF("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
|
||||
Return GetFileNameFromPath(FolderPath)
|
||||
End Function
|
||||
|
||||
@@ -1023,7 +1006,7 @@ Public Module ModBase
|
||||
Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
|
||||
Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
|
||||
folderDialog.ShowDialog()
|
||||
SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWith("\"), "", "\"))
|
||||
SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWithF("\"), "", "\"))
|
||||
Log("[UI] 选择文件夹返回:" & SelectFolder)
|
||||
End Function
|
||||
|
||||
@@ -1034,8 +1017,8 @@ Public Module ModBase
|
||||
Public Function CheckPermission(Path As String) As Boolean
|
||||
Try
|
||||
If Path = "" Then Return False
|
||||
If Not Path.EndsWith("\") Then Path += "\"
|
||||
If Path.EndsWith(":\System Volume Information\") OrElse Path.EndsWith(":\$RECYCLE.BIN\") Then Return False
|
||||
If Not Path.EndsWithF("\") Then Path += "\"
|
||||
If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
|
||||
If Not Directory.Exists(Path) Then Return False
|
||||
Dim FileName As String = "CheckPermission" & GetUuid()
|
||||
If File.Exists(Path & FileName) Then File.Delete(Path & FileName)
|
||||
@@ -1052,7 +1035,7 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public Sub CheckPermissionWithException(Path As String)
|
||||
If String.IsNullOrWhiteSpace(Path) Then Throw New ArgumentNullException("文件夹名不能为空!")
|
||||
If Not Path.EndsWith("\") Then Path += "\"
|
||||
If Not Path.EndsWithF("\") Then Path += "\"
|
||||
If Not Directory.Exists(Path) Then Throw New DirectoryNotFoundException("文件夹不存在!")
|
||||
If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission")
|
||||
File.Create(Path & "CheckPermission").Dispose()
|
||||
@@ -1236,43 +1219,35 @@ Re:
|
||||
''' <summary>
|
||||
''' 尝试根据后缀名判断文件种类并解压文件,支持 gz 与 zip,会尝试将 jar 以 zip 方式解压。
|
||||
''' 会尝试创建,但不会清空目标文件夹。
|
||||
''' 成功返回 True,并非压缩文件或失败返回 False。
|
||||
''' </summary>
|
||||
Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
|
||||
Try
|
||||
Directory.CreateDirectory(DestDirectory)
|
||||
If CompressFilePath.EndsWith(".gz") Then
|
||||
'以 gz 方式解压
|
||||
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
|
||||
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
|
||||
Dim data As Integer = stream.ReadByte()
|
||||
While data <> -1
|
||||
decompressedFile.WriteByte(data)
|
||||
data = stream.ReadByte()
|
||||
End While
|
||||
decompressedFile.Close()
|
||||
stream.Close()
|
||||
Return True
|
||||
Else
|
||||
'以 zip 方式解压
|
||||
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
|
||||
For Each Entry As ZipArchiveEntry In Archive.Entries
|
||||
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
|
||||
If DestinationPath.EndsWith("\") OrElse DestinationPath.EndsWith("/") Then
|
||||
Continue For '不创建空文件夹
|
||||
Else
|
||||
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
|
||||
Entry.ExtractToFile(DestinationPath, True)
|
||||
End If
|
||||
Next
|
||||
End Using
|
||||
Return True
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "尝试解压文件失败")
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing)
|
||||
Directory.CreateDirectory(DestDirectory)
|
||||
If CompressFilePath.EndsWithF(".gz", True) Then
|
||||
'以 gz 方式解压
|
||||
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
|
||||
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
|
||||
Dim data As Integer = stream.ReadByte()
|
||||
While data <> -1
|
||||
decompressedFile.WriteByte(data)
|
||||
data = stream.ReadByte()
|
||||
End While
|
||||
decompressedFile.Close()
|
||||
stream.Close()
|
||||
Else
|
||||
'以 zip 方式解压
|
||||
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
|
||||
For Each Entry As ZipArchiveEntry In Archive.Entries
|
||||
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
|
||||
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
|
||||
Continue For '不创建空文件夹
|
||||
Else
|
||||
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
|
||||
Entry.ExtractToFile(DestinationPath, True)
|
||||
End If
|
||||
Next
|
||||
End Using
|
||||
End If
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 删除文件夹,返回删除的文件个数。通过参数选择是否抛出异常。
|
||||
@@ -1314,9 +1289,9 @@ Re:
|
||||
''' </summary>
|
||||
Public Sub CopyDirectory(FromPath As String, ToPath As String)
|
||||
FromPath = FromPath.Replace("/", "\")
|
||||
If Not FromPath.EndsWith("\") Then FromPath &= "\"
|
||||
If Not FromPath.EndsWithF("\") Then FromPath &= "\"
|
||||
ToPath = ToPath.Replace("/", "\")
|
||||
If Not ToPath.EndsWith("\") Then ToPath &= "\"
|
||||
If Not ToPath.EndsWithF("\") Then ToPath &= "\"
|
||||
For Each File In EnumerateFiles(FromPath)
|
||||
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
|
||||
Next
|
||||
@@ -1363,7 +1338,7 @@ Re:
|
||||
Loop
|
||||
DescList = DescList.Distinct.ToList
|
||||
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
|
||||
Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "")
|
||||
Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "")
|
||||
|
||||
'常见错误(记得同时修改下面的)
|
||||
Dim CommonReason As String = Nothing
|
||||
@@ -1562,6 +1537,48 @@ Re:
|
||||
Next
|
||||
Return tmp.ToString()
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 检查字符串中的字符是否均为 ASCII 字符。
|
||||
''' </summary>
|
||||
<Extension> Public Function IsASCII(Input As String) As Boolean
|
||||
Return Input.All(Function(c) AscW(c) < 128)
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 高速的 StartsWith。
|
||||
''' </summary>
|
||||
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
|
||||
Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
|
||||
Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 高速的 EndsWith。
|
||||
''' </summary>
|
||||
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
|
||||
Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
|
||||
Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 支持可变大小写判断的 Contains。
|
||||
''' </summary>
|
||||
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
|
||||
Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
|
||||
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 高速的 IndexOf。
|
||||
''' </summary>
|
||||
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
|
||||
Public Function IndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
|
||||
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 高速的 LastIndexOf。
|
||||
''' </summary>
|
||||
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
|
||||
Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
|
||||
Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 输入 And 字符不会报错的 Val。
|
||||
@@ -1645,14 +1662,14 @@ Re:
|
||||
Source = Source.ToLower.Replace(" ", "")
|
||||
Query = Query.ToLower.Replace(" ", "")
|
||||
Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
|
||||
Do While qp < Query.Length
|
||||
Do While qp < queryLength
|
||||
'对 qp 作为开始位置计算
|
||||
Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
|
||||
'查找以 qp 为头的最大子串
|
||||
Do While sp < Source.Length
|
||||
'对每个 sp 作为开始位置计算最大子串
|
||||
Dim len As Integer = 0
|
||||
Do While (qp + len) < Query.Length AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
|
||||
Do While (qp + len) < queryLength AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
|
||||
len += 1
|
||||
Loop
|
||||
'存储 len
|
||||
@@ -1667,7 +1684,7 @@ Re:
|
||||
Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空
|
||||
'存储 lenSum
|
||||
Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
|
||||
IncWeight *= (1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax))) '根据位置加成
|
||||
IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
|
||||
lenSum += IncWeight
|
||||
End If
|
||||
'根据结果增加 qp
|
||||
@@ -1717,23 +1734,24 @@ Re:
|
||||
Public Function Search(Of T)(Entries As List(Of SearchEntry(Of T)), Query As String, Optional MaxBlurCount As Integer = 5, Optional MinBlurSimilarity As Double = 0.1) As List(Of SearchEntry(Of T))
|
||||
'初始化
|
||||
Dim ResultList As New List(Of SearchEntry(Of T))
|
||||
If Entries.Count = 0 Then Return ResultList
|
||||
If Not Entries.Any() Then Return ResultList
|
||||
'进行搜索,获取相似信息
|
||||
For Each Entry In Entries
|
||||
Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
|
||||
Entry.AbsoluteRight = False
|
||||
For Each Pair In Entry.SearchSource
|
||||
If Pair.Key.ToLower.Replace(" ", "").Contains(Query.ToLower.Replace(" ", "")) Then Entry.AbsoluteRight = True
|
||||
If Pair.Key.Replace(" ", "").ContainsF(Query.Replace(" ", ""), True) Then Entry.AbsoluteRight = True
|
||||
Next
|
||||
Next
|
||||
'按照相似度进行排序
|
||||
Entries = Sort(Entries, Function(Left As SearchEntry(Of T), Right As SearchEntry(Of T)) As Boolean
|
||||
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
|
||||
Return Left.AbsoluteRight
|
||||
Else
|
||||
Return Left.Similarity > Right.Similarity
|
||||
End If
|
||||
End Function)
|
||||
Entries = Sort(Entries,
|
||||
Function(Left, Right) As Boolean
|
||||
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
|
||||
Return Left.AbsoluteRight
|
||||
Else
|
||||
Return Left.Similarity > Right.Similarity
|
||||
End If
|
||||
End Function)
|
||||
'返回结果
|
||||
Dim BlurCount As Integer = 0
|
||||
For Each Entry In Entries
|
||||
@@ -1980,9 +1998,10 @@ NextElement:
|
||||
Log("[System] 执行外部命令并等待返回结果:" & FileName & " " & Arguments)
|
||||
Using Program As New Process() With {.StartInfo = Info}
|
||||
Program.Start()
|
||||
Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
|
||||
Program.WaitForExit(Timeout)
|
||||
If Not Program.HasExited Then Program.Kill()
|
||||
Return Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
|
||||
Return Result
|
||||
End Using
|
||||
End Function
|
||||
|
||||
@@ -2056,7 +2075,7 @@ NextElement:
|
||||
''' <param name="SortRule">传入两个对象,若第一个对象应该排在前面,则返回 True。</param>
|
||||
Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T)
|
||||
Dim NewList As New List(Of T)
|
||||
While List.Count > 0
|
||||
While List.Any
|
||||
Dim Highest = List(0)
|
||||
For i = 1 To List.Count - 1
|
||||
If SortRule(List(i), Highest) Then Highest = List(i)
|
||||
@@ -2084,7 +2103,7 @@ NextElement:
|
||||
Dim AllArguments() As String = Command.Split(" ")
|
||||
For i = 0 To AllArguments.Length - 1
|
||||
If AllArguments(i) = "-" & Name Then
|
||||
If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWith("-") Then Return True
|
||||
If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWithF("-") Then Return True
|
||||
Return AllArguments(i + 1)
|
||||
End If
|
||||
Next
|
||||
@@ -2111,6 +2130,7 @@ NextElement:
|
||||
''' </summary>
|
||||
Public Sub OpenWebsite(Url As String)
|
||||
Try
|
||||
If Not Url.StartsWithF("http", True) Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
|
||||
Log("[System] 正在打开网页:" & Url)
|
||||
Process.Start(Url)
|
||||
Catch ex As Exception
|
||||
@@ -2628,7 +2648,7 @@ Retry:
|
||||
''' </summary>
|
||||
Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T)
|
||||
Shuffle = New List(Of T)
|
||||
Do While array.Count > 0
|
||||
Do While array.Any
|
||||
Dim i As Integer = RandomInteger(0, array.Count - 1)
|
||||
Shuffle.Add(array(i))
|
||||
array.RemoveAt(i)
|
||||
|
||||
@@ -490,7 +490,7 @@
|
||||
Select Case Loader.State
|
||||
Case LoadState.Finished
|
||||
'检查是否需要重启
|
||||
If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
|
||||
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
|
||||
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
|
||||
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
|
||||
GoTo Restart
|
||||
@@ -500,7 +500,7 @@
|
||||
End If
|
||||
Case LoadState.Loading
|
||||
'检查是否需要重启
|
||||
If Loader.GetType.Name.StartsWith("LoaderTask") Then
|
||||
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
|
||||
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
|
||||
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
|
||||
GoTo Restart
|
||||
@@ -517,9 +517,9 @@ Restart:
|
||||
If Input IsNot Nothing Then
|
||||
'若输入类型与下一个加载器相同才继续
|
||||
Dim LoaderType As String = Loader.GetType.Name
|
||||
If LoaderType.StartsWith("LoaderTask") OrElse LoaderType.StartsWith("LoaderCombo") Then
|
||||
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
|
||||
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
|
||||
ElseIf LoaderType.StartsWith("LoaderDownload") Then
|
||||
ElseIf LoaderType.StartsWithF("LoaderDownload") Then
|
||||
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
|
||||
Else
|
||||
Throw New Exception("未知的加载器类型(" & LoaderType & ")")
|
||||
@@ -545,7 +545,7 @@ Restart:
|
||||
Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
|
||||
For Each SubLoader In Loader.Loaders
|
||||
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
|
||||
If SubLoader.GetType.Name.StartsWith("LoaderCombo") Then GetLoaderList(SubLoader, List)
|
||||
If SubLoader.GetType.Name.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
|
||||
Next
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -571,7 +571,7 @@ Restart:
|
||||
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
|
||||
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
|
||||
|
||||
Public Sub LoaderTaskbarAdd(Loader As LoaderBase)
|
||||
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
|
||||
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
|
||||
SyncLock LoaderTaskbarLock
|
||||
LoaderTaskbar.Add(Loader)
|
||||
@@ -587,11 +587,11 @@ Restart:
|
||||
'外显任务是否已经全部完成
|
||||
Dim IsAllDownloadTaskCompleted As Boolean = True
|
||||
For Each Loader In LoaderTaskbar
|
||||
If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
|
||||
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
|
||||
Next
|
||||
'若单个任务已中止或全部任务已完成,则刷新并移除
|
||||
For Each Task In LoaderTaskbar.ToList()
|
||||
If (IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting) AndAlso Task.Show Then
|
||||
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
|
||||
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
|
||||
LoaderTaskbar.Remove(Task)
|
||||
Log($"[Taskbar] {Task.Name} 已移出任务列表")
|
||||
@@ -606,7 +606,7 @@ Restart:
|
||||
End If
|
||||
RunInUi(Sub() FrmMain.BtnExtraDownload.Progress = LoaderTaskbarProgress)
|
||||
'更新任务栏信息
|
||||
If LoaderTaskbar.Count = 0 OrElse LoaderTaskbarProgress = 1 Then
|
||||
If Not LoaderTaskbar.Any() OrElse LoaderTaskbarProgress = 1 Then
|
||||
NewState = Shell.TaskbarItemProgressState.None
|
||||
ElseIf LoaderTaskbarProgress < 0.015 Then
|
||||
NewState = Shell.TaskbarItemProgressState.Indeterminate
|
||||
@@ -628,7 +628,6 @@ Restart:
|
||||
Dim Total As Double = 0, Count As Integer = 0
|
||||
SyncLock LoaderTaskbarLock
|
||||
For Each Task In LoaderTaskbar.ToList
|
||||
If Not Task.Show Then Continue For
|
||||
Total += Task.Progress
|
||||
Count += 1 '避免多线程影响导致计数出错
|
||||
Next
|
||||
|
||||
File diff suppressed because it is too large.
Load diff
@@ -76,7 +76,7 @@ Public Class ValidateHttp
|
||||
Public Sub New()
|
||||
End Sub '用于 XAML 初始化
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
If Str.EndsWith("/") Then Str = Str.Substring(0, Str.Length - 1)
|
||||
If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
|
||||
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效!"
|
||||
Return ""
|
||||
End Function
|
||||
@@ -149,7 +149,7 @@ Public Class ValidateExcept
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
For Each Ch As String In Excepts
|
||||
If Str.IndexOf(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
|
||||
If Str.IndexOfF(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
|
||||
If IsNothing(ErrorMessage) Then ErrorMessage = ""
|
||||
Return ErrorMessage.Replace("%", Ch)
|
||||
End If
|
||||
@@ -220,13 +220,13 @@ Public Class ValidateFolderName
|
||||
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
|
||||
If Not LengthCheck = "" Then Return LengthCheck
|
||||
'检查空格
|
||||
If Str.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
|
||||
If Str.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
|
||||
If Str.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
|
||||
If Str.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
|
||||
'检查长度
|
||||
LengthCheck = New ValidateLength(1, 100).Validate(Str)
|
||||
If Not LengthCheck = "" Then Return LengthCheck
|
||||
'检查尾部小数点
|
||||
If Str.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
|
||||
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
|
||||
'检查特殊字符
|
||||
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
|
||||
If Not CharactCheck = "" Then Return CharactCheck
|
||||
@@ -273,13 +273,13 @@ Public Class ValidateFileName
|
||||
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
|
||||
If Not LengthCheck = "" Then Return LengthCheck
|
||||
'检查空格
|
||||
If Str.StartsWith(" ") Then Return "文件名不能以空格开头!"
|
||||
If Str.EndsWith(" ") Then Return "文件名不能以空格结尾!"
|
||||
If Str.StartsWithF(" ") Then Return "文件名不能以空格开头!"
|
||||
If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾!"
|
||||
'检查长度
|
||||
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
|
||||
If Not LengthCheck = "" Then Return LengthCheck
|
||||
'检查尾部小数点
|
||||
If Str.EndsWith(".") Then Return "文件名不能以小数点结尾!"
|
||||
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾!"
|
||||
'检查特殊字符
|
||||
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
|
||||
If Not CharactCheck = "" Then Return CharactCheck
|
||||
@@ -319,7 +319,7 @@ Public Class ValidateFolderPath
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
'去除尾部斜线,统一为 \
|
||||
Str = Str.Replace("/", "\")
|
||||
If Not Str.TrimEnd("\").EndsWith(":") Then Str = Str.TrimEnd("\")
|
||||
If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
|
||||
'检查是否为空
|
||||
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
|
||||
If Not LengthCheck = "" Then Return LengthCheck
|
||||
@@ -327,15 +327,15 @@ Public Class ValidateFolderPath
|
||||
LengthCheck = New ValidateLength(1, 254).Validate(Str)
|
||||
If Not LengthCheck = "" Then Return LengthCheck
|
||||
'检查开头
|
||||
If Str.StartsWith("\\Mac\") Then GoTo Fin
|
||||
If Str.StartsWithF("\\Mac\") Then GoTo Fin
|
||||
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
|
||||
If Str.ToUpper = Drive.Name Then Return ""
|
||||
If Str.ToUpper.StartsWith(Drive.Name) Then GoTo Fin
|
||||
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
|
||||
Next
|
||||
Return "文件夹路径头存在错误!"
|
||||
Fin:
|
||||
'对首层以外的路径检查
|
||||
For i = If(Str.StartsWith("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
|
||||
For i = If(Str.StartsWithF("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
|
||||
Dim SubStr As String = Str.Split("\")(i)
|
||||
'检查是否为空
|
||||
Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr)
|
||||
@@ -344,10 +344,10 @@ Fin:
|
||||
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
|
||||
If Not CharactCheck = "" Then Return CharactCheck
|
||||
'检查头部空格
|
||||
If SubStr.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
|
||||
If SubStr.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
|
||||
If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
|
||||
If SubStr.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
|
||||
'检查尾部小数点
|
||||
If SubStr.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
|
||||
If SubStr.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
|
||||
'检查特殊字符串
|
||||
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
|
||||
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
|
||||
|
||||
@@ -55,7 +55,7 @@ Public Class MyBitmap
|
||||
Public Sub New(FilePathOrResourceName As String)
|
||||
Try
|
||||
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
|
||||
If FilePathOrResourceName.StartsWith(PathImage) Then
|
||||
If FilePathOrResourceName.StartsWithF(PathImage) Then
|
||||
'使用缓存
|
||||
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
|
||||
Pic = BitmapCache(FilePathOrResourceName).Pic
|
||||
|
||||
@@ -18,6 +18,7 @@
|
||||
'https://docs.curseforge.com/?http#tocS_ModLoaderType
|
||||
Any = 0
|
||||
Forge = 1
|
||||
LiteLoader = 3
|
||||
Fabric = 4
|
||||
Quilt = 5
|
||||
NeoForge = 6
|
||||
@@ -43,10 +44,10 @@
|
||||
For Each EntryData As String In Line.Split("¨")
|
||||
Dim Entry = New CompDatabaseEntry
|
||||
Dim SplitedLine = EntryData.Split("|")
|
||||
If SplitedLine(0).StartsWith("@") Then
|
||||
If SplitedLine(0).StartsWithF("@") Then
|
||||
Entry.CurseForgeSlug = Nothing
|
||||
Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
|
||||
ElseIf SplitedLine(0).EndsWith("@") Then
|
||||
ElseIf SplitedLine(0).EndsWithF("@") Then
|
||||
Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
|
||||
Entry.ModrinthSlug = Entry.CurseForgeSlug
|
||||
ElseIf SplitedLine(0).Contains("@") Then
|
||||
@@ -59,7 +60,6 @@
|
||||
Entry.WikiId = i
|
||||
If SplitedLine.Count >= 2 Then
|
||||
Entry.ChineseName = SplitedLine(1)
|
||||
Entry.MCBBS = If(SplitedLine.Count >= 3, SplitedLine(2), Nothing)
|
||||
If Entry.ChineseName.Contains("*") Then '处理 *
|
||||
Entry.ChineseName = Entry.ChineseName.Replace("*", " (" &
|
||||
String.Join(" ", If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
|
||||
@@ -82,10 +82,6 @@
|
||||
''' </summary>
|
||||
Public ChineseName As String = ""
|
||||
''' <summary>
|
||||
''' MCBBS 发布帖编号(例如 195107)。若为 Nothing 则没有发布帖。
|
||||
''' </summary>
|
||||
Public MCBBS As Integer?
|
||||
''' <summary>
|
||||
''' CurseForge Slug(例如 advanced-solar-panels)。
|
||||
''' </summary>
|
||||
Public CurseForgeSlug As String = Nothing
|
||||
@@ -95,7 +91,7 @@
|
||||
Public ModrinthSlug As String = Nothing
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName & If(MCBBS Is Nothing, "", "|" & MCBBS)
|
||||
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName
|
||||
End Function
|
||||
End Class
|
||||
|
||||
@@ -200,14 +196,6 @@
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' MCBBS 的帖子 ID。若为 0 则没有。
|
||||
''' </summary>
|
||||
Public ReadOnly Property MCBBS As Integer
|
||||
Get
|
||||
Return If(DatabaseEntry Is Nothing, 0, If(DatabaseEntry.MCBBS, 0))
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 翻译后的中文名。若数据库没有则等同于 RawName。
|
||||
''' </summary>
|
||||
Public ReadOnly Property TranslatedName As String
|
||||
@@ -260,12 +248,26 @@
|
||||
LastUpdate = Data("dateReleased") '#1194
|
||||
DownloadCount = Data("downloadCount")
|
||||
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
|
||||
'FileIndexes / GameVersions
|
||||
Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray).
|
||||
Where(Function(i) i("gameVersion").ToString.Contains("1."))
|
||||
CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).Distinct.ToList
|
||||
GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
|
||||
Distinct.OrderByDescending(Function(v) v).ToList
|
||||
'FileIndexes / GameVersions / ModLoaders
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
|
||||
For Each File In If(Data("latestFiles"), New JArray)
|
||||
Dim NewFile As New CompFile(File, Type)
|
||||
If Not NewFile.Available Then Continue For
|
||||
ModLoaders.AddRange(NewFile.ModLoaders)
|
||||
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
|
||||
If Not GameVersions.Any(Function(v) v.StartsWithF("1.")) Then Continue For
|
||||
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
|
||||
Next
|
||||
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599
|
||||
If Not File("gameVersion").ToString.StartsWithF("1.") Then Continue For
|
||||
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
|
||||
Next
|
||||
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
|
||||
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
|
||||
Select(Function(v) CInt(Val(v.Split(".")(1).Split("-").First))).Where(Function(v) v > 0).
|
||||
Distinct.OrderByDescending(Function(v) v).ToList
|
||||
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
|
||||
'Type
|
||||
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
|
||||
Type = CompType.Mod
|
||||
@@ -322,15 +324,7 @@
|
||||
'FUTURE: Res
|
||||
End Select
|
||||
Next
|
||||
If Tags.Count = 0 Then Tags.Add("杂项")
|
||||
'ModLoaders
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
For Each File In If(Data("latestFiles"), {})
|
||||
Dim NewFile As New CompFile(File, Type)
|
||||
If Not NewFile.Available Then Continue For
|
||||
ModLoaders.AddRange(NewFile.ModLoaders)
|
||||
Next
|
||||
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
|
||||
If Not Tags.Any() Then Tags.Add("杂项")
|
||||
#End Region
|
||||
Else
|
||||
#Region "Modrinth"
|
||||
@@ -347,7 +341,7 @@
|
||||
'GameVersions
|
||||
'搜索结果的键为 versions,获取特定工程的键为 game_versions
|
||||
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
|
||||
Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")).
|
||||
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
|
||||
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
|
||||
Distinct.OrderByDescending(Function(v) v).ToList
|
||||
'Type
|
||||
@@ -396,7 +390,7 @@
|
||||
'FUTURE: Res
|
||||
End Select
|
||||
Next
|
||||
If Tags.Count = 0 Then Tags.Add("杂项")
|
||||
If Not Tags.Any() Then Tags.Add("杂项")
|
||||
Tags.Sort()
|
||||
ModLoaders.Sort()
|
||||
#End Region
|
||||
@@ -420,10 +414,10 @@
|
||||
Json("Website") = Website
|
||||
If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate
|
||||
Json("DownloadCount") = DownloadCount
|
||||
If ModLoaders IsNot Nothing AndAlso ModLoaders.Count > 0 Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
|
||||
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
|
||||
Json("Tags") = New JArray(Tags)
|
||||
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
|
||||
If GameVersions.Count > 0 Then Json("GameVersions") = New JArray(GameVersions)
|
||||
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
|
||||
Json("CacheTime") = Date.Now '用于检查缓存时间
|
||||
Return Json
|
||||
End Function
|
||||
@@ -575,7 +569,7 @@
|
||||
End If
|
||||
Next
|
||||
'根据分类后的结果处理
|
||||
If NormalNameList.Count = 0 OrElse SubtitleList.Count = 0 Then GoTo NoSubtitle
|
||||
If Not NormalNameList.Any() OrElse Not SubtitleList.Any() Then GoTo NoSubtitle
|
||||
'同时包含 NormalName 和 Subtitle
|
||||
Title = NormalNameList.Join(" - ")
|
||||
Else
|
||||
@@ -602,7 +596,7 @@
|
||||
SubtitleList = SubtitleList.Distinct().ToList()
|
||||
'设置标题与描述
|
||||
Dim Subtitle As String = ""
|
||||
If SubtitleList.Count > 0 Then
|
||||
If SubtitleList.Any Then
|
||||
For Each Ex In SubtitleList
|
||||
Dim IsModLoaderDescription As Boolean =
|
||||
Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")
|
||||
@@ -696,8 +690,8 @@ NoSubtitle:
|
||||
''' </summary>
|
||||
Public ReadOnly Property CanContinue As Boolean
|
||||
Get
|
||||
If Tag.StartsWith("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
|
||||
If Tag.EndsWith("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
|
||||
If Tag.StartsWithF("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
|
||||
If Tag.EndsWithF("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
|
||||
If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
|
||||
Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
|
||||
End Get
|
||||
@@ -745,7 +739,7 @@ NoSubtitle:
|
||||
''' </summary>
|
||||
Public Function GetCurseForgeAddress() As String
|
||||
If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing
|
||||
If Tag.StartsWith("/") Then Storage.CurseForgeTotal = 0
|
||||
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
|
||||
If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
|
||||
'应用筛选参数
|
||||
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}"
|
||||
@@ -769,7 +763,7 @@ NoSubtitle:
|
||||
''' </summary>
|
||||
Public Function GetModrinthAddress() As String
|
||||
If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing
|
||||
If Tag.EndsWith("/") Then Storage.ModrinthTotal = 0
|
||||
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
|
||||
If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
|
||||
'应用筛选参数
|
||||
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance"
|
||||
@@ -841,7 +835,7 @@ NoSubtitle:
|
||||
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
|
||||
Exit Sub
|
||||
ElseIf Not Task.Input.CanContinue Then
|
||||
If Task.Input.Storage.Results.Count = 0 Then
|
||||
If Not Task.Input.Storage.Results.Any() Then
|
||||
Throw New Exception("没有符合条件的结果")
|
||||
Else
|
||||
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
|
||||
@@ -880,20 +874,20 @@ NoSubtitle:
|
||||
Next
|
||||
'获取搜索结果
|
||||
Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3)
|
||||
If SearchResults.Count = 0 Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
|
||||
If Not SearchResults.Any() Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
|
||||
Dim SearchResult As String = ""
|
||||
For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
|
||||
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
|
||||
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ") & " "
|
||||
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ") & " "
|
||||
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
|
||||
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
|
||||
SearchResult += SearchResults(i).Item.ChineseName.Split(" (").Last.TrimEnd(") ").Split(" - ").First.
|
||||
Replace(":", "").Replace("(", "").Replace(")", "").ToLower & " "
|
||||
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
|
||||
Next
|
||||
Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
|
||||
'去除常见连接词
|
||||
Dim RealFilter As String = ""
|
||||
For Each Word In SearchResult.Split(" ")
|
||||
If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLower) OrElse Val(Word) > 0 Then Continue For
|
||||
If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLowerInvariant) OrElse Val(Word) > 0 Then Continue For
|
||||
If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
|
||||
RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
|
||||
Next
|
||||
@@ -911,23 +905,22 @@ NoSubtitle:
|
||||
For Each Keyword In AllPossibleKeywords.Split(" ")
|
||||
Keyword = Keyword.Trim("["c, "]"c)
|
||||
If Keyword = "" Then Continue For
|
||||
If {"forge", "fabric", "for", "mod",
|
||||
"forge/fabric", "fabric/forge", "fabric/quilt", "quilt/fabric"}.Contains(Keyword) Then '#208
|
||||
Log("[Comp] 已跳过搜索关键词:" & Keyword)
|
||||
If {"forge", "fabric", "for", "mod", "quilt"}.Contains(Keyword) Then '#208
|
||||
Log("[Comp] 已跳过搜索关键词:" & Keyword, LogLevel.Developer)
|
||||
Continue For
|
||||
End If
|
||||
RightKeywords.Add(Keyword)
|
||||
Next
|
||||
If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then
|
||||
If RawFilter.Length > 0 AndAlso Not RightKeywords.Any() Then
|
||||
Task.Input.SearchText = RawFilter '全都被过滤掉了
|
||||
Else
|
||||
Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
|
||||
End If
|
||||
|
||||
'例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
|
||||
If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchText = "optiforge"
|
||||
If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchText = "optifabric"
|
||||
Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Developer)
|
||||
If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Task.Input.SearchText = "optiforge"
|
||||
If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Task.Input.SearchText = "optifabric"
|
||||
Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Debug)
|
||||
Task.Progress = 0.1
|
||||
|
||||
#End Region
|
||||
@@ -1017,15 +1010,15 @@ Retry:
|
||||
|
||||
'确保存在结果
|
||||
Storage.ErrorMessage = Nothing
|
||||
If RawResults.Count = 0 Then
|
||||
If Not RawResults.Any() Then
|
||||
If [Error] IsNot Nothing Then
|
||||
Throw [Error]
|
||||
Else
|
||||
If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then
|
||||
Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文")
|
||||
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWith("/") Then
|
||||
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWithF("/") Then
|
||||
Throw New Exception("CurseForge 不兼容所选的类型")
|
||||
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWith("/") Then
|
||||
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
|
||||
Throw New Exception("Modrinth 不兼容所选的类型")
|
||||
Else
|
||||
Throw New Exception("没有符合条件的结果")
|
||||
@@ -1185,7 +1178,7 @@ Retry:
|
||||
''' </summary>
|
||||
Public ReadOnly Property Available As Boolean
|
||||
Get
|
||||
Return FileName IsNot Nothing
|
||||
Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
@@ -1195,7 +1188,11 @@ Retry:
|
||||
''' <summary>
|
||||
''' 文件所有可能的下载源。
|
||||
''' </summary>
|
||||
Private ReadOnly DownloadAddress As String()
|
||||
Public DownloadUrls As List(Of String)
|
||||
''' <summary>
|
||||
''' 文件的 SHA1 或 MD5。
|
||||
''' </summary>
|
||||
Public ReadOnly Hash As String = Nothing
|
||||
''' <summary>
|
||||
''' 该文件的所有依赖工程的原始 ID。
|
||||
''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
|
||||
@@ -1210,7 +1207,7 @@ Retry:
|
||||
''' </summary>
|
||||
''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
|
||||
Public Function ToNetFile(LocalAddress As String) As NetFile
|
||||
Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""))
|
||||
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
|
||||
End Function
|
||||
|
||||
'实例化
|
||||
@@ -1220,94 +1217,136 @@ Retry:
|
||||
''' </summary>
|
||||
Public Sub New(Data As JObject, Type As CompType)
|
||||
Me.Type = Type
|
||||
FromCurseForge = Data.ContainsKey("gameId")
|
||||
If FromCurseForge Then
|
||||
#Region "CurseForge"
|
||||
'简单信息
|
||||
Id = Data("id")
|
||||
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
|
||||
ReleaseDate = Data("fileDate")
|
||||
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
|
||||
DownloadCount = Data("downloadCount")
|
||||
FileName = Data("fileName")
|
||||
'DownloadAddress
|
||||
Dim Url = Data("downloadUrl").ToString
|
||||
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
|
||||
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
|
||||
DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
|
||||
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
|
||||
Url.Replace("://edge", "://media"),
|
||||
Url}.Distinct.ToArray
|
||||
'Dependencies
|
||||
If Type = CompType.Mod Then
|
||||
RawDependencies = Data("dependencies").
|
||||
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
|
||||
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
|
||||
Select(Function(d) d("modId").ToString).ToList
|
||||
End If
|
||||
'GameVersions
|
||||
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
|
||||
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
|
||||
If GameVersions.Count > 1 Then
|
||||
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
|
||||
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
|
||||
ElseIf GameVersions.Count = 1 Then
|
||||
GameVersions = GameVersions.ToList
|
||||
Else
|
||||
GameVersions = New List(Of String) From {"未知版本"}
|
||||
End If
|
||||
'ModLoaders
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
|
||||
If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
|
||||
If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
|
||||
If RawVersions.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
|
||||
If Data.ContainsKey("FromCurseForge") Then
|
||||
#Region "CompJson"
|
||||
FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
|
||||
Id = Data("Id").ToString
|
||||
DisplayName = Data("DisplayName").ToString
|
||||
ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
|
||||
DownloadCount = Data("DownloadCount").ToObject(Of Integer)
|
||||
Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus)
|
||||
If Data.ContainsKey("FileName") Then FileName = Data("FileName").ToString
|
||||
If Data.ContainsKey("DownloadUrls") Then DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
|
||||
If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of List(Of CompModLoaderType))
|
||||
If Data.ContainsKey("Hash") Then Hash = Data("Hash").ToString
|
||||
If Data.ContainsKey("GameVersions") Then GameVersions = Data("GameVersions").ToObject(Of List(Of String))
|
||||
If Data.ContainsKey("RawDependencies") Then RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
|
||||
If Data.ContainsKey("Dependencies") Then Dependencies = Data("Dependencies").ToObject(Of List(Of String))
|
||||
#End Region
|
||||
Else
|
||||
#Region "Modrinth"
|
||||
'简单信息
|
||||
Id = Data("id")
|
||||
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
|
||||
ReleaseDate = Data("date_published")
|
||||
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
|
||||
DownloadCount = Data("downloads")
|
||||
'可能为空
|
||||
If CType(Data("files"), JArray).Count > 0 Then
|
||||
FileName = Data("files")(0)("filename")
|
||||
DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, FileName)}
|
||||
End If
|
||||
'Dependencies
|
||||
If Type = CompType.Mod Then
|
||||
RawDependencies = Data("dependencies").
|
||||
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
|
||||
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
|
||||
d("project_id").ToString.Length > 0). '有时候真的会空……
|
||||
Select(Function(d) d("project_id").ToString).ToList
|
||||
End If
|
||||
'GameVersions
|
||||
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
|
||||
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.") OrElse v.StartsWith("b1.")).
|
||||
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWith("b1."), "远古版本", v))).ToList
|
||||
If GameVersions.Count > 1 Then
|
||||
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
|
||||
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
|
||||
ElseIf GameVersions.Count = 1 Then
|
||||
'无需处理
|
||||
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
|
||||
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
|
||||
Else
|
||||
GameVersions = New List(Of String) From {"未知版本"}
|
||||
End If
|
||||
'ModLoaders
|
||||
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
|
||||
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
|
||||
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
|
||||
FromCurseForge = Data.ContainsKey("gameId")
|
||||
If FromCurseForge Then
|
||||
#Region "CurseForge"
|
||||
'简单信息
|
||||
Id = Data("id")
|
||||
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
|
||||
ReleaseDate = Data("fileDate")
|
||||
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
|
||||
DownloadCount = Data("downloadCount")
|
||||
FileName = Data("fileName")
|
||||
Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
|
||||
If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
|
||||
'DownloadAddress
|
||||
Dim Url = Data("downloadUrl").ToString
|
||||
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
|
||||
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
|
||||
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
|
||||
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
|
||||
Url.Replace("://edge", "://media"),
|
||||
Url}).Distinct().ToList()
|
||||
'Dependencies
|
||||
If Type = CompType.Mod Then
|
||||
RawDependencies = Data("dependencies").
|
||||
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
|
||||
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
|
||||
Select(Function(d) d("modId").ToString).ToList
|
||||
End If
|
||||
'GameVersions
|
||||
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
|
||||
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
|
||||
If GameVersions.Count > 1 Then
|
||||
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
|
||||
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
|
||||
ElseIf GameVersions.Count = 1 Then
|
||||
GameVersions = GameVersions.ToList
|
||||
Else
|
||||
GameVersions = New List(Of String) From {"未知版本"}
|
||||
End If
|
||||
'ModLoaders
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
|
||||
If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
|
||||
If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
|
||||
If RawVersions.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
|
||||
#End Region
|
||||
Else
|
||||
#Region "Modrinth"
|
||||
'简单信息
|
||||
Id = Data("id")
|
||||
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
|
||||
ReleaseDate = Data("date_published")
|
||||
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
|
||||
DownloadCount = Data("downloads")
|
||||
'可能为空
|
||||
If CType(Data("files"), JArray).Any() Then
|
||||
Dim File As JToken = Data("files")(0)
|
||||
FileName = File("filename")
|
||||
DownloadUrls = New List(Of String) From {File("url")}
|
||||
Hash = File("hashes")("sha1")
|
||||
End If
|
||||
'Dependencies
|
||||
If Type = CompType.Mod Then
|
||||
RawDependencies = Data("dependencies").
|
||||
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
|
||||
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
|
||||
d("project_id").ToString.Length > 0). '有时候真的会空……
|
||||
Select(Function(d) d("project_id").ToString).ToList
|
||||
End If
|
||||
'GameVersions
|
||||
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
|
||||
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
|
||||
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
|
||||
If GameVersions.Count > 1 Then
|
||||
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
|
||||
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
|
||||
ElseIf GameVersions.Count = 1 Then
|
||||
'无需处理
|
||||
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
|
||||
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
|
||||
Else
|
||||
GameVersions = New List(Of String) From {"未知版本"}
|
||||
End If
|
||||
'ModLoaders
|
||||
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
|
||||
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
|
||||
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
|
||||
#End Region
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 将当前实例转为可用于保存缓存的 Json。
|
||||
''' </summary>
|
||||
Public Function ToJson() As JObject
|
||||
Dim Json As New JObject
|
||||
Json.Add("FromCurseForge", FromCurseForge)
|
||||
Json.Add("Id", Id)
|
||||
Json.Add("DisplayName", DisplayName)
|
||||
Json.Add("ReleaseDate", ReleaseDate)
|
||||
Json.Add("DownloadCount", DownloadCount)
|
||||
Json.Add("ModLoaders", New JArray(ModLoaders.Select(Function(m) CInt(m))))
|
||||
Json.Add("GameVersions", New JArray(GameVersions))
|
||||
Json.Add("Status", CInt(Status))
|
||||
If FileName IsNot Nothing Then Json.Add("FileName", FileName)
|
||||
If DownloadUrls IsNot Nothing Then Json.Add("DownloadUrls", New JArray(DownloadUrls))
|
||||
If Hash IsNot Nothing Then Json.Add("Hash", Hash)
|
||||
Json.Add("RawDependencies", New JArray(RawDependencies))
|
||||
Json.Add("Dependencies", New JArray(Dependencies))
|
||||
Return Json
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 将当前文件信息实例化为控件。
|
||||
''' </summary>
|
||||
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
|
||||
@@ -1317,9 +1356,9 @@ Retry:
|
||||
Dim Info As String = ""
|
||||
Select Case Type
|
||||
Case CompType.Mod
|
||||
Info += If(ModLoaders.Count > 0,
|
||||
Info += If(ModLoaders.Any,
|
||||
"适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
|
||||
Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "")
|
||||
Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod,", "")
|
||||
Case CompType.ModPack
|
||||
If GameVersions.All(Function(v) v.Contains("w")) Then
|
||||
Info += $"游戏版本 {Join(GameVersions, "、")},"
|
||||
@@ -1413,7 +1452,7 @@ Retry:
|
||||
SelectMany(Function(f) f.RawDependencies).Distinct().ToList
|
||||
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
|
||||
'获取前置 Mod 工程信息
|
||||
If UndoneDeps.Count > 0 Then
|
||||
If UndoneDeps.Any Then
|
||||
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
|
||||
Dim Projects As JArray
|
||||
If TargetProject.FromCurseForge Then
|
||||
@@ -1428,7 +1467,7 @@ Retry:
|
||||
Next
|
||||
End If
|
||||
'更新前置 Mod 信息
|
||||
If Deps.Count > 0 Then
|
||||
If Deps.Any Then
|
||||
For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
|
||||
For Each File In CompFilesCache(ProjectId)
|
||||
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
|
||||
@@ -1448,7 +1487,7 @@ Retry:
|
||||
'如果为整合包就不会有 Dependencies 信息,所以不用管
|
||||
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
|
||||
Deps.Sort()
|
||||
If Deps.Count = 0 Then Exit Sub
|
||||
If Not Deps.Any() Then Exit Sub
|
||||
Deps = Deps.Where(Function(dep)
|
||||
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
|
||||
Return CompProjectCache.ContainsKey(dep)
|
||||
|
||||
@@ -80,7 +80,7 @@
|
||||
Log(ex, "确认崩溃日志时间失败(" & LogFile & ")")
|
||||
End Try
|
||||
Next
|
||||
If RightLogs.Count = 0 Then Log("[Crash] 未发现可能可用的日志文件")
|
||||
If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件")
|
||||
|
||||
'将可能可用的日志文件导出
|
||||
For Each FilePath In RightLogs
|
||||
@@ -94,7 +94,7 @@
|
||||
Log(ex, "读取可能的崩溃日志文件失败(" & FilePath & ")")
|
||||
End Try
|
||||
Next
|
||||
If LatestLog IsNot Nothing AndAlso LatestLog.Count > 0 Then
|
||||
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
|
||||
Dim RawOutput As String = Join(LatestLog, vbCrLf)
|
||||
Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput)
|
||||
WriteFile(TempFolder & "RawOutput.log", RawOutput)
|
||||
@@ -110,21 +110,20 @@
|
||||
Public Sub Import(FilePath As String)
|
||||
Log("[Crash] 步骤 1:自主导入日志文件")
|
||||
|
||||
'解压压缩包
|
||||
'尝试视作压缩包解压
|
||||
Try
|
||||
Dim Info As New FileInfo(FilePath)
|
||||
If Not Info.Exists OrElse Info.Length = 0 Then Exit Try
|
||||
If Not FilePath.ToLower.EndsWith(".jar") AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then
|
||||
'解压成功
|
||||
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
|
||||
ExtractFile(FilePath, TempFolder & "Temp\")
|
||||
Log("[Crash] 已解压导入的日志文件:" & FilePath)
|
||||
Else
|
||||
'解压失败
|
||||
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
|
||||
Log("[Crash] 已复制导入的日志文件:" & FilePath)
|
||||
GoTo Extracted
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "解压导入文件中的压缩包失败")
|
||||
Catch
|
||||
End Try
|
||||
'并非压缩包
|
||||
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
|
||||
Log("[Crash] 已复制导入的日志文件:" & FilePath)
|
||||
Extracted:
|
||||
|
||||
'导入其中的日志文件
|
||||
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
|
||||
@@ -132,7 +131,7 @@
|
||||
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
|
||||
Dim Ext As String = TargetFile.Extension.ToLower
|
||||
If Ext = ".log" OrElse Ext = ".txt" Then
|
||||
If TargetFile.Name.StartsWith("crash-") Then
|
||||
If TargetFile.Name.StartsWithF("crash-") Then
|
||||
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
|
||||
Else
|
||||
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
|
||||
@@ -169,10 +168,10 @@
|
||||
For Each LogFile In AnalyzeRawFiles
|
||||
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
|
||||
Dim TargetType As AnalyzeFileType
|
||||
If MatchName.StartsWith("hs_err") Then
|
||||
If MatchName.StartsWithF("hs_err") Then
|
||||
TargetType = AnalyzeFileType.HsErr
|
||||
DirectFile = LogFile
|
||||
ElseIf MatchName.StartsWith("crash-") Then
|
||||
ElseIf MatchName.StartsWithF("crash-") Then
|
||||
TargetType = AnalyzeFileType.CrashReport
|
||||
DirectFile = LogFile
|
||||
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
|
||||
@@ -187,13 +186,13 @@
|
||||
Else
|
||||
TargetType = AnalyzeFileType.ExtraLog
|
||||
End If
|
||||
ElseIf MatchName.EndsWith(".log") OrElse MatchName.EndsWith(".txt") Then
|
||||
ElseIf MatchName.EndsWithF(".log", True) OrElse MatchName.EndsWithF(".txt", True) Then
|
||||
TargetType = AnalyzeFileType.ExtraLog
|
||||
Else
|
||||
Log("[Crash] " & MatchName & " 分类为 Ignore")
|
||||
Continue For
|
||||
End If
|
||||
If LogFile.Value.Count = 0 Then
|
||||
If Not LogFile.Value.Any() Then
|
||||
Log("[Crash] " & MatchName & " 由于内容为空跳过")
|
||||
Else
|
||||
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
|
||||
@@ -208,7 +207,7 @@
|
||||
For Each File In TotalFiles
|
||||
If SelectType = File.Key Then SelectedFiles.Add(File.Value)
|
||||
Next
|
||||
If SelectedFiles.Count = 0 Then Continue For
|
||||
If Not SelectedFiles.Any() Then Continue For
|
||||
Try
|
||||
'根据文件类别判断
|
||||
Select Case SelectType
|
||||
@@ -389,9 +388,9 @@
|
||||
|
||||
'1. 精准日志匹配,中/高优先级
|
||||
AnalyzeCrit1()
|
||||
If CrashReasons.Count > 0 Then GoTo Done
|
||||
If CrashReasons.Any Then GoTo Done
|
||||
AnalyzeCrit2()
|
||||
If CrashReasons.Count > 0 Then GoTo Done
|
||||
If CrashReasons.Any Then GoTo Done
|
||||
|
||||
'2. 堆栈分析
|
||||
If LogAll.Contains("orge") OrElse LogAll.Contains("abric") OrElse LogAll.Contains("uilt") OrElse LogAll.Contains("iteloader") Then
|
||||
@@ -406,7 +405,7 @@
|
||||
If LogMc IsNot Nothing Then
|
||||
Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)")
|
||||
Log("[Crash] 开始进行 Minecraft 日志堆栈分析,发现 " & Fatals.Count & " 个报错项")
|
||||
If Fatals.Count > 0 Then
|
||||
If Fatals.Any Then
|
||||
For Each Fatal In Fatals
|
||||
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
|
||||
Next
|
||||
@@ -419,7 +418,7 @@
|
||||
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
|
||||
End If
|
||||
'Mod 名称分析
|
||||
If Keywords.Count > 0 Then
|
||||
If Keywords.Any Then
|
||||
Dim Names = AnalyzeModName(Keywords)
|
||||
If Names Is Nothing Then
|
||||
AppendReason(CrashReason.堆栈分析发现关键字, Keywords)
|
||||
@@ -437,12 +436,12 @@
|
||||
|
||||
'输出到日志
|
||||
Done:
|
||||
If CrashReasons.Count = 0 Then
|
||||
If Not CrashReasons.Any() Then
|
||||
Log("[Crash] 步骤 3:分析崩溃原因完成,未找到可能的原因")
|
||||
Else
|
||||
Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因")
|
||||
For Each Reason In CrashReasons
|
||||
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Count > 0, "(" & Join(Reason.Value, ";") & ")", ""))
|
||||
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Join(Reason.Value, ";") & ")", ""))
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
@@ -458,7 +457,7 @@ Done:
|
||||
Else
|
||||
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
|
||||
End If
|
||||
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Count > 0, "(" & Join(Additional, ";") & ")", ""))
|
||||
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Join(Additional, ";") & ")", ""))
|
||||
End Sub
|
||||
Private Sub AppendReason(Reason As CrashReason, Additional As String)
|
||||
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
|
||||
@@ -567,7 +566,6 @@ Done:
|
||||
End If
|
||||
End If
|
||||
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
If LogCrash.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
|
||||
End If
|
||||
@@ -584,6 +582,8 @@ Done:
|
||||
'常规信息
|
||||
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(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, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
|
||||
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
|
||||
End If
|
||||
|
||||
End Sub
|
||||
@@ -610,6 +610,9 @@ Done:
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
|
||||
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
Else
|
||||
'在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
|
||||
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
End If
|
||||
'极短的程序输出
|
||||
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
|
||||
@@ -644,14 +647,14 @@ Done:
|
||||
"org.lwjgl", "com.sun", "net.minecraftforge", "paulscode.sound", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
|
||||
"com.electronwill.nightconfig", "it.unimi.dsi",
|
||||
"MojangTricksIntelDriversForPerformance_javaw"}
|
||||
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
|
||||
If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack
|
||||
Next
|
||||
PossibleStacks.Add(Stack.Trim) '.Split("$").First)
|
||||
NextStack:
|
||||
Next
|
||||
PossibleStacks = PossibleStacks.Distinct.ToList
|
||||
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
|
||||
If PossibleStacks.Count = 0 Then Return New List(Of String)
|
||||
If Not PossibleStacks.Any() Then Return New List(Of String)
|
||||
For Each Stack As String In PossibleStacks
|
||||
Log("[Crash] - " & Stack)
|
||||
Next
|
||||
@@ -662,7 +665,7 @@ NextStack:
|
||||
Dim Splited = Stack.Split(".")
|
||||
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
|
||||
Dim Word As String = Splited(i)
|
||||
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
|
||||
If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
|
||||
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top",
|
||||
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi",
|
||||
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
|
||||
@@ -676,7 +679,7 @@ NextStack:
|
||||
Next
|
||||
PossibleWords = PossibleWords.Distinct.ToList
|
||||
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
|
||||
If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", "))
|
||||
If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", "))
|
||||
If PossibleWords.Count > 10 Then
|
||||
Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑")
|
||||
Return New List(Of String)
|
||||
@@ -715,8 +718,8 @@ NextStack:
|
||||
'[Fabric] 获取所有包含 Mod 信息的行
|
||||
Dim ModNameLines As New List(Of String)
|
||||
For Each Line In Details.Split(vbLf)
|
||||
If Line.ToLower.Contains(".jar") OrElse
|
||||
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
|
||||
If Line.ContainsF(".jar", True) OrElse
|
||||
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
|
||||
Next
|
||||
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
|
||||
|
||||
@@ -781,7 +784,7 @@ NextStack:
|
||||
|
||||
'输出
|
||||
ModFileNames = ModFileNames.Distinct.ToList
|
||||
If ModFileNames.Count = 0 Then
|
||||
If Not ModFileNames.Any() Then
|
||||
Return Nothing
|
||||
Else
|
||||
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
|
||||
@@ -845,7 +848,7 @@ NextStack:
|
||||
FileName = "游戏崩溃前的输出.txt"
|
||||
End Select
|
||||
If File.Exists(OutputFile) Then
|
||||
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile)))
|
||||
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
|
||||
End If
|
||||
Next
|
||||
'导出报告
|
||||
@@ -865,7 +868,7 @@ NextStack:
|
||||
Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String
|
||||
|
||||
'没有结果的处理
|
||||
If CrashReasons.Count = 0 Then
|
||||
If Not CrashReasons.Any() Then
|
||||
If IsHandAnalyze Then
|
||||
Return "很抱歉,PCL 无法确定错误原因。"
|
||||
Else
|
||||
@@ -901,7 +904,7 @@ NextStack:
|
||||
Results.Add("你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用所需的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h")
|
||||
End If
|
||||
Case CrashReason.Mod缺少前置或MC版本错误
|
||||
If Additional.Count > 0 Then
|
||||
If Additional.Any Then
|
||||
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Else
|
||||
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
@@ -1033,7 +1036,7 @@ NextStack:
|
||||
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
|
||||
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
|
||||
Trim(vbCrLf.ToCharArray) &
|
||||
If(Not Results.Any(Function(r) r.EndsWith("\h")) OrElse IsHandAnalyze, "",
|
||||
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
|
||||
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
|
||||
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
|
||||
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
|
||||
|
||||
@@ -57,9 +57,9 @@
|
||||
|
||||
#Region "下载支持库文件"
|
||||
Dim LoadersLib As New List(Of LoaderBase) From {
|
||||
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
|
||||
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
|
||||
}
|
||||
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
|
||||
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
|
||||
}
|
||||
'构造加载器
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载支持库文件(主加载器)", LoadersLib) With {.Block = False, .Show = False, .ProgressWeight = 16})
|
||||
#End Region
|
||||
@@ -71,19 +71,19 @@
|
||||
Dim LoadersAssets As New List(Of LoaderBase)
|
||||
'获取资源文件索引地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Try
|
||||
Dim IndexFile = DlClientAssetIndexGet(Version)
|
||||
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
|
||||
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
|
||||
Task.Output = New List(Of NetFile)
|
||||
Else
|
||||
Task.Output = New List(Of NetFile) From {IndexFile}
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Throw New Exception("分析资源文件索引地址失败", ex)
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 0.5, .Show = False})
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Try
|
||||
Dim IndexFile = DlClientAssetIndexGet(Version)
|
||||
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
|
||||
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
|
||||
Task.Output = New List(Of NetFile)
|
||||
Else
|
||||
Task.Output = New List(Of NetFile) From {IndexFile}
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Throw New Exception("分析资源文件索引地址失败", ex)
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = 0.5, .Show = False})
|
||||
'下载资源文件索引
|
||||
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
|
||||
'要求独立更新索引
|
||||
@@ -91,27 +91,29 @@
|
||||
Dim LoadersAssetsUpdate As New List(Of LoaderBase)
|
||||
Dim TempAddress As String = Nothing
|
||||
Dim RealAddress As String = Nothing
|
||||
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
|
||||
RealAddress = BackAssetsFile.LocalPath
|
||||
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
|
||||
BackAssetsFile.LocalPath = TempAddress
|
||||
Task.Output = New List(Of NetFile) From {BackAssetsFile}
|
||||
End Sub))
|
||||
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
|
||||
RealAddress = BackAssetsFile.LocalPath
|
||||
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
|
||||
BackAssetsFile.LocalPath = TempAddress
|
||||
Task.Output = New List(Of NetFile) From {BackAssetsFile}
|
||||
End Sub))
|
||||
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
|
||||
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
|
||||
CopyFile(TempAddress, RealAddress)
|
||||
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
|
||||
End Sub))
|
||||
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
|
||||
Sub(Task As LoaderTask(Of List(Of NetFile), String))
|
||||
CopyFile(TempAddress, RealAddress)
|
||||
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
|
||||
End Sub))
|
||||
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
|
||||
Log("[Download] 开始后台更新资源文件索引")
|
||||
Updater.Start()
|
||||
End If
|
||||
'获取资源文件地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
|
||||
End Sub) With {.ProgressWeight = 3})
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
|
||||
End Sub) With {.ProgressWeight = 3})
|
||||
'下载资源文件
|
||||
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
|
||||
'构造加载器
|
||||
@@ -221,9 +223,7 @@
|
||||
''' </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",
|
||||
BackupUrl:="https://download.mcbbs.net/mc/game/version_manifest.json",
|
||||
IsJson:=True)
|
||||
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True)
|
||||
Try
|
||||
Dim Versions As JArray = Json("versions")
|
||||
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
|
||||
@@ -250,7 +250,7 @@
|
||||
End Select
|
||||
'确认版本格式标准
|
||||
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
|
||||
If Id <> "1.0" AndAlso Id.EndsWith(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
|
||||
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
|
||||
'查找版本并开始
|
||||
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
|
||||
If Version("id") = Id Then
|
||||
@@ -308,7 +308,7 @@
|
||||
Return _inherit
|
||||
End Get
|
||||
Set(value As String)
|
||||
If value.EndsWith(".0") Then value = Left(value, value.Length - 2)
|
||||
If value.EndsWithF(".0") Then value = Left(value, value.Length - 2)
|
||||
_inherit = value
|
||||
End Set
|
||||
End Property
|
||||
@@ -368,9 +368,9 @@
|
||||
Dim Entry As New DlOptiFineListEntry With {
|
||||
.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).ToLower.Contains("pre"),
|
||||
.IsPreview = Name(i).ContainsF("pre", True),
|
||||
.Inherit = Name(i).ToString.Split(" ")(0),
|
||||
.NameFile = If(Name(i).ToLower.Contains("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
|
||||
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
|
||||
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
|
||||
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
|
||||
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
|
||||
@@ -384,15 +384,14 @@
|
||||
''' </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",
|
||||
BackupUrl:="https://download.mcbbs.net/optifine/versionList", IsJson:=True)
|
||||
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True)
|
||||
Try
|
||||
Dim Versions As New List(Of DlOptiFineListEntry)
|
||||
For Each Token As JObject In Json
|
||||
Dim Entry As New DlOptiFineListEntry With {
|
||||
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
|
||||
.ReleaseTime = "",
|
||||
.IsPreview = Token("patch").ToString.ToLower.Contains("pre"),
|
||||
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
|
||||
.Inherit = Token("mcversion").ToString,
|
||||
.NameFile = Token("filename").ToString,
|
||||
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
|
||||
@@ -455,7 +454,7 @@
|
||||
''' </summary>
|
||||
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
|
||||
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
|
||||
Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html")
|
||||
Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html", UseBrowserUserAgent:=True)
|
||||
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
|
||||
'获取所有版本信息
|
||||
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
|
||||
@@ -469,8 +468,7 @@
|
||||
''' </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,
|
||||
BackupUrl:="https://download.mcbbs.net/forge/minecraft")
|
||||
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default)
|
||||
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
|
||||
'获取所有版本信息
|
||||
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
|
||||
@@ -593,7 +591,7 @@
|
||||
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
|
||||
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
|
||||
Catch ex As Exception
|
||||
If GetExceptionSummary(ex).Contains("(404)") Then
|
||||
Throw New Exception("没有可用版本")
|
||||
@@ -605,7 +603,7 @@
|
||||
Dim Versions As New List(Of DlForgeVersionEntry)
|
||||
Try
|
||||
'分割版本信息
|
||||
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOf("</table>")).Split("<td class=""download-version")
|
||||
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
|
||||
'获取所有版本信息
|
||||
For i = 1 To VersionCodes.Count - 1
|
||||
Dim VersionCode = VersionCodes(i)
|
||||
@@ -630,17 +628,17 @@
|
||||
Dim MD5 As String, Category As String
|
||||
If VersionCode.Contains("classifier-installer""") Then
|
||||
'类型为 installer.jar,支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
|
||||
VersionCode = VersionCode.Substring(VersionCode.IndexOf("installer.jar"))
|
||||
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar"))
|
||||
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
|
||||
Category = "installer"
|
||||
ElseIf VersionCode.Contains("classifier-universal""") Then
|
||||
'类型为 universal.zip,支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
|
||||
VersionCode = VersionCode.Substring(VersionCode.IndexOf("universal.zip"))
|
||||
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip"))
|
||||
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
|
||||
Category = "universal"
|
||||
ElseIf VersionCode.Contains("client.zip") Then
|
||||
'类型为 client.zip,支持范围 182~ (1.3.2 部分 ~)
|
||||
VersionCode = VersionCode.Substring(VersionCode.IndexOf("client.zip"))
|
||||
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip"))
|
||||
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
|
||||
Category = "client"
|
||||
Else
|
||||
@@ -656,7 +654,7 @@
|
||||
Catch ex As Exception
|
||||
Throw New Exception("版本列表解析失败(" & Result & ")", ex)
|
||||
End Try
|
||||
If Versions.Count = 0 Then Throw New Exception("没有可用版本")
|
||||
If Not Versions.Any() Then Throw New Exception("没有可用版本")
|
||||
Loader.Output = Versions
|
||||
End Sub
|
||||
|
||||
@@ -664,8 +662,7 @@
|
||||
''' 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,
|
||||
BackupUrl:="https://download.mcbbs.net/forge/minecraft/" & Loader.Input, IsJson:=True)
|
||||
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
|
||||
Dim Versions As New List(Of DlForgeVersionEntry)
|
||||
Try
|
||||
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
|
||||
@@ -713,7 +710,7 @@
|
||||
Catch ex As Exception
|
||||
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
|
||||
End Try
|
||||
If Versions.Count = 0 Then Throw New Exception("没有可用版本")
|
||||
If Not Versions.Any() Then Throw New Exception("没有可用版本")
|
||||
Loader.Output = Versions
|
||||
End Sub
|
||||
|
||||
@@ -804,7 +801,7 @@
|
||||
Dim Json As JObject = Result("versions")
|
||||
Dim Versions As New List(Of DlLiteLoaderListEntry)
|
||||
For Each Pair As KeyValuePair(Of String, JToken) In Json
|
||||
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
|
||||
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
|
||||
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
|
||||
Versions.Add(New DlLiteLoaderListEntry With {
|
||||
.Inherit = Pair.Key,
|
||||
@@ -827,13 +824,12 @@
|
||||
''' </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",
|
||||
BackupUrl:="https://download.mcbbs.net/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
|
||||
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
|
||||
Try
|
||||
Dim Json As JObject = Result("versions")
|
||||
Dim Versions As New List(Of DlLiteLoaderListEntry)
|
||||
For Each Pair As KeyValuePair(Of String, JToken) In Json
|
||||
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
|
||||
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
|
||||
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
|
||||
Versions.Add(New DlLiteLoaderListEntry With {
|
||||
.Inherit = Pair.Key,
|
||||
@@ -914,8 +910,7 @@
|
||||
''' </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",
|
||||
BackupUrl:="https://download.mcbbs.net/fabric-meta/v2/versions", IsJson:=True)
|
||||
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/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("获取到的列表缺乏必要项")
|
||||
@@ -943,26 +938,25 @@
|
||||
|
||||
Public Function DlSourceResourceGet(MojangBase As String) As String()
|
||||
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
|
||||
Return {MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net/assets").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net/assets").Replace("https://resources.download.minecraft.net", "https://download.mcbbs.net/assets"),
|
||||
MojangBase,
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
|
||||
Return {
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
|
||||
MojangBase
|
||||
}
|
||||
End Function
|
||||
|
||||
Public Function DlSourceLibraryGet(MojangBase As String) As String()
|
||||
Return {MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net/maven").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net/maven").Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/maven"),
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net/libraries").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net/libraries").Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/libraries"),
|
||||
MojangBase,
|
||||
Return {
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
|
||||
MojangBase
|
||||
}
|
||||
End Function
|
||||
|
||||
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
|
||||
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
|
||||
Return {MojangBase.Replace("https://piston-data.mojang.com", "https://download.mcbbs.net").Replace("https://piston-meta.mojang.com", "https://download.mcbbs.net").Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
|
||||
MojangBase,
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
|
||||
Return {
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
|
||||
MojangBase
|
||||
}
|
||||
End Function
|
||||
|
||||
|
||||
@@ -62,7 +62,7 @@
|
||||
Public ReadOnly Property HasEnvironment As Boolean
|
||||
Get
|
||||
If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False
|
||||
Return PathEnv.Replace("\", "").Replace("/", "").ToLower.Contains(PathFolder.Replace("\", "").ToLower)
|
||||
Return PathEnv.Replace("\", "").Replace("/", "").ContainsF(PathFolder.Replace("\", ""), True)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
@@ -78,8 +78,8 @@
|
||||
''' </summary>
|
||||
Public Overrides Function ToString() As String
|
||||
Dim VersionString = Version.ToString
|
||||
If VersionString.StartsWith("1.") Then VersionString = Mid(VersionString, 3)
|
||||
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")," & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
|
||||
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
|
||||
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
|
||||
End Function
|
||||
|
||||
'构造
|
||||
@@ -87,7 +87,7 @@
|
||||
''' 输入 javaw.exe 文件所在文件夹的路径,不限制结尾。
|
||||
''' </summary>
|
||||
Public Sub New(Folder As String, IsUserImport As Boolean)
|
||||
If Not Folder.EndsWith("\") Then Folder += "\"
|
||||
If Not Folder.EndsWithF("\") Then Folder += "\"
|
||||
PathFolder = Folder.Replace("/", "\")
|
||||
Me.IsUserImport = IsUserImport
|
||||
End Sub
|
||||
@@ -116,8 +116,9 @@
|
||||
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
|
||||
'获取详细信息
|
||||
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
|
||||
If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493,VersionString = "21.0.2.0.2"
|
||||
Do While VersionString.Split(".").Count < 4
|
||||
If VersionString.StartsWith("1.") Then
|
||||
If VersionString.StartsWithF("1.") Then
|
||||
VersionString = VersionString & ".0"
|
||||
Else
|
||||
VersionString = "1." & VersionString
|
||||
@@ -184,7 +185,7 @@
|
||||
JavaList.Add(JavaEntry.FromJson(JsonEntry))
|
||||
Next
|
||||
End If
|
||||
If JavaList.Count = 0 Then
|
||||
If Not JavaList.Any() Then
|
||||
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
|
||||
JavaSearchLoader.Start(0)
|
||||
Else
|
||||
@@ -219,7 +220,7 @@
|
||||
Next
|
||||
|
||||
'检查特定的 Java
|
||||
If TargetJavaList.Count > 0 Then
|
||||
If TargetJavaList.Any Then
|
||||
TargetJavaList = JavaCheckList(TargetJavaList)
|
||||
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java:")
|
||||
For Each Java In TargetJavaList
|
||||
@@ -232,7 +233,7 @@
|
||||
Dim UserJava As JavaEntry = Nothing
|
||||
|
||||
'获取版本独立设置中指定的 Java
|
||||
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWith("{") Then
|
||||
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWithF("{") Then
|
||||
Try
|
||||
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
|
||||
UserJava.Check()
|
||||
@@ -291,7 +292,7 @@ RetryGet:
|
||||
Next
|
||||
|
||||
'若未找到适合的 Java,尝试触发搜索
|
||||
If AllowedJavaList.Count = 0 AndAlso JavaSearchLoader.State = LoadState.Waiting Then
|
||||
If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
|
||||
Log("[Java] 未找到满足条件的 Java,尝试进行搜索")
|
||||
JavaSearchLoader.Start(IsForceRestart:=True)
|
||||
GoTo RetryGet
|
||||
@@ -352,7 +353,7 @@ ExitUserJavaCheck:
|
||||
#End Region
|
||||
|
||||
'若依然未找到适合的 Java,直接返回
|
||||
If AllowedJavaList.Count = 0 Then Return Nothing
|
||||
If Not AllowedJavaList.Any() Then Return Nothing
|
||||
|
||||
'优先使用特定目录下的 Java
|
||||
For Each Java In AllowedJavaList
|
||||
@@ -445,11 +446,11 @@ NoUserJava:
|
||||
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
|
||||
ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName
|
||||
If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName
|
||||
If Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWith(ProgramPathParent) Then Return True
|
||||
If Not Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Right.PathFolder.StartsWith(ProgramPathParent) Then Return False
|
||||
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
|
||||
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
|
||||
If PathMcFolder <> "" Then
|
||||
If Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWith(MinecraftPathParent) Then Return True
|
||||
If Not Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Right.PathFolder.StartsWith(MinecraftPathParent) Then Return False
|
||||
If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
|
||||
If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
|
||||
End If
|
||||
'2. 尽量使用 64 位
|
||||
If Left.Is64Bit AndAlso Not Right.Is64Bit Then Return True
|
||||
@@ -459,7 +460,7 @@ NoUserJava:
|
||||
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 20...
|
||||
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21...
|
||||
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 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
|
||||
@@ -500,7 +501,7 @@ NoUserJava:
|
||||
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
|
||||
PathInEnv = PathInEnv.Trim(" """.ToCharArray())
|
||||
If PathInEnv = "" Then Continue For
|
||||
If Not PathInEnv.EndsWith("\") Then PathInEnv += "\"
|
||||
If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\"
|
||||
'粗略检查有效性
|
||||
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
|
||||
Next
|
||||
@@ -533,7 +534,7 @@ NoUserJava:
|
||||
Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接")
|
||||
JavaWithoutReparse.Add(Pair.Key, Pair.Value)
|
||||
Next
|
||||
If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse
|
||||
If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
|
||||
|
||||
'若不全为特殊引用,则清除特殊引用的地址
|
||||
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
|
||||
@@ -545,7 +546,7 @@ NoUserJava:
|
||||
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
|
||||
End If
|
||||
Next
|
||||
If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit
|
||||
If JavaWithoutInherit.Any Then JavaPreList = JavaWithoutInherit
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -652,7 +653,7 @@ Wait:
|
||||
'确认目录存在
|
||||
If Not OriginalPath.Exists Then Exit Sub
|
||||
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
|
||||
If Not Path.EndsWith("\") Then Path += "\"
|
||||
If Not Path.EndsWithF("\") Then Path += "\"
|
||||
'若该目录有 Java,则加入结果
|
||||
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
|
||||
'查找其下的所有文件夹
|
||||
@@ -715,7 +716,7 @@ Wait:
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 获取下载 Java 8/14/17 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
|
||||
''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
|
||||
''' </summary>
|
||||
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
|
||||
Return New LoaderCombo(Of Integer)($"下载 Java {Version}", {
|
||||
@@ -727,21 +728,19 @@ Wait:
|
||||
Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
|
||||
Log("[Java] 开始获取 Java 下载信息")
|
||||
Dim IndexFileStr As String = NetGetCodeByDownload(
|
||||
{"https://download.mcbbs.net/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
|
||||
"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
|
||||
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
|
||||
"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
|
||||
IsJson:=True)
|
||||
'获取下载地址
|
||||
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
|
||||
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新)
|
||||
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v)))
|
||||
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWith(Loader.Input))
|
||||
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input))
|
||||
Dim Address As String = TargetEntry.Value("manifest")("url")
|
||||
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
|
||||
'获取文件列表
|
||||
Dim ListFileStr As String = NetGetCodeByDownload(
|
||||
{Address.Replace("piston-meta.mojang.com", "download.mcbbs.net"),
|
||||
Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"),
|
||||
{Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"),
|
||||
Address},
|
||||
IsJson:=True)
|
||||
Dim BaseDir As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
|
||||
@@ -753,8 +752,7 @@ Wait:
|
||||
If Checker.Check(BaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
|
||||
Dim Url As String = Info("url")
|
||||
Results.Add(New NetFile(
|
||||
{Url.Replace("piston-data.mojang.com", "download.mcbbs.net"),
|
||||
Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"),
|
||||
{Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"),
|
||||
Url},
|
||||
BaseDir & File.Name, Checker))
|
||||
Next
|
||||
|
||||
@@ -62,7 +62,7 @@ Public Module ModLaunch
|
||||
''' 记录启动日志。
|
||||
''' </summary>
|
||||
Public Sub McLaunchLog(Text As String)
|
||||
Text = SecretFilter(Text)
|
||||
Text = SecretFilter(Text, "*")
|
||||
RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
|
||||
Log("[Launch] " & Text)
|
||||
End Sub
|
||||
@@ -101,10 +101,10 @@ Public Module ModLaunch
|
||||
'正式加载
|
||||
Try
|
||||
'构造主加载器
|
||||
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", {
|
||||
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False, .Show = False},
|
||||
Dim Loaders As New List(Of LoaderBase) From {
|
||||
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
|
||||
McLoginLoader,
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True},
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False},
|
||||
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
|
||||
@@ -112,7 +112,12 @@ Public Module ModLaunch
|
||||
New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
|
||||
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
|
||||
}) With {.Show = False}
|
||||
}
|
||||
If Setup.Get("LaunchArgumentRam") Then
|
||||
CType(Loaders(2), LoaderCombo(Of String)).Block = False
|
||||
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
|
||||
End If
|
||||
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
|
||||
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
|
||||
'等待加载器执行并更新 UI
|
||||
McLaunchLoaderReal = LaunchLoader
|
||||
@@ -143,7 +148,7 @@ Public Module ModLaunch
|
||||
Catch ex As Exception
|
||||
Dim CurrentEx = ex
|
||||
NextInner:
|
||||
If CurrentEx.Message.StartsWith("$") Then
|
||||
If CurrentEx.Message.StartsWithF("$") Then
|
||||
'若有以 $ 开头的错误信息,则以此为准显示提示
|
||||
'若错误信息为 $$,则不提示
|
||||
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
@@ -163,6 +168,28 @@ NextInner:
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "内存优化"
|
||||
|
||||
Private Sub McLaunchMemoryOptimize(Loader As LoaderTask(Of Integer, Integer))
|
||||
McLaunchLog("内存优化开始")
|
||||
Dim Finished As Boolean = False
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
PageOtherTest.MemoryOptimize(False)
|
||||
Finished = True
|
||||
End Sub, "Launch Memory Optimize")
|
||||
Do While Not Finished AndAlso Not Loader.IsAborted
|
||||
If Loader.Progress < 0.7 Then
|
||||
Loader.Progress += 0.007 '10s
|
||||
Else
|
||||
Loader.Progress += (0.95 - Loader.Progress) * 0.02 '最快 += 0.005
|
||||
End If
|
||||
Thread.Sleep(100)
|
||||
Loop
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "预检测"
|
||||
|
||||
Private Sub McLaunchPrecheck()
|
||||
@@ -247,7 +274,7 @@ NextInner:
|
||||
''' </summary>
|
||||
Public BaseUrl As String
|
||||
''' <summary>
|
||||
''' 登录所使用的标识符,如 “Mojang”、“Nide”,用于存储缓存等。
|
||||
''' 登录所使用的标识符,目前只可能为 “Auth” 或 “Nide”,用于存储缓存等。
|
||||
''' </summary>
|
||||
Public Token As String
|
||||
''' <summary>
|
||||
@@ -526,7 +553,13 @@ SkipLogin:
|
||||
McLaunchLog("登录方式:" & Input.Description & "(" & LogUsername & ")")
|
||||
Data.Progress = 0.05
|
||||
'尝试登录
|
||||
If (Not Data.Input.ForceReselectProfile) AndAlso Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso Not Setup.Get("Cache" & Input.Token & "Access") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Client") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Uuid") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Name") = "" Then
|
||||
If (Not Data.Input.ForceReselectProfile) AndAlso
|
||||
Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso
|
||||
Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso
|
||||
Setup.Get("Cache" & Input.Token & "Access") <> "" AndAlso
|
||||
Setup.Get("Cache" & Input.Token & "Client") <> "" AndAlso
|
||||
Setup.Get("Cache" & Input.Token & "Uuid") <> "" AndAlso
|
||||
Setup.Get("Cache" & Input.Token & "Name") <> "" Then
|
||||
'尝试验证登录
|
||||
Try
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
@@ -752,7 +785,7 @@ LoginFinish:
|
||||
End Select
|
||||
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
|
||||
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
|
||||
ElseIf ex.Message.StartsWith("$") Then
|
||||
ElseIf ex.Message.StartsWithF("$") Then
|
||||
Throw
|
||||
Else
|
||||
Throw New Exception("登录失败:" & ex.Message, ex)
|
||||
@@ -990,14 +1023,14 @@ SystemBrowser:
|
||||
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")
|
||||
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
|
||||
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
|
||||
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")
|
||||
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
|
||||
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
|
||||
Loop
|
||||
Case 3
|
||||
'使用正版用户名
|
||||
@@ -1013,7 +1046,7 @@ SystemBrowser:
|
||||
Case 4
|
||||
'自定义
|
||||
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
|
||||
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
|
||||
If Uuid.EndsWithF("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
|
||||
@@ -1057,7 +1090,12 @@ SystemBrowser:
|
||||
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
|
||||
|
||||
'MC 大版本检测
|
||||
If (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
|
||||
If (McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
|
||||
(McVersionCurrent.Version.McCodeMain > 20 AndAlso McVersionCurrent.Version.McCodeMain <> 99) OrElse
|
||||
(McVersionCurrent.Version.McCodeMain = 20 AndAlso McVersionCurrent.Version.McCodeSub >= 5) Then
|
||||
'1.20.5+(24w14a+):至少 Java 21
|
||||
MinVer = New Version(1, 21, 0, 0)
|
||||
ElseIf (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
|
||||
(McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
|
||||
'1.18 pre2+:至少 Java 17
|
||||
MinVer = New Version(1, 17, 0, 0)
|
||||
@@ -1091,22 +1129,25 @@ SystemBrowser:
|
||||
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)
|
||||
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
|
||||
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
|
||||
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
|
||||
'<=1.12:Java 8
|
||||
MaxVer = New Version(1, 8, 999, 999)
|
||||
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain >= 13 Then
|
||||
'1.13 - 1.14:Java 8 - 10
|
||||
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
|
||||
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
|
||||
MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
|
||||
ElseIf McVersionCurrent.Version.McCodeMain = 15 Then
|
||||
'1.15:Java 8 - 15
|
||||
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
|
||||
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
|
||||
MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer)
|
||||
ElseIf VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then
|
||||
'1.16,Forge 34.X ~ 36.2.25:最高 Java 8u320
|
||||
MaxVer = New Version(1, 8, 0, 320)
|
||||
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
|
||||
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 19 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
|
||||
'1.18:若安装了 OptiFine,最高 Java 18
|
||||
MaxVer = New Version(1, 18, 999, 999)
|
||||
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -1114,10 +1155,10 @@ SystemBrowser:
|
||||
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+
|
||||
MinVer = New Version(1, 8, 0, 0)
|
||||
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
|
||||
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
|
||||
'1.18+:Java 17+
|
||||
MinVer = New Version(1, 17, 0, 0)
|
||||
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -1140,7 +1181,10 @@ SystemBrowser:
|
||||
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
|
||||
McLaunchLog("无合适的 Java,需要确认是否自动下载")
|
||||
Dim JavaCode As String
|
||||
If MinVer >= New Version(1, 9, 0, 0) Then
|
||||
If MinVer >= New Version(1, 21, 0, 0) Then
|
||||
JavaCode = 21
|
||||
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
|
||||
ElseIf MinVer >= New Version(1, 9, 0, 0) Then
|
||||
JavaCode = 17
|
||||
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
|
||||
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
|
||||
@@ -1194,17 +1238,20 @@ SystemBrowser:
|
||||
''' </summary>
|
||||
Public Function ExtractJavaWrapper() As String
|
||||
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
|
||||
WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
|
||||
WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
End SyncLock
|
||||
Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
|
||||
Return WrapperPath
|
||||
End Function
|
||||
Private ExtractJavaWrapperLock As New Object
|
||||
''' <summary>
|
||||
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
|
||||
''' </summary>
|
||||
Public Function GetJavaWrapperDir() As String
|
||||
If Encoding.UTF8.GetByteCount(PathAppdata) = PathAppdata.Length Then
|
||||
If PathAppdata.IsASCII() Then
|
||||
Return PathAppdata.TrimEnd("\")
|
||||
ElseIf Encoding.UTF8.GetByteCount(PathTemp) = PathTemp.Length Then
|
||||
ElseIf PathTemp.IsASCII() Then
|
||||
Log("[Java] Wrapper:AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
|
||||
Return PathTemp.TrimEnd("\")
|
||||
Else
|
||||
@@ -1268,9 +1315,7 @@ SystemBrowser:
|
||||
'不包含端口号
|
||||
Arguments += " --server " & Server & " --port 25565"
|
||||
End If
|
||||
If McVersionCurrent.Version.HasOptiFine Then 'OptiFine 警告
|
||||
Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Critical)
|
||||
End If
|
||||
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Critical)
|
||||
End If
|
||||
End If
|
||||
'自定义
|
||||
@@ -1292,10 +1337,11 @@ SystemBrowser:
|
||||
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
|
||||
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
|
||||
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
|
||||
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
|
||||
DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
|
||||
DataList.Add("-Xmn256m")
|
||||
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.5) & "m")
|
||||
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
|
||||
DataList.Add("""-Djava.library.path=" & Version.Path & Version.Name & "-natives""")
|
||||
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
|
||||
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
|
||||
|
||||
'统一通行证
|
||||
@@ -1394,9 +1440,9 @@ NextVersion:
|
||||
Dim DeDuplicateDataList As New List(Of String)
|
||||
For i = 0 To DataList.Count - 1
|
||||
Dim CurrentEntry As String = DataList(i)
|
||||
If DataList(i).StartsWith("-") Then
|
||||
If DataList(i).StartsWithF("-") Then
|
||||
Do While i < DataList.Count - 1
|
||||
If DataList(i + 1).StartsWith("-") Then
|
||||
If DataList(i + 1).StartsWithF("-") Then
|
||||
Exit Do
|
||||
Else
|
||||
i += 1
|
||||
@@ -1407,6 +1453,9 @@ NextVersion:
|
||||
DeDuplicateDataList.Add(CurrentEntry.Trim.Replace("McEmu= ", "McEmu="))
|
||||
Next
|
||||
|
||||
'#3511 的清理
|
||||
DeDuplicateDataList.Remove("-XX:MaxDirectMemorySize=256M")
|
||||
|
||||
'去重
|
||||
Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ")
|
||||
|
||||
@@ -1487,9 +1536,9 @@ NextVersion:
|
||||
Dim DeDuplicateDataList As New List(Of String)
|
||||
For i = 0 To DataList.Count - 1
|
||||
Dim CurrentEntry As String = DataList(i)
|
||||
If DataList(i).StartsWith("-") Then
|
||||
If DataList(i).StartsWithF("-") Then
|
||||
Do While i < DataList.Count - 1
|
||||
If DataList(i + 1).StartsWith("-") Then
|
||||
If DataList(i + 1).StartsWithF("-") Then
|
||||
Exit Do
|
||||
Else
|
||||
i += 1
|
||||
@@ -1527,7 +1576,7 @@ NextVersion:
|
||||
|
||||
'基础参数
|
||||
GameArguments.Add("${classpath_separator}", ";")
|
||||
GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives")
|
||||
GameArguments.Add("${natives_directory}", GetNativesFolder())
|
||||
GameArguments.Add("${library_directory}", PathMcFolder & "libraries")
|
||||
GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries")
|
||||
GameArguments.Add("${launcher_name}", "PCL")
|
||||
@@ -1544,9 +1593,26 @@ NextVersion:
|
||||
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
|
||||
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
|
||||
GameArguments.Add("${user_type}", "msa") '#1221
|
||||
Dim GameSize As Size = Setup.GetLaunchArgumentWindowSize()
|
||||
GameArguments.Add("${resolution_width}", GameSize.Width)
|
||||
GameArguments.Add("${resolution_height}", GameSize.Height)
|
||||
|
||||
'窗口尺寸参数
|
||||
Dim GameSize As Size
|
||||
Select Case Setup.Get("LaunchArgumentWindowType")
|
||||
Case 2
|
||||
Dim Result As Size
|
||||
RunInUiWait(Sub() Result = New Size(GetPixelSize(FrmMain.PanForm.ActualWidth), GetPixelSize(FrmMain.PanForm.ActualHeight)))
|
||||
GameSize = Result
|
||||
Case 3
|
||||
GameSize = New Size(Math.Max(100, Setup.Get("LaunchArgumentWindowWidth") - 2), Math.Max(100, Setup.Get("LaunchArgumentWindowHeight") - 2))
|
||||
Case Else
|
||||
GameSize = New Size(875 - 2, 540 - 2)
|
||||
End Select
|
||||
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
|
||||
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍
|
||||
GameSize.Width /= DPI / 96
|
||||
GameSize.Height /= DPI / 96
|
||||
End If
|
||||
GameArguments.Add("${resolution_width}", Math.Round(GameSize.Width))
|
||||
GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))
|
||||
|
||||
'Assets 相关参数
|
||||
GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
|
||||
@@ -1578,7 +1644,8 @@ NextVersion:
|
||||
Private Sub McLaunchNatives(Loader As LoaderTask(Of List(Of McLibToken), Integer))
|
||||
|
||||
'创建文件夹
|
||||
Directory.CreateDirectory(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
|
||||
Dim Target As String = GetNativesFolder() & "\"
|
||||
Directory.CreateDirectory(Target)
|
||||
|
||||
'解压文件
|
||||
McLaunchLog("正在解压 Natives 文件")
|
||||
@@ -1595,9 +1662,9 @@ NextVersion:
|
||||
End Try
|
||||
For Each Entry In Zip.Entries
|
||||
Dim FileName As String = Entry.FullName
|
||||
If FileName.EndsWith(".dll") Then
|
||||
If FileName.EndsWithF(".dll", True) Then
|
||||
'实际解压文件的步骤
|
||||
Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName
|
||||
Dim FilePath As String = Target & FileName
|
||||
ExistFiles.Add(FilePath)
|
||||
Dim OriginalFile As New FileInfo(FilePath)
|
||||
If OriginalFile.Exists Then
|
||||
@@ -1623,7 +1690,7 @@ NextVersion:
|
||||
Next
|
||||
|
||||
'删除多余文件
|
||||
For Each FileName As String In Directory.GetFiles(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
|
||||
For Each FileName As String In Directory.GetFiles(Target)
|
||||
If ExistFiles.Contains(FileName) Then Continue For
|
||||
Try
|
||||
McLaunchLog("删除:" & FileName)
|
||||
@@ -1636,6 +1703,16 @@ NextVersion:
|
||||
Next
|
||||
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 获取 Natives 文件夹路径,不以 \ 结尾。
|
||||
''' </summary>
|
||||
Private Function GetNativesFolder() As String
|
||||
Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives"
|
||||
If IsGBKEncoding OrElse Result.IsASCII() Then Return Result
|
||||
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
|
||||
If Result.IsASCII() Then Return Result
|
||||
Return OsDrive & "ProgramData\PCL\natives"
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -1750,7 +1827,7 @@ NextVersion:
|
||||
Select Case Setup.Get("LaunchArgumentWindowType")
|
||||
Case 0 '全屏
|
||||
WriteIni(SetupFileAddress, "fullscreen", "true")
|
||||
Case 5 '保持默认
|
||||
Case 1 '默认
|
||||
Case Else '其他
|
||||
WriteIni(SetupFileAddress, "fullscreen", "false")
|
||||
End Select
|
||||
@@ -1911,9 +1988,9 @@ IgnoreCustomSkin:
|
||||
|
||||
'获取自定义命令
|
||||
Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
|
||||
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
|
||||
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal, True)
|
||||
Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
|
||||
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
|
||||
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion, True)
|
||||
|
||||
'输出 bat
|
||||
Try
|
||||
@@ -1928,7 +2005,7 @@ IgnoreCustomSkin:
|
||||
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
|
||||
"echo 游戏已退出。" & vbCrLf &
|
||||
"pause"
|
||||
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString),
|
||||
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
|
||||
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
|
||||
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
|
||||
McLaunchLog("导出启动脚本完成,强制结束启动过程")
|
||||
@@ -2050,7 +2127,7 @@ IgnoreCustomSkin:
|
||||
McLaunchLog("")
|
||||
McLaunchLog("~ 基础参数 ~")
|
||||
McLaunchLog("PCL 版本:" & VersionDisplayName & " (" & VersionCode & ")")
|
||||
McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")")
|
||||
McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(识别为 1." & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")")
|
||||
McLaunchLog("资源版本:" & McAssetsGetIndexName(McVersionCurrent))
|
||||
McLaunchLog("版本继承:" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion))
|
||||
McLaunchLog("分配的内存:" & PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) & " GB(" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB)")
|
||||
@@ -2060,6 +2137,7 @@ IgnoreCustomSkin:
|
||||
McLaunchLog("HMCL 格式:" & McVersionCurrent.IsHmclFormatJson)
|
||||
McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
|
||||
McLaunchLog("环境变量:" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
|
||||
McLaunchLog("Natives 文件夹:" & GetNativesFolder())
|
||||
McLaunchLog("")
|
||||
McLaunchLog("~ 登录参数 ~")
|
||||
McLaunchLog("玩家用户名:" & McLoginLoader.Output.Name)
|
||||
@@ -2072,7 +2150,7 @@ IgnoreCustomSkin:
|
||||
'获取窗口标题
|
||||
Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent)
|
||||
If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle")
|
||||
WindowTitle = ArgumentReplace(WindowTitle)
|
||||
WindowTitle = ArgumentReplace(WindowTitle, False)
|
||||
|
||||
'初始化等待
|
||||
Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle)
|
||||
@@ -2124,7 +2202,7 @@ IgnoreCustomSkin:
|
||||
''' <summary>
|
||||
''' 在启动结束时,对 PCL 约定的替换标记进行处理。
|
||||
''' </summary>
|
||||
Private Function ArgumentReplace(Raw As String) As String
|
||||
Private Function ArgumentReplace(Raw As String, ReplaceTimeAndDate As Boolean) As String
|
||||
If Raw Is Nothing Then Return Nothing
|
||||
'路径替换
|
||||
Raw = Raw.Replace("{minecraft}", PathMcFolder)
|
||||
@@ -2134,6 +2212,10 @@ IgnoreCustomSkin:
|
||||
'普通替换
|
||||
Raw = Raw.Replace("{user}", McLoginLoader.Output.Name)
|
||||
Raw = Raw.Replace("{uuid}", McLoginLoader.Output.Uuid)
|
||||
If ReplaceTimeAndDate Then '设置窗口标题时需要动态替换日期和时间
|
||||
Raw = Raw.Replace("{date}", Date.Now.ToString("yyyy/M/d"))
|
||||
Raw = Raw.Replace("{time}", Date.Now.ToString("HH:mm:ss"))
|
||||
End If
|
||||
Select Case McLoginLoader.Input.Type
|
||||
Case McLoginType.Legacy
|
||||
If PageLinkHiper.HiperState = LoadState.Finished Then
|
||||
|
||||
@@ -42,15 +42,19 @@
|
||||
#Region "读取默认(Original)文件夹,即当前、官启文件夹,可能没有结果"
|
||||
|
||||
'扫描当前文件夹
|
||||
If CheckPermission(Path) AndAlso Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path, .Type = McFolderType.Original})
|
||||
For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories
|
||||
If CheckPermission(Folder.FullName) AndAlso Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Folder.FullName & "\", .Type = McFolderType.Original})
|
||||
Next
|
||||
Try
|
||||
If Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path, .Type = McFolderType.Original})
|
||||
For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories
|
||||
If Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Folder.FullName & "\", .Type = McFolderType.Original})
|
||||
Next
|
||||
Catch ex As Exception
|
||||
Log(ex, "扫描 PCL 所在文件夹中是否有 MC 文件夹失败")
|
||||
End Try
|
||||
|
||||
'扫描官启文件夹
|
||||
Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\"
|
||||
If (CacheMcFolderList.Count = 0 OrElse MojangPath <> CacheMcFolderList(0).Path) AndAlso '当前文件夹不是官启文件夹
|
||||
CheckPermission(MojangPath) AndAlso Directory.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
|
||||
If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Path) AndAlso '当前文件夹不是官启文件夹
|
||||
Directory.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
|
||||
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Path = MojangPath, .Type = McFolderType.Original})
|
||||
End If
|
||||
|
||||
@@ -61,7 +65,7 @@
|
||||
'格式:TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径
|
||||
For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
|
||||
If Folder = "" Then Continue For
|
||||
If Not Folder.Contains(">") OrElse Not Folder.EndsWith("\") Then
|
||||
If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
|
||||
Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Critical)
|
||||
Continue For
|
||||
End If
|
||||
@@ -88,13 +92,13 @@
|
||||
For Each Folder As McFolder In CacheMcFolderList
|
||||
If Not Folder.Type = McFolderType.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Path)
|
||||
Next
|
||||
If NewSetup.Count = 0 Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
|
||||
If Not NewSetup.Any() Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
|
||||
Setup.Set("LaunchFolders", Join(NewSetup, "|"))
|
||||
|
||||
#End Region
|
||||
|
||||
'若没有可用文件夹,则创建 .minecraft
|
||||
If CacheMcFolderList.Count = 0 Then
|
||||
If Not CacheMcFolderList.Any() Then
|
||||
Directory.CreateDirectory(Path & ".minecraft\versions\")
|
||||
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path & ".minecraft\", .Type = McFolderType.Original})
|
||||
End If
|
||||
@@ -145,7 +149,7 @@
|
||||
|
||||
#Region "版本处理"
|
||||
|
||||
Public Const McVersionCacheVersion As Integer = 26
|
||||
Public Const McVersionCacheVersion As Integer = 27
|
||||
|
||||
Private _McVersionCurrent As McVersion
|
||||
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
|
||||
@@ -177,7 +181,7 @@
|
||||
If AniControlEnabled = 0 AndAlso
|
||||
Setup.Get("VersionServerAuthServer", Version:=value) <> Setup.Get("CacheAuthServerServer") AndAlso
|
||||
Setup.Get("VersionServerLogin", Version:=value) = 4 Then
|
||||
Setup.Set("CacheNideServer", "")
|
||||
Setup.Set("CacheAuthAccess", "")
|
||||
Log("[Launch] 服务器改变,要求重新登录 Authlib-Injector")
|
||||
End If
|
||||
If Setup.Get("VersionServerLogin", Version:=value) = 4 Then
|
||||
@@ -212,8 +216,8 @@
|
||||
'尚未判断
|
||||
Dim ModFolder As New DirectoryInfo(Path & "mods\")
|
||||
Dim SaveFolder As New DirectoryInfo(Path & "saves\")
|
||||
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse
|
||||
(SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then
|
||||
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse
|
||||
(SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
|
||||
'自动开启
|
||||
Setup.Set("VersionArgumentIndie", 1, Version:=Me)
|
||||
Log("[Setup] 已自动开启单版本隔离:" & Name)
|
||||
@@ -406,7 +410,7 @@
|
||||
End If
|
||||
'无法获取
|
||||
_Version.McName = "Unknown"
|
||||
Info = "PCL 无法识别该版本,请向作者反馈此问题"
|
||||
Info = "PCL 无法识别该版本的 MC 版本号"
|
||||
Catch ex As Exception
|
||||
Log(ex, "识别 Minecraft 版本时出错")
|
||||
_Version.McName = "Unknown"
|
||||
@@ -414,7 +418,7 @@
|
||||
End Try
|
||||
VersionSearchFinish:
|
||||
'获取版本号
|
||||
If _Version.McName.StartsWith("1.") Then
|
||||
If _Version.McName.StartsWithF("1.") Then
|
||||
Dim SplitVersion = _Version.McName.Split(" "c, "_"c, "-"c, "."c)
|
||||
Dim SplitResult As String
|
||||
'分割获取信息
|
||||
@@ -542,8 +546,8 @@ Recheck:
|
||||
'处理 JumpLoader
|
||||
If Text.Contains("minecraftforge") AndAlso File.Exists(PathIndie & "config\jumploader.json") Then
|
||||
For Each ModFile In Directory.EnumerateFiles(PathIndie & "mods")
|
||||
Dim FileName As String = GetFileNameFromPath(ModFile).ToLower
|
||||
If FileName.EndsWith(".jar") AndAlso FileName.Contains("jumploader") Then
|
||||
Dim FileName As String = GetFileNameFromPath(ModFile)
|
||||
If FileName.EndsWithF(".jar", True) AndAlso FileName.ContainsF("jumploader", True) Then
|
||||
Log("[Minecraft] 发现 JumpLoader 分支项:" & FileName)
|
||||
HasJumpLoader = True
|
||||
Exit For
|
||||
@@ -608,7 +612,7 @@ Recheck:
|
||||
Public Sub New(Path As String)
|
||||
Me.Path = If(Path.Contains(":"), "", PathMcFolder & "versions\") & '补全完整路径
|
||||
Path &
|
||||
If(Path.EndsWith("\"), "", "\") '补全右划线
|
||||
If(Path.EndsWithF("\"), "", "\") '补全右划线
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
@@ -680,7 +684,7 @@ Recheck:
|
||||
'愚人节与快照版本
|
||||
If If(JsonObject("type"), "").ToString = "fool" OrElse GetMcFoolName(Version.McName) <> "" Then
|
||||
State = McVersionState.Fool
|
||||
ElseIf Version.McName.ToLower.Contains("w") OrElse Name.ToLower.Contains("combat") OrElse Version.McName.ToLower.Contains("rc") OrElse Version.McName.ToLower.Contains("pre") OrElse Version.McName.Contains("experimental") OrElse If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending" Then
|
||||
ElseIf Version.McName.ContainsF("w", True) OrElse Name.ContainsF("combat", True) OrElse Version.McName.ContainsF("rc", True) OrElse Version.McName.ContainsF("pre", True) OrElse Version.McName.ContainsF("experimental", True) OrElse If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending" Then
|
||||
State = McVersionState.Snapshot
|
||||
End If
|
||||
'OptiFine
|
||||
@@ -740,9 +744,9 @@ ExitDataLoad:
|
||||
If CustomInfo = "" Then
|
||||
Select Case State
|
||||
Case McVersionState.Snapshot
|
||||
If Version.McName.ToLower.Contains("pre") Then
|
||||
If Version.McName.ContainsF("pre", True) Then
|
||||
Info = "预发布版 " & Version.McName
|
||||
ElseIf Version.McName.ToLower.Contains("rc") Then
|
||||
ElseIf Version.McName.ContainsF("rc", True) Then
|
||||
Info = "发布候选 " & Version.McName
|
||||
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
|
||||
Info = "实验性快照"
|
||||
@@ -944,8 +948,8 @@ ExitDataLoad:
|
||||
(Asc(CType(Left(OptiFineVersion.ToUpper, 1), Char)) - Asc("A"c) + 1) * 10000 + '第二段:字母编号(2 位),如 G2 中的 G(7)
|
||||
Val(RegexSeek(Right(OptiFineVersion, OptiFineVersion.Length - 1), "[0-9]+")) * 100 '第三段:末尾数字(2 位),如 C5 beta4 中的 5
|
||||
'第三段:测试标记
|
||||
If OptiFineVersion.ToLower.Contains("pre") Then _SortCode += 50
|
||||
If OptiFineVersion.ToLower.Contains("pre") OrElse OptiFineVersion.ToLower.Contains("beta") Then
|
||||
If OptiFineVersion.ContainsF("pre", True) Then _SortCode += 50
|
||||
If OptiFineVersion.ContainsF("pre", True) OrElse OptiFineVersion.ContainsF("beta", True) Then
|
||||
If Val(Right(OptiFineVersion, 1)) = 0 AndAlso Right(OptiFineVersion, 1) <> "0" Then
|
||||
_SortCode += 1 '为 pre 或 beta 结尾,视作 1
|
||||
Else
|
||||
@@ -977,9 +981,9 @@ ExitDataLoad:
|
||||
''' </summary>
|
||||
Public Function GetMcFoolName(Name As String) As String
|
||||
Name = Name.ToLower
|
||||
If Name.StartsWith("2.0") Then
|
||||
If Name.StartsWithF("2.0") Then
|
||||
Return "这个秘密计划了两年的更新将游戏推向了一个新高度!"
|
||||
ElseIf Name.StartsWith("20w14inf") OrElse Name = "20w14∞" Then
|
||||
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
|
||||
Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
|
||||
ElseIf Name = "15w14a" Then
|
||||
Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
|
||||
@@ -990,7 +994,9 @@ ExitDataLoad:
|
||||
ElseIf Name = "22w13oneblockatatime" Then
|
||||
Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
|
||||
ElseIf Name = "23w13a_or_b" Then
|
||||
Return "研究表明玩家喜欢作出选择——越多越好!"
|
||||
Return "研究表明:玩家喜欢作出选择——越多越好!"
|
||||
ElseIf Name = "24w14potato" Then
|
||||
Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
|
||||
Else
|
||||
Return ""
|
||||
End If
|
||||
@@ -1014,6 +1020,12 @@ ExitDataLoad:
|
||||
''' </summary>
|
||||
Public McVersionListLoader As New LoaderTask(Of String, Integer)("Minecraft Version List", AddressOf McVersionListLoad) With {.ReloadTimeout = 1}
|
||||
|
||||
''' <summary>
|
||||
''' 是否为本次打开 PCL 后第一次加载版本列表。
|
||||
''' 这会清理所有 .pclignore 文件,而非跳过这些对应版本。
|
||||
''' </summary>
|
||||
Private IsFirstMcVersionListLoad As Boolean = True
|
||||
|
||||
''' <summary>
|
||||
''' 开始加载当前 Minecraft 文件夹的版本列表。
|
||||
''' </summary>
|
||||
@@ -1036,7 +1048,7 @@ ExitDataLoad:
|
||||
End Try
|
||||
End If
|
||||
'没有可用版本
|
||||
If FolderList.Count = 0 Then
|
||||
If Not FolderList.Any() Then
|
||||
WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存
|
||||
GoTo OnLoaded
|
||||
End If
|
||||
@@ -1058,6 +1070,7 @@ Reload:
|
||||
WriteIni(Path & "PCL.ini", "VersionCache", FolderListCheck)
|
||||
McVersionList = McVersionListLoadNoCache(Path)
|
||||
End If
|
||||
IsFirstMcVersionListLoad = False
|
||||
If Loader.IsAborted Then Exit Sub
|
||||
|
||||
'改变当前选择的版本
|
||||
@@ -1110,14 +1123,20 @@ OnLoaded:
|
||||
'循环读取版本
|
||||
For Each Folder As String In ReadIni(Path & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
|
||||
If Folder = "" Then Continue For
|
||||
If File.Exists(Path & "versions\" & Folder & "\.pclignore") Then
|
||||
Log("[Minecraft] 跳过要求忽略的项目:" & Path & "versions\" & Folder)
|
||||
Continue For
|
||||
Dim VersionFolder As String = $"{Path}versions\{Folder}\"
|
||||
If File.Exists(VersionFolder & ".pclignore") Then
|
||||
If IsFirstMcVersionListLoad Then
|
||||
Log("[Minecraft] 清理残留的忽略项目:" & VersionFolder) '#2781
|
||||
File.Delete(VersionFolder & ".pclignore")
|
||||
Else
|
||||
Log("[Minecraft] 跳过要求忽略的项目:" & VersionFolder)
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
Try
|
||||
|
||||
'读取单个版本
|
||||
Dim Version As New McVersion(Path & "versions\" & Folder & "\")
|
||||
Dim Version As New McVersion(VersionFolder)
|
||||
VersionList.Add(Version)
|
||||
Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "CustomInfo", "")
|
||||
If Version.Info = "" Then Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "Info", Version.Info)
|
||||
@@ -1189,11 +1208,17 @@ OnLoaded:
|
||||
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName)
|
||||
Continue For
|
||||
End If
|
||||
If File.Exists(Folder.FullName & "\.pclignore") Then
|
||||
Log("[Minecraft] 跳过要求忽略的项目:" & Folder.FullName)
|
||||
Continue For
|
||||
Dim VersionFolder As String = Folder.FullName & "\"
|
||||
If File.Exists(VersionFolder & ".pclignore") Then
|
||||
If IsFirstMcVersionListLoad Then
|
||||
Log("[Minecraft] 清理残留的忽略项目:" & VersionFolder) '#2781
|
||||
File.Delete(VersionFolder & ".pclignore")
|
||||
Else
|
||||
Log("[Minecraft] 跳过要求忽略的项目:" & VersionFolder)
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
Dim Version As New McVersion(Folder.FullName & "\")
|
||||
Dim Version As New McVersion(VersionFolder)
|
||||
VersionList.Add(Version)
|
||||
Version.Load()
|
||||
Next
|
||||
@@ -1209,7 +1234,7 @@ OnLoaded:
|
||||
For Each Version As McVersion In VersionList
|
||||
If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version)
|
||||
Next
|
||||
If StaredVersions.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
|
||||
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
|
||||
|
||||
'预先筛选出愚人节的版本
|
||||
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error)
|
||||
@@ -1283,8 +1308,8 @@ OnLoaded:
|
||||
|
||||
'将剩余的东西添加进去
|
||||
VersionRubbish.AddRange(VersionList)
|
||||
If VersionUseful.Count > 0 Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful)
|
||||
If VersionRubbish.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish)
|
||||
If VersionUseful.Any Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful)
|
||||
If VersionRubbish.Any Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish)
|
||||
|
||||
'按照自定义版本分类重新添加
|
||||
For Each VersionPair In VersionListOriginal
|
||||
@@ -1404,7 +1429,7 @@ OnLoaded:
|
||||
NextVersion:
|
||||
Next
|
||||
'加入版本列表,并从剩余中删除
|
||||
If KeepList.Count > 0 Then
|
||||
If KeepList.Any Then
|
||||
Target.Add(CardType, KeepList)
|
||||
For Each Version As McVersion In KeepList
|
||||
VersionList.Remove(Version)
|
||||
@@ -1425,7 +1450,7 @@ NextVersion:
|
||||
Next
|
||||
NextVersion:
|
||||
Next
|
||||
If KeepList.Count > 0 Then
|
||||
If KeepList.Any Then
|
||||
For Each Version As McVersion In KeepList
|
||||
VersionList.Remove(Version)
|
||||
Next
|
||||
@@ -1490,7 +1515,7 @@ NextVersion:
|
||||
''' </summary>
|
||||
Public Function McSkinGetAddress(Uuid As String, Type As String) As String
|
||||
If Uuid = "" Then Throw New Exception("Uuid 为空。")
|
||||
If Uuid.StartsWith("000000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
|
||||
If Uuid.StartsWithF("00000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
|
||||
'尝试读取缓存
|
||||
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
|
||||
If Not CacheSkinAddress = "" Then Return CacheSkinAddress
|
||||
@@ -1915,7 +1940,7 @@ NextVersion:
|
||||
'获取下载信息
|
||||
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))
|
||||
DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
End Try
|
||||
@@ -1926,9 +1951,7 @@ NextVersion:
|
||||
'开始下载
|
||||
Dim DownloadAddress As String = DownloadInfo("download_url")
|
||||
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
|
||||
Result.Add(New NetFile({
|
||||
DownloadAddress.Replace("bmclapi2.bangbang93.com", "download.mcbbs.net"), DownloadAddress
|
||||
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
|
||||
Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
@@ -1958,7 +1981,7 @@ NextVersion:
|
||||
'获取 Url 的真实地址
|
||||
Urls.Add(Token.Url)
|
||||
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
|
||||
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOf("maven")), "https://download.mcbbs.net/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
|
||||
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
|
||||
End If
|
||||
If Token.LocalPath.Contains("transformer-discovery-service") Then
|
||||
'Transformer 文件释放
|
||||
@@ -1970,7 +1993,6 @@ NextVersion:
|
||||
Dim OptiFineBase As String = Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries\optifine\OptiFine\", "").Split("_")(0) & "/" & GetFileNameFromPath(Token.LocalPath).Replace("-", "_")
|
||||
OptiFineBase = "/maven/com/optifine/" & OptiFineBase
|
||||
If OptiFineBase.Contains("_pre") Then OptiFineBase = OptiFineBase.Replace("com/optifine/", "com/optifine/preview_")
|
||||
Urls.Add("https://download.mcbbs.net" & OptiFineBase)
|
||||
Urls.Add("https://bmclapi2.bangbang93.com" & OptiFineBase)
|
||||
ElseIf Urls.Count <= 2 Then
|
||||
'普通文件
|
||||
@@ -1989,10 +2011,6 @@ NextVersion:
|
||||
Public Function McLibGet(Original As String, Optional WithHead As Boolean = True, Optional IgnoreLiteLoader As Boolean = False, Optional CustomMcFolder As String = Nothing) As String
|
||||
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
|
||||
Dim Splited = Original.Split(":")
|
||||
'If Original.ToLower.Contains("xray") OrElse Original.ToLower.Contains("rift") OrElse Original.ToLower.Contains("mixin") OrElse Original.Contains("net.minecraftforge:forge") OrElse Splited(2).Contains("beta") OrElse (IgnoreLiteLoader AndAlso Original.Contains("liteloader")) Then
|
||||
'ElseIf Splited(2).Contains("-") Then
|
||||
' Log("[Launch] 可能存在分段问题的支持库:" & Original)
|
||||
'End If
|
||||
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
|
||||
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
|
||||
'判断 OptiFine 是否应该使用 installer
|
||||
@@ -2030,8 +2048,7 @@ NextVersion:
|
||||
If Version.InheritVersion = "" Then Exit Do
|
||||
Version = New McVersion(PathMcFolder & "versions\" & Version.InheritVersion)
|
||||
Loop
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取资源文件索引下载地址失败")
|
||||
Catch
|
||||
End Try
|
||||
'无法获取到下载地址
|
||||
If ReturnLegacyOnError Then
|
||||
@@ -2221,10 +2238,11 @@ NextVersion:
|
||||
'弹窗结果
|
||||
If MsgResult = 2 Then
|
||||
'下载
|
||||
RunInUi(Sub()
|
||||
PageDownloadInstall.McVersionWaitingForSelect = VersionName
|
||||
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
|
||||
End Sub)
|
||||
RunInUi(
|
||||
Sub()
|
||||
PageDownloadInstall.McVersionWaitingForSelect = VersionName
|
||||
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
|
||||
End Sub)
|
||||
End If
|
||||
|
||||
Catch ex As Exception
|
||||
@@ -2249,8 +2267,10 @@ NextVersion:
|
||||
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
|
||||
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
|
||||
End If
|
||||
Dim Lefts = RegexSearch(Left.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
|
||||
Dim Rights = RegexSearch(Right.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
|
||||
Left = Left.ToLowerInvariant
|
||||
Right = Right.ToLowerInvariant
|
||||
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
|
||||
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
|
||||
Dim i As Integer = 0
|
||||
While True
|
||||
'两边均缺失,感觉是一个东西
|
||||
|
||||
@@ -13,6 +13,14 @@ Public Module ModMod
|
||||
Public Sub New(Path As String)
|
||||
Me.Path = If(Path, "")
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' Mod 的完整路径,去除最后的 .disabled 和 .old。
|
||||
''' </summary>
|
||||
Public ReadOnly Property RawPath As String
|
||||
Get
|
||||
Return GetPathFromFullPath(Path) & RawFileName
|
||||
End Get
|
||||
End Property
|
||||
|
||||
''' <summary>
|
||||
''' Mod 的完整文件名。
|
||||
@@ -40,7 +48,7 @@ Public Module ModMod
|
||||
Load()
|
||||
If Not IsFileAvailable Then
|
||||
Return McModState.Unavaliable
|
||||
ElseIf Path.EndsWith(".disabled") OrElse Path.EndsWith(".old") Then
|
||||
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
|
||||
Return McModState.Disabled
|
||||
Else
|
||||
Return McModState.Fine
|
||||
@@ -68,7 +76,7 @@ Public Module ModMod
|
||||
Return _Name
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso
|
||||
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
|
||||
value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
|
||||
_Name = value
|
||||
End If
|
||||
@@ -105,12 +113,12 @@ Public Module ModMod
|
||||
Return _Version
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Version IsNot Nothing AndAlso (_Version.Contains(".") OrElse _Version.Contains("-")) Then Exit Property
|
||||
If value IsNot Nothing AndAlso value.ToLower.Contains("version") Then value = "version" '需要修改的标识
|
||||
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
|
||||
If value?.ContainsF("version", True) Then value = "version" '需要修改的标识
|
||||
_Version = value
|
||||
End Set
|
||||
End Property
|
||||
Private _Version As String = Nothing
|
||||
Public _Version As String = Nothing
|
||||
|
||||
''' <summary>
|
||||
''' 用于依赖检查的 ModID。
|
||||
@@ -121,12 +129,12 @@ Public Module ModMod
|
||||
Return _ModId
|
||||
End Get
|
||||
Set(value As String)
|
||||
If value Is Nothing Then Exit Property
|
||||
value = RegexSeek(value.ToLower, "[0-9a-z_-]+")
|
||||
If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
|
||||
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
|
||||
If _ModId Is Nothing Then _ModId = value
|
||||
End If
|
||||
If value Is Nothing Then Return
|
||||
value = RegexSeek(value, "[0-9a-zA-Z_-]+")
|
||||
If value Is Nothing OrElse value.Count <= 1 OrElse Val(value).ToString = value Then Return
|
||||
If value.ContainsF("name", True) OrElse value.ContainsF("modid", True) Then Return
|
||||
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
|
||||
If _ModId Is Nothing Then _ModId = value
|
||||
End Set
|
||||
End Property
|
||||
Private _ModId As String = Nothing
|
||||
@@ -144,7 +152,7 @@ Public Module ModMod
|
||||
Return _Url
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWith("http") Then
|
||||
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWithF("http") Then
|
||||
_Url = value
|
||||
End If
|
||||
End Set
|
||||
@@ -185,7 +193,7 @@ Public Module ModMod
|
||||
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
|
||||
VersionRequirement = Nothing
|
||||
Else
|
||||
If (Not VersionRequirement.StartsWith("[")) AndAlso (Not VersionRequirement.StartsWith("(")) AndAlso (Not VersionRequirement.EndsWith("]")) AndAlso (Not VersionRequirement.EndsWith(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
|
||||
If (Not VersionRequirement.StartsWithF("[")) AndAlso (Not VersionRequirement.StartsWithF("(")) AndAlso (Not VersionRequirement.EndsWithF("]")) AndAlso (Not VersionRequirement.EndsWithF(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
|
||||
End If
|
||||
'向依赖项中添加
|
||||
If _Dependencies.ContainsKey(ModID) Then
|
||||
@@ -262,7 +270,6 @@ Public Module ModMod
|
||||
_Dependencies = New Dictionary(Of String, String)
|
||||
IsLoaded = False
|
||||
_FileUnavailableReason = Nothing
|
||||
IsInfoWithoutClassAvailable = False
|
||||
IsInfoWithClassLoaded = False
|
||||
IsInfoWithClassAvailable = False
|
||||
End Sub
|
||||
@@ -276,15 +283,12 @@ Public Module ModMod
|
||||
Init()
|
||||
Dim Jar As ZipArchive = Nothing
|
||||
Try
|
||||
'阶段 1:基础可用性检查、打开 Jar 文件
|
||||
'基础可用性检查、打开 Jar 文件
|
||||
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")")
|
||||
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
|
||||
Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
|
||||
If Jar.Entries.Count = 0 Then Throw New FileFormatException("文件内容为空")
|
||||
'阶段 2:信息获取
|
||||
LoadWithoutClass(Jar)
|
||||
'阶段 3: Class 信息获取
|
||||
If Not IsInfoWithoutClassAvailable Then LoadWithClass(Jar)
|
||||
'信息获取
|
||||
LookupMetadata(Jar)
|
||||
Catch ex As UnauthorizedAccessException
|
||||
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
|
||||
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
|
||||
@@ -299,9 +303,9 @@ Public Module ModMod
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 进行不使用 .class 文件的信息获取。
|
||||
''' 从 jar 文件中获取 Mod 信息。
|
||||
''' </summary>
|
||||
Private Sub LoadWithoutClass(Jar As ZipArchive)
|
||||
Private Sub LookupMetadata(Jar As ZipArchive)
|
||||
|
||||
#Region "尝试使用 mcmod.info"
|
||||
Try
|
||||
@@ -333,13 +337,13 @@ Public Module ModMod
|
||||
For Each Token In AuthorJson
|
||||
Author.Add(Token.ToString)
|
||||
Next
|
||||
If Author.Count > 0 Then Authors = Join(Author, ", ")
|
||||
If Author.Any Then Authors = Join(Author, ", ")
|
||||
End If
|
||||
Dim Reqs As JArray = InfoObject("requiredMods")
|
||||
If Reqs IsNot Nothing Then
|
||||
For Each Token As String In Reqs
|
||||
If Not String.IsNullOrEmpty(Token) Then
|
||||
Token = Token.Substring(Token.IndexOf(":") + 1)
|
||||
Token = Token.Substring(Token.IndexOfF(":") + 1)
|
||||
If Token.Contains("@") Then
|
||||
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
|
||||
Else
|
||||
@@ -352,7 +356,7 @@ Public Module ModMod
|
||||
If Reqs IsNot Nothing Then
|
||||
For Each Token As String In Reqs
|
||||
If Not String.IsNullOrEmpty(Token) Then
|
||||
Token = Token.Substring(Token.IndexOf(":") + 1)
|
||||
Token = Token.Substring(Token.IndexOfF(":") + 1)
|
||||
If Token.Contains("@") Then
|
||||
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
|
||||
Else
|
||||
@@ -389,7 +393,7 @@ GotFabric:
|
||||
For Each Token In AuthorJson
|
||||
Author.Add(Token.ToString)
|
||||
Next
|
||||
If Author.Count > 0 Then Authors = Join(Author, ", ")
|
||||
If Author.Any Then Authors = Join(Author, ", ")
|
||||
End If
|
||||
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
|
||||
' '添加 Minecraft 依赖
|
||||
@@ -399,8 +403,8 @@ GotFabric:
|
||||
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
|
||||
' If Deps <> "" Then
|
||||
' For Each Dep In Deps.Split(";")
|
||||
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
|
||||
' Dep = Dep.Substring(Dep.IndexOf(":") + 1)
|
||||
' If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
|
||||
' Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
|
||||
' If Dep.Contains("@") Then
|
||||
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
|
||||
' Else
|
||||
@@ -428,40 +432,40 @@ GotFabric:
|
||||
'文件标准化:统一换行符为 vbLf,去除注释、头尾的空格、空行
|
||||
Dim Lines As New List(Of String)
|
||||
For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符
|
||||
If Line.StartsWith("#") Then '去除注释
|
||||
If Line.StartsWithF("#") Then '去除注释
|
||||
Continue For
|
||||
ElseIf Line.Contains("#") Then
|
||||
Line = Line.Substring(0, Line.IndexOf("#"))
|
||||
Line = Line.Substring(0, Line.IndexOfF("#"))
|
||||
End If
|
||||
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
|
||||
If Line.Count > 0 Then Lines.Add(Line) '去除空行
|
||||
If Line.Any Then Lines.Add(Line) '去除空行
|
||||
Next
|
||||
'读取文件数据
|
||||
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
|
||||
For i = 0 To Lines.Count - 1
|
||||
Dim Line As String = Lines(i)
|
||||
If Line.StartsWith("[") AndAlso Line.EndsWith("]") Then
|
||||
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
|
||||
'段落标记
|
||||
Dim Header = Line.Trim("[]".ToCharArray)
|
||||
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
|
||||
ElseIf Line.Contains("=") Then
|
||||
'字段标记
|
||||
Dim Key As String = Line.Substring(0, Line.IndexOf("=")).TrimEnd(New Char() {" "c, " "c, " "c})
|
||||
Dim RawValue As String = Line.Substring(Line.IndexOf("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
|
||||
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, " "c})
|
||||
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
|
||||
Dim Value As Object
|
||||
If RawValue.StartsWith("""") AndAlso RawValue.EndsWith("""") Then
|
||||
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
|
||||
'单行字符串
|
||||
Value = RawValue.Trim("""")
|
||||
ElseIf RawValue.StartsWith("'''") Then
|
||||
ElseIf RawValue.StartsWithF("'''") Then
|
||||
'多行字符串
|
||||
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
|
||||
If ValueLines(0).EndsWith("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
|
||||
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
|
||||
ValueLines(0) = ValueLines(0).TrimEnd("'")
|
||||
Else
|
||||
Do Until i >= Lines.Count - 1
|
||||
i += 1
|
||||
Dim ValueLine As String = Lines(i)
|
||||
If ValueLine.EndsWith("'''") Then
|
||||
If ValueLine.EndsWithF("'''") Then
|
||||
ValueLines.Add(ValueLine.TrimEnd("'"))
|
||||
Exit Do
|
||||
Else
|
||||
@@ -567,8 +571,8 @@ Got:
|
||||
Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
|
||||
If Deps <> "" Then
|
||||
For Each Dep In Deps.Split(";")
|
||||
If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
|
||||
Dep = Dep.Substring(Dep.IndexOf(":") + 1)
|
||||
If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
|
||||
Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
|
||||
If Dep.Contains("@") Then
|
||||
AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
|
||||
Else
|
||||
@@ -589,7 +593,7 @@ Finished:
|
||||
If MetaEntry IsNot Nothing Then
|
||||
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
|
||||
If MetaString.Contains("Implementation-Version:") Then
|
||||
MetaString = MetaString.Substring(MetaString.IndexOf("Implementation-Version:") + "Implementation-Version:".Count)
|
||||
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
|
||||
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
|
||||
Version = MetaString
|
||||
End If
|
||||
@@ -602,97 +606,17 @@ Finished:
|
||||
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
|
||||
#End Region
|
||||
|
||||
IsInfoWithoutClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 进行使用 .class 文件的信息获取。
|
||||
''' </summary>
|
||||
Private Sub LoadWithClass(Jar As ZipArchive)
|
||||
Try
|
||||
'查找入口点文件
|
||||
Dim ModClass As String = Nothing
|
||||
Dim ModClassNotBest As String = Nothing '非完美匹配
|
||||
For Each Entry In Jar.Entries
|
||||
If Entry.Name.EndsWith(".class") Then
|
||||
Dim Temp As String = ReadFile(Entry.Open()).ToLower
|
||||
If Temp.Contains("#lnet/minecraftforge/fml/common/mod;") Then
|
||||
ModClass = Temp
|
||||
Exit For
|
||||
ElseIf Temp.Contains("modid") Then
|
||||
ModClassNotBest = Temp
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
If ModClass Is Nothing Then ModClass = ModClassNotBest
|
||||
If ModClass Is Nothing Then Throw New FileNotFoundException("未找到 Mod 入口点")
|
||||
ModClass = ModClass.Replace("ljava/lang/string;", "")
|
||||
If ModClass.Count > 3000 Then ModClass = ModClass.Substring(0, 3000) '如果文件过大,截取前 3000 Byte
|
||||
Dim IndexHead As Integer, IndexTail As Integer, IncreaseCount As Integer
|
||||
'获取 ModID
|
||||
If _ModId Is Nothing Then
|
||||
IndexHead = ModClass.IndexOf("modid") + "modid".Length + 1
|
||||
IncreaseCount = 0
|
||||
Do While Convert.ToInt32(ModClass(IndexHead)) < 32
|
||||
IndexHead += 1
|
||||
IncreaseCount += 1
|
||||
If IncreaseCount > 10 Then Throw New Exception("ModID 头匹配失败")
|
||||
Loop
|
||||
IndexTail = IndexHead + 1
|
||||
IncreaseCount = 0
|
||||
Do Until Convert.ToInt32(ModClass(IndexTail)) < 32
|
||||
IndexTail += 1
|
||||
IncreaseCount += 1
|
||||
If IncreaseCount > 50 Then Throw New Exception("ModID 尾匹配失败")
|
||||
Loop
|
||||
ModId = ModClass.Substring(IndexHead, IndexTail - IndexHead)
|
||||
End If
|
||||
'获取 Version
|
||||
If _Version Is Nothing AndAlso ModClass.Contains("version") Then
|
||||
IndexHead = ModClass.IndexOf("version") + "version".Length + 1
|
||||
IncreaseCount = 0
|
||||
Do While Convert.ToInt32(ModClass(IndexHead)) < 32
|
||||
IndexHead += 1
|
||||
IncreaseCount += 1
|
||||
If IncreaseCount > 10 Then GoTo VersionFindFail
|
||||
Loop
|
||||
IndexTail = IndexHead + 1
|
||||
IncreaseCount = 0
|
||||
Do While ModClass(IndexTail) = "."c OrElse ModClass(IndexTail) = "-"c OrElse
|
||||
(ModClass(IndexTail) >= "0"c AndAlso ModClass(IndexTail) <= "9"c) OrElse
|
||||
(ModClass(IndexTail) >= "a"c AndAlso ModClass(IndexTail) <= "z"c)
|
||||
IndexTail += 1
|
||||
IncreaseCount += 1
|
||||
If IncreaseCount > 50 Then GoTo VersionFindFail
|
||||
Loop
|
||||
_Version = ModClass.Substring(IndexHead, IndexTail - IndexHead)
|
||||
End If
|
||||
VersionFindFail:
|
||||
'获取 Dependencies
|
||||
IndexHead = ModClass.IndexOf("dependencies")
|
||||
If IndexHead > 0 Then
|
||||
If ModClass.Count >= IndexHead + 300 Then ModClass = ModClass.Substring(IndexHead, 299)
|
||||
Dim Deps As List(Of String) = RegexSearch(ModClass, "(?<=required-((before|after|before-client|after-client)?):)[0-9a-z]+(@[\(\[]{1}[0-9.,]+[\)\]]{1})?")
|
||||
For Each Token As String In Deps
|
||||
If Not String.IsNullOrEmpty(Token) Then
|
||||
If Token.Contains("@") Then
|
||||
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
|
||||
Else
|
||||
AddDependency(Token)
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "Mod Class 信息不可用(" & If(Path, "null") & ")", LogLevel.Normal)
|
||||
End Try
|
||||
IsInfoWithClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "网络信息"
|
||||
|
||||
''' <summary>
|
||||
''' 当任何网络信息更新时触发。
|
||||
''' </summary>
|
||||
Public Event OnCompUpdate(sender As McMod)
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 关联的网络项目。
|
||||
''' </summary>
|
||||
@@ -702,12 +626,70 @@ VersionFindFail:
|
||||
End Get
|
||||
Set(value As CompProject)
|
||||
_Comp = value
|
||||
RaiseEvent OnGetCompProject(Me)
|
||||
RaiseEvent OnCompUpdate(Me)
|
||||
End Set
|
||||
End Property
|
||||
Private _Comp As CompProject
|
||||
Public IsCompFromModrinth = False
|
||||
Public Event OnGetCompProject(sender As McMod)
|
||||
|
||||
''' <summary>
|
||||
''' 本地文件对应的联网文件信息。
|
||||
''' </summary>
|
||||
Public CompFile As CompFile
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 对应的联网最新版本。
|
||||
''' </summary>
|
||||
Public Property UpdateFile As CompFile
|
||||
Get
|
||||
Return _UpdateFile
|
||||
End Get
|
||||
Set(value As CompFile)
|
||||
_UpdateFile = value
|
||||
RaiseEvent OnCompUpdate(Me)
|
||||
End Set
|
||||
End Property
|
||||
Private _UpdateFile As CompFile
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 的更新日志网址。
|
||||
''' </summary>
|
||||
Public ChangelogUrls As New List(Of String)
|
||||
''' <summary>
|
||||
''' 所有网络信息是否已成功加载。
|
||||
''' </summary>
|
||||
Public CompLoaded As Boolean = False
|
||||
|
||||
''' <summary>
|
||||
''' 将网络信息保存为 Json。
|
||||
''' </summary>
|
||||
Public Function ToJson() As JObject
|
||||
Dim Json As New JObject
|
||||
If Comp IsNot Nothing Then Json.Add("Comp", Comp.ToJson())
|
||||
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
|
||||
Json.Add("CompLoaded", CompLoaded)
|
||||
If CompFile IsNot Nothing Then Json.Add("CompFile", CompFile.ToJson())
|
||||
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToJson())
|
||||
Return Json
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从 Json 中读取网络信息。
|
||||
''' </summary>
|
||||
Public Sub FromJson(Json As JObject)
|
||||
CompLoaded = Json("CompLoaded")
|
||||
If Json.ContainsKey("Comp") Then Comp = New CompProject(Json("Comp"))
|
||||
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
|
||||
If Json.ContainsKey("CompFile") Then CompFile = New CompFile(Json("CompFile"), CompType.Mod)
|
||||
If Json.ContainsKey("UpdateFile") Then UpdateFile = New CompFile(Json("UpdateFile"), CompType.Mod)
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 该文件是否可以更新。
|
||||
''' </summary>
|
||||
Public ReadOnly Property CanUpdate As Boolean
|
||||
Get
|
||||
Return ChangelogUrls.Any()
|
||||
End Get
|
||||
End Property
|
||||
|
||||
''' <summary>
|
||||
''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。
|
||||
@@ -715,6 +697,14 @@ VersionFindFail:
|
||||
Public ReadOnly Property CurseForgeHash As UInteger
|
||||
Get
|
||||
If _CurseForgeHash Is Nothing Then
|
||||
'读取缓存
|
||||
Dim Info As New FileInfo(Path)
|
||||
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
|
||||
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
|
||||
If Cached <> "" Then
|
||||
_CurseForgeHash = Cached
|
||||
Return _CurseForgeHash
|
||||
End If
|
||||
'读取文件
|
||||
Dim data As New List(Of Byte)
|
||||
For Each b As Byte In File.ReadAllBytes(Path)
|
||||
@@ -749,6 +739,8 @@ VersionFindFail:
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
h = h Xor (h >> 15)
|
||||
_CurseForgeHash = h
|
||||
'写入缓存
|
||||
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
|
||||
End If
|
||||
Return _CurseForgeHash
|
||||
End Get
|
||||
@@ -761,20 +753,43 @@ VersionFindFail:
|
||||
Public ReadOnly Property ModrinthHash As String
|
||||
Get
|
||||
If _ModrinthHash Is Nothing Then
|
||||
'读取缓存
|
||||
Dim Info As New FileInfo(Path)
|
||||
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-M")
|
||||
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
|
||||
If Cached <> "" Then
|
||||
_ModrinthHash = Cached
|
||||
Return _ModrinthHash
|
||||
End If
|
||||
'计算 SHA1
|
||||
_ModrinthHash = GetFileSHA1(Path)
|
||||
'写入缓存
|
||||
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
|
||||
End If
|
||||
Return _ModrinthHash
|
||||
End Get
|
||||
End Property
|
||||
Private _ModrinthHash As String
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "API"
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return $"{State} - {Path}"
|
||||
End Function
|
||||
Public Overrides Function Equals(obj As Object) As Boolean
|
||||
Dim target = TryCast(obj, McMod)
|
||||
Return target IsNot Nothing AndAlso Path = target.Path
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
''' <summary>
|
||||
''' 是否可能为前置 Mod。
|
||||
''' </summary>
|
||||
Public Function IsPresetMod() As Boolean
|
||||
Return Dependencies.Count = 0 AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
|
||||
Return Not Dependencies.Any() AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
@@ -783,9 +798,9 @@ VersionFindFail:
|
||||
Public Shared Function IsModFile(Path As String)
|
||||
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
|
||||
Path = Path.ToLower
|
||||
If Path.EndsWith(".jar") OrElse Path.EndsWith(".zip") OrElse Path.EndsWith(".litemod") OrElse
|
||||
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") OrElse
|
||||
Path.EndsWith(".jar.old") OrElse Path.EndsWith(".zip.old") OrElse Path.EndsWith(".litemod.old") Then Return True
|
||||
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
|
||||
Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
|
||||
Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
|
||||
Return False
|
||||
End Function
|
||||
|
||||
@@ -797,6 +812,20 @@ VersionFindFail:
|
||||
Try
|
||||
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False)
|
||||
|
||||
'等待 Mod 更新完成
|
||||
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
|
||||
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
|
||||
Try
|
||||
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
|
||||
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
|
||||
If Loader.IsAborted Then Exit Sub
|
||||
Thread.Sleep(100)
|
||||
Loop
|
||||
Finally
|
||||
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
|
||||
End Try
|
||||
End If
|
||||
|
||||
'获取 Mod 文件夹下的可用文件列表
|
||||
Dim ModFileList As New List(Of FileInfo)
|
||||
If Directory.Exists(Loader.Input) Then
|
||||
@@ -826,7 +855,7 @@ VersionFindFail:
|
||||
If CacheContent <> "" Then
|
||||
Cache = GetJson(CacheContent)
|
||||
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
|
||||
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息")
|
||||
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
|
||||
Cache = New JObject
|
||||
End If
|
||||
End If
|
||||
@@ -839,20 +868,30 @@ VersionFindFail:
|
||||
Dim ModList As New List(Of McMod)
|
||||
Dim ModUpdateList As New List(Of McMod)
|
||||
For Each ModFile As FileInfo In ModFileList
|
||||
Loader.Progress += 0.95 / ModFileList.Count
|
||||
Loader.Progress += 0.94 / ModFileList.Count
|
||||
If Loader.IsAborted Then Exit Sub
|
||||
'加载 McMod 对象
|
||||
Dim ModEntry As New McMod(ModFile.FullName)
|
||||
ModEntry.Load()
|
||||
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName)
|
||||
If DumpMod IsNot Nothing Then
|
||||
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
|
||||
Log($"[Mod] 重复的 Mod 文件:{DumpMod.FileName} 与 {ModEntry.FileName},已忽略 {DisabledMod.FileName}", LogLevel.Debug)
|
||||
If DisabledMod Is ModEntry Then
|
||||
Continue For
|
||||
Else
|
||||
ModList.Remove(DisabledMod)
|
||||
ModUpdateList.Remove(DisabledMod)
|
||||
End If
|
||||
End If
|
||||
ModList.Add(ModEntry)
|
||||
'读取 Comp 缓存
|
||||
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
|
||||
Dim Hash = ModEntry.ModrinthHash
|
||||
If Cache.ContainsKey(Hash) Then
|
||||
ModEntry.Comp = New CompProject(Cache(Hash))
|
||||
ModEntry.IsCompFromModrinth = Not ModEntry.Comp.FromCurseForge
|
||||
ModEntry.FromJson(Cache(Hash))
|
||||
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
|
||||
If Date.Now - Cache(Hash)("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
|
||||
If ModEntry.CompLoaded AndAlso Date.Now - Cache(Hash)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
|
||||
End If
|
||||
ModUpdateList.Add(ModEntry)
|
||||
Next
|
||||
@@ -860,13 +899,14 @@ VersionFindFail:
|
||||
Log($"[Mod] 共有 {ModList.Count} 个 Mod,其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息,{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
|
||||
|
||||
'排序
|
||||
ModList = Sort(ModList, Function(Left As McMod, Right As McMod) As Boolean
|
||||
If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then
|
||||
Return Left.State = McMod.McModState.Unavaliable
|
||||
Else
|
||||
Return Not Right.FileName.CompareTo(Left.FileName)
|
||||
End If
|
||||
End Function)
|
||||
ModList = Sort(ModList,
|
||||
Function(Left As McMod, Right As McMod) As Boolean
|
||||
If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then
|
||||
Return Left.State = McMod.McModState.Unavaliable
|
||||
Else
|
||||
Return Not Right.FileName.CompareTo(Left.FileName)
|
||||
End If
|
||||
End Function)
|
||||
|
||||
'回设
|
||||
If Loader.IsAborted Then Exit Sub
|
||||
@@ -874,10 +914,10 @@ VersionFindFail:
|
||||
|
||||
'开始联网加载
|
||||
If ModUpdateList.Any() Then
|
||||
'TODO: 添加信息获取中提示
|
||||
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
|
||||
End If
|
||||
|
||||
Loader.Progress = 1
|
||||
Catch ex As Exception
|
||||
Log(ex, "Mod 列表加载失败", LogLevel.Debug)
|
||||
Throw
|
||||
@@ -885,29 +925,31 @@ VersionFindFail:
|
||||
End Sub
|
||||
|
||||
'联网加载 Mod 详情
|
||||
Private Const LocalModCacheVersion As Integer = 1
|
||||
Private Const LocalModCacheVersion As Integer = 3
|
||||
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
|
||||
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
|
||||
Dim Mods As List(Of McMod) = Loader.Input.Key
|
||||
Dim Cache As JObject = Loader.Input.Value
|
||||
'获取作为检查目标的加载器和版本
|
||||
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
|
||||
Dim ModLoaders As New List(Of String)
|
||||
If TargetMcVersion.HasForge Then ModLoaders.Add("forge")
|
||||
If TargetMcVersion.HasFabric Then ModLoaders.Add("fabric")
|
||||
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add("liteloader")
|
||||
If Not ModLoaders.Any() Then ModLoaders.AddRange({"forge", "fabric", "liteloader"})
|
||||
Dim ModLoaders As New List(Of CompModLoaderType)
|
||||
If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
|
||||
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
|
||||
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
|
||||
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
|
||||
Dim McVersions As New List(Of String) From {TargetMcVersion.McName}
|
||||
If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
|
||||
McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
|
||||
For i = 1 To TargetMcVersion.McCodeSub
|
||||
McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
|
||||
Next
|
||||
End If
|
||||
McVersions = McVersions.Distinct().ToList()
|
||||
'暂不向下扩展检查的 MC 小版本
|
||||
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
|
||||
'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
|
||||
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
|
||||
' For i = 1 To TargetMcVersion.McCodeSub
|
||||
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
|
||||
' Next
|
||||
'End If
|
||||
'McVersions = McVersions.Distinct().ToList()
|
||||
'开始网络获取
|
||||
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersions.Join("/")}")
|
||||
Dim CompletedThread As Integer = 0
|
||||
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
|
||||
Dim MainThread As Thread = Thread.CurrentThread
|
||||
'从 Modrinth 获取信息
|
||||
RunInNewThread(
|
||||
@@ -915,25 +957,25 @@ VersionFindFail:
|
||||
Try
|
||||
'步骤 1:获取 Hash 与对应的工程 ID
|
||||
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
|
||||
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
|
||||
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"",
|
||||
""loaders"": [""{ModLoaders.Join(""",""")}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject)
|
||||
Log($"[Mod] 从 Modrinth 获取到 {ModrinthUpdate.Count} 个本地 Mod 的对应信息")
|
||||
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
|
||||
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
|
||||
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
|
||||
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
|
||||
If ModrinthUpdate.Count = 0 Then Exit Sub
|
||||
If ModrinthVersion.Count = 0 Then Exit Sub
|
||||
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
|
||||
For Each ModEntity In Mods
|
||||
If Not ModrinthUpdate.ContainsKey(ModEntity.ModrinthHash) Then Continue For
|
||||
Dim ProjectId = ModrinthUpdate(ModEntity.ModrinthHash)("project_id").ToString
|
||||
If CompProjectCache.ContainsKey(ProjectId) Then
|
||||
ModEntity.Comp = CompProjectCache(ProjectId)
|
||||
Else
|
||||
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
|
||||
ModrinthMapping(ProjectId).Add(ModEntity)
|
||||
End If
|
||||
For Each Entry In Mods
|
||||
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
|
||||
If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
|
||||
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
|
||||
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
|
||||
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
|
||||
ModrinthMapping(ProjectId).Add(Entry)
|
||||
'记录对应的 CompFile
|
||||
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
|
||||
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
|
||||
Next
|
||||
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
|
||||
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 类本地 Mod 的工程信息")
|
||||
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
|
||||
'步骤 3:获取工程信息
|
||||
If Not ModrinthMapping.Any() Then Exit Sub
|
||||
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
|
||||
@@ -942,18 +984,37 @@ VersionFindFail:
|
||||
For Each ProjectJson In ModrinthProject
|
||||
Dim Project As New CompProject(ProjectJson)
|
||||
For Each Entry In ModrinthMapping(Project.Id)
|
||||
If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then
|
||||
Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 加载不出来
|
||||
End If
|
||||
Entry.IsCompFromModrinth = True
|
||||
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
|
||||
Entry.Comp = Project
|
||||
Next
|
||||
Next
|
||||
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
|
||||
'步骤 4:获取更新信息
|
||||
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
|
||||
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"",
|
||||
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject)
|
||||
For Each Entry In Mods
|
||||
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
|
||||
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
|
||||
If Not UpdateFile.Available Then Continue For
|
||||
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
|
||||
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
|
||||
'设置更新日志与更新文件
|
||||
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
|
||||
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}")
|
||||
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
|
||||
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
|
||||
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
|
||||
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}"}
|
||||
Entry.UpdateFile = UpdateFile
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
|
||||
SucceedThreadCount += 1
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
|
||||
Finally
|
||||
CompletedThread += 1
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
End Sub, "Mod List Detail Loader Modrinth")
|
||||
'从 CurseForge 获取信息
|
||||
@@ -962,57 +1023,110 @@ VersionFindFail:
|
||||
Try
|
||||
'步骤 1:获取 Hash 与对应的工程 ID
|
||||
Dim CurseForgeHashes As New List(Of UInteger)
|
||||
For Each ModEntity In Mods
|
||||
CurseForgeHashes.Add(ModEntity.CurseForgeHash)
|
||||
For Each Entry In Mods
|
||||
CurseForgeHashes.Add(Entry.CurseForgeHash)
|
||||
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
|
||||
Next
|
||||
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
|
||||
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
|
||||
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
|
||||
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
|
||||
If CurseForgeRaw.Count = 0 Then Exit Sub
|
||||
If Not CurseForgeRaw.Any() Then Exit Sub
|
||||
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
|
||||
For Each Project In CurseForgeRaw
|
||||
Dim ProjectId = Project("id").ToString
|
||||
Dim Hash As UInteger = Project("file")("fileFingerprint")
|
||||
For Each Entry In Mods
|
||||
If Entry.CurseForgeHash <> Hash Then Continue For
|
||||
If CompProjectCache.ContainsKey(ProjectId) Then
|
||||
Entry.Comp = CompProjectCache(ProjectId)
|
||||
Else
|
||||
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
|
||||
CurseForgeMapping(ProjectId).Add(Entry)
|
||||
End If
|
||||
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
|
||||
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
|
||||
CurseForgeMapping(ProjectId).Add(Entry)
|
||||
'记录对应的 CompFile
|
||||
Dim File As New CompFile(Project("file"), CompType.Mod)
|
||||
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
|
||||
Next
|
||||
Next
|
||||
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
|
||||
Log($"[Mod] 读取缓存后还需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
|
||||
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
|
||||
'步骤 3:获取工程信息
|
||||
If Not CurseForgeMapping.Any() Then Exit Sub
|
||||
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
|
||||
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
|
||||
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
|
||||
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
|
||||
For Each ProjectJson In CurseForgeProject
|
||||
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
|
||||
'设置 Entry 中的工程信息
|
||||
Dim Project As New CompProject(ProjectJson)
|
||||
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
|
||||
If Entry.Comp IsNot Nothing AndAlso Entry.IsCompFromModrinth Then
|
||||
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
|
||||
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
|
||||
Entry.Comp = Entry.Comp '再次触发修改事件
|
||||
Continue For
|
||||
End If
|
||||
Entry.IsCompFromModrinth = False
|
||||
Entry.Comp = Project
|
||||
Next
|
||||
'查找或许版本更新的文件列表
|
||||
If ModLoaders.Count = 1 Then 'TODO: 结果有多个 ModLoader 时提示无法检测更新
|
||||
Dim NewestVersion As String = Nothing
|
||||
Dim NewestFileIds As New List(Of Integer)
|
||||
For Each IndexEntry In ProjectJson("latestFilesIndexes")
|
||||
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
|
||||
Dim IndexVersion As String = IndexEntry("gameVersion")
|
||||
If Not McVersions.Contains(IndexVersion) Then Continue For 'MC 版本匹配
|
||||
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
|
||||
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
|
||||
If NewestVersion <> IndexVersion Then
|
||||
NewestVersion = IndexVersion
|
||||
NewestFileIds.Clear()
|
||||
End If
|
||||
NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer))
|
||||
Next
|
||||
For Each FileId In NewestFileIds
|
||||
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of McMod)
|
||||
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
|
||||
FileIdToProjectSlug(FileId) = Project.Slug
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 CurseForge 获取本地 Mod 信息结束")
|
||||
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
|
||||
'步骤 4:获取更新文件信息
|
||||
If Not UpdateFileIds.Any() Then Exit Sub
|
||||
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST",
|
||||
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
|
||||
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
|
||||
For Each FileJson In CurseForgeFiles
|
||||
Dim File As New CompFile(FileJson, CompType.Mod)
|
||||
If Not File.Available Then Continue For
|
||||
For Each Entry As McMod In UpdateFileIds(File.Id)
|
||||
If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
|
||||
UpdateFiles(Entry) = File
|
||||
Next
|
||||
Next
|
||||
For Each Pair In UpdateFiles
|
||||
Dim Entry As McMod = Pair.Key
|
||||
Dim UpdateFile As CompFile = Pair.Value
|
||||
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
|
||||
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
|
||||
'设置更新日志与更新文件
|
||||
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
|
||||
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
|
||||
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
|
||||
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
|
||||
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
|
||||
Entry.UpdateFile = UpdateFile
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
|
||||
SucceedThreadCount += 1
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
|
||||
Finally
|
||||
CompletedThread += 1
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
End Sub, "Mod List Detail Loader CurseForge")
|
||||
'等待线程结束
|
||||
Do Until CompletedThread = 2
|
||||
Do Until EndedThreadCount = 2
|
||||
If Loader.IsAborted Then Exit Sub
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
@@ -1020,8 +1134,9 @@ VersionFindFail:
|
||||
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
|
||||
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
|
||||
If Not Mods.Any() Then Exit Sub
|
||||
For Each ModEntity In Mods
|
||||
Cache(ModEntity.ModrinthHash) = ModEntity.Comp.ToJson()
|
||||
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
|
||||
Entry.CompLoaded = SucceedThreadCount = 2
|
||||
Cache(Entry.ModrinthHash) = Entry.ToJson()
|
||||
Next
|
||||
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
|
||||
End Sub
|
||||
@@ -1051,12 +1166,12 @@ VersionFindFail:
|
||||
If CurrentDependencies.ContainsKey(PossibleModId) Then
|
||||
If CurrentDependencies(PossibleModId)(2) = 1 Then
|
||||
Result.Add("重复添加了相同的 Mod,请尝试删除其中一个(ModID:" & PossibleModId & ")。" & vbCrLf &
|
||||
" - " & ModEntity.FileName & vbCrLf &
|
||||
" - " & CurrentDependencies(PossibleModId)(1))
|
||||
" - " & ModEntity.FileName & vbCrLf &
|
||||
" - " & CurrentDependencies(PossibleModId)(1))
|
||||
Else
|
||||
Log("[Minecraft] 由于可能有多个 ModID,跳过疑似的重复项(ModID:" & PossibleModId & ")。" & vbCrLf &
|
||||
" - " & ModEntity.FileName & vbCrLf &
|
||||
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
|
||||
" - " & ModEntity.FileName & vbCrLf &
|
||||
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
|
||||
End If
|
||||
Else
|
||||
CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count})
|
||||
@@ -1074,8 +1189,8 @@ VersionFindFail:
|
||||
If Dependency.Value IsNot Nothing Then
|
||||
'获取分段后的详细版本信息
|
||||
Dim ReqVersion As String = Dependency.Value
|
||||
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWith("[")
|
||||
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWith("]")
|
||||
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
|
||||
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
|
||||
Dim ReqVersionHead As String
|
||||
Dim ReqVersionTail As String
|
||||
If ReqVersion.Contains(",") Then
|
||||
@@ -1089,8 +1204,8 @@ VersionFindFail:
|
||||
ReqVersionTailCanEqual = False
|
||||
End If
|
||||
End If
|
||||
If ReqVersionHead.StartsWith("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOf("-") + 1)
|
||||
If ReqVersionTail.StartsWith("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOf("-") + 1)
|
||||
If ReqVersionHead.StartsWithF("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOfF("-") + 1)
|
||||
If ReqVersionTail.StartsWithF("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOfF("-") + 1)
|
||||
'获取报错描述文本
|
||||
Dim VersionRequire As String
|
||||
If ReqVersionHead = ReqVersionTail Then
|
||||
@@ -1118,7 +1233,7 @@ VersionFindFail:
|
||||
Continue For
|
||||
End If
|
||||
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
|
||||
If CurrentVersion.StartsWith("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOf("-") + 1)
|
||||
If CurrentVersion.StartsWithF("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOfF("-") + 1)
|
||||
'对比前置 Mod 头部版本
|
||||
If ReqVersionHead.Contains(".") Then
|
||||
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
|
||||
@@ -1147,7 +1262,7 @@ VersionFindFail:
|
||||
Log(ex, "检查 Mod 时出错")
|
||||
End Try
|
||||
Next
|
||||
If Result.Count = 0 Then
|
||||
If Not Result.Any() Then
|
||||
Log("[Minecraft] Mod 检查未发现异常")
|
||||
Else
|
||||
Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
|
||||
|
||||
@@ -40,7 +40,7 @@ Public Module ModModpack
|
||||
For Each Entry In Archive.Entries
|
||||
Dim FullNames As String() = Entry.FullName.Split("/")
|
||||
ArchiveBaseFolder = FullNames(0) & "/"
|
||||
If Entry.FullName.EndsWith("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
|
||||
If Entry.FullName.EndsWithF("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
|
||||
'确定为一级目录下
|
||||
If FullNames.Count <> 2 Then Continue For
|
||||
'判断是否为关键文件
|
||||
@@ -61,7 +61,7 @@ Public Module ModModpack
|
||||
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
|
||||
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
ElseIf File.ToLower.EndsWith(".rar") Then
|
||||
ElseIf File.EndsWithF(".rar", True) Then
|
||||
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
Else
|
||||
@@ -186,7 +186,7 @@ Retry:
|
||||
Dim FabricVersion As String = Nothing
|
||||
For Each Entry In If(Json("minecraft")("modLoaders"), {})
|
||||
Dim Id As String = If(Entry("id"), "").ToString.ToLower
|
||||
If Id.StartsWith("forge-") Then
|
||||
If Id.StartsWithF("forge-") Then
|
||||
'Forge 指定
|
||||
If Id.Contains("recommended") Then
|
||||
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
|
||||
@@ -199,7 +199,7 @@ Retry:
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取整合包 Forge 版本失败:" & Id)
|
||||
End Try
|
||||
ElseIf Id.StartsWith("fabric-") Then
|
||||
ElseIf Id.StartsWithF("fabric-") Then
|
||||
'Fabric 指定
|
||||
Try
|
||||
Log("[ModPack] 整合包 Fabric 版本:" & Id)
|
||||
@@ -244,16 +244,17 @@ Retry:
|
||||
ModList.Add(ModEntry("fileID"))
|
||||
If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID"))
|
||||
Next
|
||||
If ModList.Count > 0 Then
|
||||
If ModList.Any Then
|
||||
Dim ModDownloadLoaders As New List(Of LoaderBase)
|
||||
'获取 Mod 下载信息
|
||||
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
|
||||
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of Integer, JArray))
|
||||
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
|
||||
'如果文件已被删除,则 API 会跳过那一项
|
||||
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
|
||||
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
|
||||
'构造 NetFile
|
||||
InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
|
||||
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
|
||||
Dim FileList As New Dictionary(Of Integer, NetFile)
|
||||
For Each ModJson In Task.Input
|
||||
@@ -277,7 +278,7 @@ Retry:
|
||||
IsResourcePack =
|
||||
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
|
||||
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
|
||||
(Not File.FileName.EndsWith(".jar")) '文件后缀不是 .jar
|
||||
(Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar
|
||||
Else
|
||||
IsResourcePack = False
|
||||
End If
|
||||
@@ -288,7 +289,10 @@ Retry:
|
||||
Task.Output = FileList.Values.ToList
|
||||
End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
|
||||
'下载 Mod 文件
|
||||
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
ModDownloadLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
'构造加载器
|
||||
InstallLoaders.Add(New LoaderCombo(Of Integer)("下载 Mod(主加载器)", ModDownloadLoaders) With
|
||||
{.Show = False, .ProgressWeight = ModDownloadLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
End If
|
||||
|
||||
'构造加载器
|
||||
@@ -299,43 +303,35 @@ Retry:
|
||||
.ForgeVersion = ForgeVersion,
|
||||
.FabricVersion = FabricVersion
|
||||
}
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
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)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
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 VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
|
||||
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
|
||||
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
|
||||
Log("[ModPack] 已设置整合包 Logo:" & Logo)
|
||||
End If
|
||||
'删除原始整合包文件
|
||||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||||
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
|
||||
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
|
||||
File.Delete(Target)
|
||||
End If
|
||||
Next
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
Sub(Task As LoaderTask(Of String, String))
|
||||
'设置图标
|
||||
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
|
||||
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
|
||||
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
|
||||
Log("[ModPack] 已设置整合包 Logo:" & Logo)
|
||||
End If
|
||||
'删除原始整合包文件
|
||||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||||
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
|
||||
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
|
||||
File.Delete(Target)
|
||||
End If
|
||||
Next
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
|
||||
@@ -438,10 +434,10 @@ Retry:
|
||||
End If
|
||||
'添加下载文件
|
||||
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
|
||||
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
|
||||
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString)))
|
||||
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
|
||||
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
|
||||
Next
|
||||
If FileList.Count > 0 Then
|
||||
If FileList.Any Then
|
||||
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
End If
|
||||
|
||||
@@ -453,43 +449,35 @@ Retry:
|
||||
.ForgeVersion = ForgeVersion,
|
||||
.FabricVersion = FabricVersion
|
||||
}
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
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)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
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 VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
|
||||
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
|
||||
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
|
||||
Log("[ModPack] 已设置整合包 Logo:" & Logo)
|
||||
End If
|
||||
'删除原始整合包文件
|
||||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||||
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
|
||||
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
|
||||
File.Delete(Target)
|
||||
End If
|
||||
Next
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
Sub(Task As LoaderTask(Of String, String))
|
||||
'设置图标
|
||||
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
|
||||
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
|
||||
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
|
||||
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
|
||||
Log("[ModPack] 已设置整合包 Logo:" & Logo)
|
||||
End If
|
||||
'删除原始整合包文件
|
||||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||||
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
|
||||
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
|
||||
File.Delete(Target)
|
||||
End If
|
||||
Next
|
||||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
|
||||
@@ -554,16 +542,8 @@ Retry:
|
||||
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
|
||||
.MinecraftName = Json("gameVersion").ToString
|
||||
}
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
|
||||
@@ -584,8 +564,8 @@ Retry:
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase) From {
|
||||
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime},
|
||||
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime},
|
||||
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)},
|
||||
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
|
||||
New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
|
||||
}
|
||||
|
||||
@@ -704,24 +684,16 @@ Retry:
|
||||
End Select
|
||||
Next
|
||||
'构造加载器
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
|
||||
|
||||
'重复任务检查
|
||||
@@ -802,24 +774,16 @@ Retry:
|
||||
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
|
||||
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
|
||||
}
|
||||
Dim InstallExpectTime As Double = 0
|
||||
For Each InstallLoader In InstallLoaders
|
||||
InstallExpectTime += InstallLoader.ProgressWeight
|
||||
Next
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
Dim MergeExpectTime As Double = 0
|
||||
For Each MergeLoader In MergeLoaders
|
||||
MergeExpectTime += MergeLoader.ProgressWeight
|
||||
Next
|
||||
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
|
||||
'构造总加载器
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
|
||||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
|
||||
|
||||
'重复任务检查
|
||||
|
||||
@@ -96,7 +96,7 @@
|
||||
'设置窗口标题
|
||||
For i = 1 To 3
|
||||
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
|
||||
Dim RealTitle As String = WindowTitle.Replace("{time}", Date.Now.ToShortTimeString)
|
||||
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
|
||||
SetWindowText(WindowHandle, RealTitle.ToCharArray)
|
||||
End If
|
||||
Thread.Sleep(64)
|
||||
@@ -143,7 +143,7 @@
|
||||
'输出文本
|
||||
Dim Copyed As New List(Of String)
|
||||
SyncLock WaitingLogLock
|
||||
If WaitingLog.Count = 0 Then Exit Sub
|
||||
If Not WaitingLog.Any() Then Exit Sub
|
||||
Copyed = WaitingLog
|
||||
WaitingLog = New List(Of String)(1000)
|
||||
End SyncLock
|
||||
@@ -192,7 +192,7 @@
|
||||
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
|
||||
WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+
|
||||
LogProgress = 2
|
||||
ElseIf LogProgress < 3 AndAlso Text.ToLower.Contains("lwjgl version") Then
|
||||
ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
|
||||
WatcherLog("日志 3/5:LWJGL 版本已确认")
|
||||
LogProgress = 3
|
||||
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
|
||||
@@ -269,24 +269,25 @@
|
||||
If MinecraftWindow Is Nothing Then Exit Sub
|
||||
Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
|
||||
'已找到窗口
|
||||
If Not MinecraftWindowName.StartsWith("FML") Then
|
||||
If Not MinecraftWindowName.StartsWithF("FML") Then
|
||||
'已找到 Minecraft 窗口
|
||||
WindowHandle = MinecraftWindowHandle
|
||||
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
|
||||
IsWindowFinished = True
|
||||
'最大化
|
||||
If Setup.Get("LaunchArgumentWindowType") = 4 Then
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
|
||||
'……虽然我很想这样说,但总有人反馈,算了
|
||||
Thread.Sleep(2000)
|
||||
ShowWindow(WindowHandle, 3)
|
||||
WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
|
||||
Catch ex As Exception
|
||||
Log(ex, "最大化 Minecraft 窗口时出现错误")
|
||||
End Try
|
||||
End Sub, "MinecraftWindowMaximize")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
|
||||
'……虽然我很想这样说,但总有人反馈,算了
|
||||
Thread.Sleep(2000)
|
||||
ShowWindow(WindowHandle, 3)
|
||||
WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
|
||||
Catch ex As Exception
|
||||
Log(ex, "最大化 Minecraft 窗口时出现错误")
|
||||
End Try
|
||||
End Sub, "MinecraftWindowMaximize")
|
||||
End If
|
||||
ElseIf Not IsWindowAppeared Then
|
||||
'已找到 FML 窗口
|
||||
@@ -317,7 +318,7 @@
|
||||
Dim WindowText As String = str.ToString
|
||||
'有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确
|
||||
'部分版本会搞个 GLFW message window 出来所以得反选
|
||||
If Not (WindowText.StartsWith("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWith("GLFW")) Then Exit Sub
|
||||
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Exit Sub
|
||||
'获取窗口关联的进程
|
||||
Dim ProcessId As Integer
|
||||
GetWindowThreadProcessId(hwnd, ProcessId)
|
||||
|
||||
@@ -14,11 +14,11 @@
|
||||
_Logo = value
|
||||
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
|
||||
Try
|
||||
If _Logo.ToLower.StartsWith("http") Then
|
||||
If _Logo.StartsWithF("http", True) Then
|
||||
'网络图片
|
||||
If File.Exists(FileAddress) Then
|
||||
PathLogo.Source = New MyBitmap(FileAddress)
|
||||
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
|
||||
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
|
||||
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
|
||||
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
|
||||
Else
|
||||
@@ -57,7 +57,7 @@ RetryStart:
|
||||
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd)
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
|
||||
@@ -1,8 +1,9 @@
|
||||
<Grid x:Class="MyLocalModItem"
|
||||
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
|
||||
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
|
||||
x:Name="PanBack" Height="44"
|
||||
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
|
||||
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
|
||||
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
|
||||
xmlns:local="clr-namespace:PCL;assembly="
|
||||
x:Name="PanBack" Height="44"
|
||||
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition Width="6" />
|
||||
<ColumnDefinition Width="34" />
|
||||
@@ -19,7 +20,7 @@
|
||||
</Grid.RowDefinitions>
|
||||
<!-- Logo -->
|
||||
<Border Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True"
|
||||
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
|
||||
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
|
||||
<Border.Clip>
|
||||
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
|
||||
</Border.Clip>
|
||||
@@ -27,10 +28,26 @@
|
||||
</Border>
|
||||
<!-- 标题 -->
|
||||
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
|
||||
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" />
|
||||
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
SnapsToDevicePixels="False" UseLayoutRounding="False">
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
|
||||
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
|
||||
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
<!-- 更新按钮 -->
|
||||
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
|
||||
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
|
||||
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
|
||||
</StackPanel>
|
||||
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition Width="Auto" />
|
||||
<ColumnDefinition Width="1*" />
|
||||
<ColumnDefinition Width="Auto" />
|
||||
</Grid.ColumnDefinitions>
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
|
||||
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
|
||||
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
<local:MyIconTextButton Grid.Column="2" Text="更新" />
|
||||
</Grid>-->
|
||||
<!-- Tag 与 详情 -->
|
||||
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
|
||||
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
|
||||
|
||||
@@ -16,11 +16,11 @@ Public Class MyLocalModItem
|
||||
_Logo = value
|
||||
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
|
||||
Try
|
||||
If _Logo.ToLower.StartsWith("http") Then
|
||||
If _Logo.StartsWithF("http", True) Then
|
||||
'网络图片
|
||||
If File.Exists(FileAddress) Then
|
||||
PathLogo.Source = New MyBitmap(FileAddress)
|
||||
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
|
||||
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
|
||||
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
|
||||
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
|
||||
Else
|
||||
@@ -59,7 +59,7 @@ RetryStart:
|
||||
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd)
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
@@ -190,6 +190,39 @@ RetryStart:
|
||||
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
|
||||
End Sub
|
||||
|
||||
'滑动选中
|
||||
Private Shared SwipeStart As Integer, SwipeEnd As Integer
|
||||
Private Shared Swiping As Boolean = False
|
||||
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
|
||||
Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown
|
||||
'开始滑动
|
||||
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
|
||||
SwipeStart = Index
|
||||
SwipeEnd = Index
|
||||
Swiping = True
|
||||
SwipToState = Not Checked
|
||||
FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏
|
||||
End Sub
|
||||
Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp
|
||||
'结束滑动
|
||||
If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then
|
||||
Swiping = False
|
||||
FrmVersionMod.CardSelect.IsHitTestVisible = True
|
||||
Exit Sub
|
||||
End If
|
||||
'计算滑动范围
|
||||
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
|
||||
SwipeStart = Math.Min(SwipeStart, Index)
|
||||
SwipeEnd = Math.Max(SwipeEnd, Index)
|
||||
'勾选所有范围中的项
|
||||
If SwipeStart = SwipeEnd Then Exit Sub
|
||||
For i = SwipeStart To SwipeEnd
|
||||
Dim Item As MyLocalModItem = CType(Parent, StackPanel).Children(i)
|
||||
Item.InitLate(Item, e)
|
||||
Item.Checked = SwipToState
|
||||
Next
|
||||
End Sub
|
||||
|
||||
'勾选状态
|
||||
Public Event Check(sender As Object, e As RouteEventArgs)
|
||||
Public Event Changed(sender As Object, e As RouteEventArgs)
|
||||
@@ -201,10 +234,10 @@ RetryStart:
|
||||
Set(value As Boolean)
|
||||
Try
|
||||
'触发属性值修改
|
||||
Dim ChangedEventArgs As New RouteEventArgs(False)
|
||||
Dim RawValue = _Checked
|
||||
If value = _Checked Then Exit Property
|
||||
_Checked = value
|
||||
Dim ChangedEventArgs As New RouteEventArgs(False)
|
||||
If IsInitialized Then
|
||||
RaiseEvent Changed(Me, ChangedEventArgs)
|
||||
If ChangedEventArgs.Handled Then
|
||||
@@ -310,7 +343,7 @@ RetryStart:
|
||||
Children.Remove(ButtonStack)
|
||||
ButtonStack = Nothing
|
||||
End If
|
||||
If value.Count = 0 Then Exit Property
|
||||
If Not value.Any() Then Exit Property
|
||||
'添加新 Stack
|
||||
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal,
|
||||
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
|
||||
@@ -347,6 +380,30 @@ RetryStart:
|
||||
Public Sub Refresh()
|
||||
RunInUi(
|
||||
Sub()
|
||||
'更新
|
||||
If Entry.CanUpdate Then
|
||||
BtnUpdate.Visibility = Visibility.Visible
|
||||
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
|
||||
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
|
||||
'简化名称对比
|
||||
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
|
||||
Dim NewestSegs = NewestName.Split("-"c).ToList()
|
||||
Dim Shortened As Boolean = False
|
||||
For Each Seg In CurrentSegs.ToList()
|
||||
If Not NewestSegs.Contains(Seg) Then Continue For
|
||||
CurrentSegs.Remove(Seg)
|
||||
NewestSegs.Remove(Seg)
|
||||
Shortened = True
|
||||
Next
|
||||
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
|
||||
CurrentName = Join(CurrentSegs, "-")
|
||||
NewestName = Join(NewestSegs, "-")
|
||||
Entry._Version = CurrentName '使用网络信息作为显示的版本号
|
||||
End If
|
||||
BtnUpdate.ToolTip = $"当前版本:{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本:{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新,右键查看更新日志。"
|
||||
Else
|
||||
BtnUpdate.Visibility = Visibility.Collapsed
|
||||
End If
|
||||
'标题
|
||||
If Entry.Comp Is Nothing Then
|
||||
Title = Entry.Name
|
||||
@@ -390,9 +447,9 @@ RetryStart:
|
||||
Else
|
||||
If ImgState Is Nothing Then
|
||||
ImgState = New Image With {
|
||||
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
|
||||
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
|
||||
}
|
||||
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
|
||||
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
|
||||
}
|
||||
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
|
||||
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
|
||||
Children.Add(ImgState)
|
||||
@@ -409,11 +466,7 @@ RetryStart:
|
||||
End Sub
|
||||
|
||||
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
|
||||
'按钮虚拟化检测
|
||||
If ButtonHandler IsNot Nothing Then
|
||||
ButtonHandler(sender, e)
|
||||
ButtonHandler = Nothing
|
||||
End If
|
||||
InitLate(sender, e)
|
||||
'触发颜色动画
|
||||
Dim Time As Integer = If(IsMouseOver, 120, 180)
|
||||
Dim Ani As New List(Of AniData)
|
||||
@@ -422,19 +475,19 @@ RetryStart:
|
||||
If IsMouseOver Then
|
||||
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
|
||||
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
|
||||
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
|
||||
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
|
||||
Else
|
||||
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
|
||||
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
|
||||
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
|
||||
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
|
||||
End If
|
||||
End If
|
||||
'RectBack
|
||||
If IsMouseOver OrElse Checked Then
|
||||
Ani.AddRange({
|
||||
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
|
||||
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
|
||||
})
|
||||
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
|
||||
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
|
||||
})
|
||||
If IsMouseDown Then
|
||||
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
|
||||
Else
|
||||
@@ -442,12 +495,42 @@ RetryStart:
|
||||
End If
|
||||
Else
|
||||
Ani.AddRange({
|
||||
AaOpacity(RectBack, -RectBack.Opacity, Time),
|
||||
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
|
||||
AaScaleTransform(RectBack, -0.196, 1,,, True)
|
||||
})
|
||||
AaOpacity(RectBack, -RectBack.Opacity, Time),
|
||||
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
|
||||
AaScaleTransform(RectBack, -0.196, 1,,, True)
|
||||
})
|
||||
End If
|
||||
AniStart(Ani, "LocalModItem Color " & Uuid)
|
||||
End Sub
|
||||
|
||||
'触发虚拟化内容
|
||||
Private Sub InitLate(sender As Object, e As EventArgs)
|
||||
If ButtonHandler IsNot Nothing Then
|
||||
ButtonHandler(sender, e)
|
||||
ButtonHandler = Nothing
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'显示更新日志
|
||||
Private Sub ShowUpdateLog(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
|
||||
e.Handled = True
|
||||
Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com"))
|
||||
Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com"))
|
||||
If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then
|
||||
OpenWebsite(Entry.ChangelogUrls.First)
|
||||
Else
|
||||
Select Case MyMsgBox("要在哪个网站上查看更新日志?", "查看更新日志", "Modrinth", "CurseForge", "取消")
|
||||
Case 1
|
||||
OpenWebsite(ModrinthUrl)
|
||||
Case 2
|
||||
OpenWebsite(CurseForgeUrl)
|
||||
End Select
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'触发更新
|
||||
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
|
||||
FrmVersionMod.UpdateMods({Entry})
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
@@ -13,7 +13,7 @@
|
||||
|
||||
Case "打开网页"
|
||||
Data(0) = Data(0).Replace("\", "/")
|
||||
If Not Data(0).Contains("://") OrElse Data(0).ToLower.StartsWith("file") Then '为了支持更多协议(#2200)
|
||||
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
|
||||
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -78,7 +78,7 @@
|
||||
|
||||
Case "下载文件"
|
||||
Data(0) = Data(0).Replace("\", "/")
|
||||
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
|
||||
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
|
||||
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -99,7 +99,7 @@
|
||||
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
|
||||
|
||||
'网页确认
|
||||
If RelativeUrl.ToLower.StartsWith("http") Then
|
||||
If RelativeUrl.StartsWithF("http", True) Then
|
||||
If RunInUi() Then
|
||||
Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf &
|
||||
"因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
|
||||
@@ -108,7 +108,7 @@
|
||||
Dim RawFileName As String
|
||||
Try
|
||||
RawFileName = GetFileNameFromPath(RelativeUrl)
|
||||
If Not RawFileName.ToLower.EndsWith(".json") Then Throw New Exception("未指向 .json 后缀的文件")
|
||||
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
|
||||
Catch ex As Exception
|
||||
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
|
||||
"例如:" & vbCrLf &
|
||||
|
||||
@@ -1,4 +1,6 @@
|
||||
Public Module ModMusic
|
||||
Imports System.Security.Cryptography
|
||||
|
||||
Public Module ModMusic
|
||||
|
||||
#Region "播放列表"
|
||||
|
||||
@@ -25,13 +27,13 @@
|
||||
For Each File In EnumerateFiles(Path & "PCL\Musics\")
|
||||
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
|
||||
Dim Ext As String = File.Extension.ToLower
|
||||
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(Ext) Then Continue For
|
||||
If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For
|
||||
MusicAllList.Add(File.FullName)
|
||||
Next
|
||||
End If
|
||||
'打乱顺序播放
|
||||
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
|
||||
If Not IgnoreFirst = "" AndAlso Not MusicWaitingList.Count = 0 AndAlso MusicWaitingList(0) = IgnoreFirst Then
|
||||
If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then
|
||||
'若需要避免成为第一项的为第一项,则将它放在最后
|
||||
MusicWaitingList.RemoveAt(0)
|
||||
MusicWaitingList.Add(IgnoreFirst)
|
||||
@@ -45,11 +47,11 @@
|
||||
''' </summary>
|
||||
Private Function DequeueNextMusicAddress() As String
|
||||
'初始化,确保存在音乐
|
||||
If MusicAllList Is Nothing OrElse MusicAllList.Count = 0 OrElse MusicWaitingList.Count = 0 Then MusicListInit(False)
|
||||
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
|
||||
'出列下一个音乐,如果出列结束则生成新列表
|
||||
DequeueNextMusicAddress = MusicWaitingList(0)
|
||||
MusicWaitingList.RemoveAt(0)
|
||||
If MusicWaitingList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
|
||||
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
@@ -63,7 +65,7 @@
|
||||
RunInUi(Sub()
|
||||
Try
|
||||
|
||||
If MusicAllList.Count = 0 Then
|
||||
If Not MusicAllList.Any() Then
|
||||
'无背景音乐
|
||||
FrmMain.BtnExtraMusic.Show = False
|
||||
Else
|
||||
@@ -160,7 +162,7 @@
|
||||
Try
|
||||
|
||||
MusicListInit(True)
|
||||
If MusicAllList.Count = 0 Then
|
||||
If Not MusicAllList.Any() Then
|
||||
If MusicNAudio Is Nothing Then
|
||||
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical)
|
||||
Else
|
||||
@@ -264,12 +266,16 @@
|
||||
Thread.Sleep(100)
|
||||
End While
|
||||
'当前音乐已播放结束,继续下一曲
|
||||
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
|
||||
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
|
||||
Catch ex As Exception
|
||||
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent)
|
||||
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
|
||||
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
|
||||
Thread.Sleep(1000000000)
|
||||
End If
|
||||
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
|
||||
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
|
||||
ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then
|
||||
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then
|
||||
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
|
||||
Else
|
||||
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
|
||||
|
||||
@@ -8,11 +8,11 @@ Imports System.Runtime.InteropServices
|
||||
|
||||
'查看程序集特性的值
|
||||
|
||||
<Assembly: AssemblyTitle("Plain Craft Launcher 2 启动器")>
|
||||
<Assembly: AssemblyTitle("Plain Craft Launcher 启动器")>
|
||||
<Assembly: AssemblyDescription("Minecraft 启动器 (制作:龙腾猫跃)")>
|
||||
<Assembly: AssemblyCompany("")>
|
||||
<Assembly: AssemblyProduct("Plain Craft Launcher 2")>
|
||||
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016-2024. All Rights Reserved.")>
|
||||
<Assembly: AssemblyProduct("Plain Craft Launcher")>
|
||||
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016. All Rights Reserved.")>
|
||||
<Assembly: AssemblyConfiguration("PCL2 Config Mark")>
|
||||
<Assembly: ComVisible(False)>
|
||||
|
||||
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
|
||||
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
|
||||
' 方法是按如下所示使用“*”
|
||||
|
||||
<Assembly: AssemblyVersion("2.6.13.0")>
|
||||
<Assembly: AssemblyFileVersion("2.6.13.0")>
|
||||
<Assembly: AssemblyVersion("2.7.2.0")>
|
||||
<Assembly: AssemblyFileVersion("2.7.2.0")>
|
||||
<Assembly: NeutralResourcesLanguage("")>
|
||||
File diff suppressed because it is too large.
Load diff
@@ -39,7 +39,7 @@
|
||||
Version("id") = "20w14∞"
|
||||
Version("type") = "special"
|
||||
Version.Add("lore", GetMcFoolName(Version("id")))
|
||||
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
|
||||
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
|
||||
Type = "愚人节版"
|
||||
Version("type") = "special"
|
||||
Version.Add("lore", GetMcFoolName(Version("id")))
|
||||
@@ -77,7 +77,7 @@
|
||||
PanMain.Children.Add(CardInfo)
|
||||
'添加其他版本
|
||||
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
|
||||
If Pair.Value.Count = 0 Then Continue For
|
||||
If Not Pair.Value.Any() Then Continue For
|
||||
'增加卡片
|
||||
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
|
||||
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
|
||||
|
||||
@@ -16,7 +16,6 @@
|
||||
<StackPanel Orientation="Horizontal" Height="35">
|
||||
<local:MyButton x:Name="BtnIntroWeb" MinWidth="140" Text="转到 CurseForge" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
|
||||
<local:MyButton x:Name="BtnIntroWiki" MinWidth="140" Text="转到 MC 百科" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
|
||||
<local:MyButton x:Name="BtnIntroMCBBS" MinWidth="140" Text="转到 MCBBS" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
|
||||
<local:MyButton x:Name="BtnIntroCopy" MinWidth="140" Text="复制名称" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
|
||||
</StackPanel>
|
||||
</StackPanel>
|
||||
|
||||
@@ -88,7 +88,7 @@
|
||||
PanMain.Children.Clear()
|
||||
'转化为 UI
|
||||
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
|
||||
If Pair.Value.Count = 0 Then Continue For
|
||||
If Not Pair.Value.Any() Then Continue For
|
||||
'增加卡片
|
||||
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.Type = CompType.ModPack, 9, 8)} 'FUTURE: Res
|
||||
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
|
||||
@@ -145,7 +145,6 @@
|
||||
'决定按钮显示
|
||||
BtnIntroWeb.Text = If(Project.FromCurseForge, "转到 CurseForge", "转到 Modrinth")
|
||||
BtnIntroWiki.Visibility = If(Project.WikiId = 0, Visibility.Collapsed, Visibility.Visible)
|
||||
BtnIntroMCBBS.Visibility = If(Project.MCBBS = 0, Visibility.Collapsed, Visibility.Visible)
|
||||
|
||||
AniControlEnabled -= 1
|
||||
End Sub
|
||||
@@ -211,10 +210,10 @@
|
||||
If Project.Type = CompType.Mod Then
|
||||
'获取 Mod 所需的加载器种类
|
||||
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
|
||||
If File.ModLoaders.Count > 0 Then '从文件中获取
|
||||
If File.ModLoaders.Any Then '从文件中获取
|
||||
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
|
||||
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
|
||||
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
|
||||
ElseIf Project.ModLoaders.Any Then '从工程中获取
|
||||
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
|
||||
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
|
||||
End If
|
||||
@@ -253,7 +252,7 @@
|
||||
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
|
||||
If Not SuitableVersions.Any() Then
|
||||
DefaultFolder = PathMcFolder
|
||||
If NeedLoad Then
|
||||
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!")
|
||||
@@ -323,9 +322,6 @@
|
||||
Private Sub BtnIntroWiki_Click(sender As Object, e As EventArgs) Handles BtnIntroWiki.Click
|
||||
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")
|
||||
End Sub
|
||||
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
|
||||
ClipboardSet(CompItem.LabTitle.Text)
|
||||
End Sub
|
||||
|
||||
@@ -20,7 +20,6 @@
|
||||
<StackPanel Margin="25,37,25,15">
|
||||
<local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" />
|
||||
<local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" />
|
||||
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabricOld" IsWarn="False" />
|
||||
<Grid Margin="0,0,0,11">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition Width="1*" />
|
||||
|
||||
@@ -32,7 +32,7 @@
|
||||
#Region "页面切换"
|
||||
|
||||
'页面切换动画
|
||||
Private IsInSelectPage As Boolean = False
|
||||
Public IsInSelectPage As Boolean = False
|
||||
Private IsFirstLoaded As Boolean = False
|
||||
Private Sub EnterSelectPage()
|
||||
If IsInSelectPage Then Exit Sub
|
||||
@@ -273,11 +273,13 @@
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private IsReloading As Boolean = False '#3742 中,LoadOptiFineGetError 会初始化 LoadOptiFine,触发事件 LoadOptiFine.StateChanged,导致再次调用 SelectReload
|
||||
''' <summary>
|
||||
''' 重载已选择的项目的显示。
|
||||
''' </summary>
|
||||
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
|
||||
If SelectedMinecraftId Is Nothing Then Exit Sub
|
||||
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
|
||||
IsReloading = True
|
||||
'主预览
|
||||
SelectNameUpdate()
|
||||
ItemSelect.Title = TextSelectName.Text
|
||||
@@ -385,17 +387,12 @@
|
||||
'主警告
|
||||
HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed)
|
||||
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
|
||||
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then
|
||||
HintOptiFabric.Visibility = Visibility.Collapsed
|
||||
HintOptiFabricOld.Visibility = Visibility.Visible
|
||||
Else
|
||||
HintOptiFabric.Visibility = Visibility.Visible
|
||||
HintOptiFabricOld.Visibility = Visibility.Collapsed
|
||||
End If
|
||||
HintOptiFabric.Visibility = Visibility.Visible
|
||||
Else
|
||||
HintOptiFabric.Visibility = Visibility.Collapsed
|
||||
HintOptiFabricOld.Visibility = Visibility.Collapsed
|
||||
End If
|
||||
'结束
|
||||
IsReloading = False
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 清空已选择的项目。
|
||||
@@ -523,7 +520,7 @@
|
||||
Version("id") = "20w14∞"
|
||||
Version("type") = "special"
|
||||
Version.Add("lore", GetMcFoolName(Version("id")))
|
||||
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
|
||||
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
|
||||
Type = "愚人节版"
|
||||
Version("type") = "special"
|
||||
Version.Add("lore", GetMcFoolName(Version("id")))
|
||||
@@ -562,7 +559,7 @@
|
||||
PanMinecraft.Children.Insert(0, CardInfo)
|
||||
'添加其他版本
|
||||
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
|
||||
If Pair.Value.Count = 0 Then Continue For
|
||||
If Not Pair.Value.Any() Then Continue For
|
||||
'增加卡片
|
||||
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 7}
|
||||
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
|
||||
@@ -656,7 +653,7 @@
|
||||
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
|
||||
If Not Versions.Any() Then Exit Sub
|
||||
'排序
|
||||
Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
|
||||
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
|
||||
@@ -724,7 +721,7 @@
|
||||
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
|
||||
If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version)
|
||||
Next
|
||||
If Versions.Count = 0 Then Exit Sub
|
||||
If Not Versions.Any() Then Exit Sub
|
||||
'可视化
|
||||
PanLiteLoader.Children.Clear()
|
||||
For Each Version In Versions
|
||||
@@ -804,7 +801,7 @@
|
||||
'获取要显示的版本
|
||||
Dim Versions As New List(Of DlForgeVersionEntry)
|
||||
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
|
||||
If Loader.Output.Count = 0 Then Exit Sub
|
||||
If Not Loader.Output.Any() Then Exit Sub
|
||||
PanForge.Children.Clear()
|
||||
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
|
||||
Where(Function(v)
|
||||
@@ -870,7 +867,7 @@
|
||||
If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub
|
||||
'获取版本列表
|
||||
Dim Versions As JArray = DlFabricListLoader.Output.Value("loader")
|
||||
If Versions.Count = 0 Then Exit Sub
|
||||
If Not Versions.Any() Then Exit Sub
|
||||
'可视化
|
||||
PanFabric.Children.Clear()
|
||||
PanFabric.Tag = Versions
|
||||
@@ -983,7 +980,7 @@
|
||||
Versions.Add(Version)
|
||||
End If
|
||||
Next
|
||||
If Versions.Count = 0 Then Exit Sub
|
||||
If Not Versions.Any() Then Exit Sub
|
||||
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
|
||||
'可视化
|
||||
PanFabricApi.Children.Clear()
|
||||
@@ -1037,7 +1034,6 @@
|
||||
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
|
||||
''' </summary>
|
||||
Private Function LoadOptiFabricGetError() As String
|
||||
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
|
||||
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
|
||||
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
|
||||
If DlOptiFabricLoader.Output Is Nothing Then
|
||||
@@ -1073,7 +1069,7 @@
|
||||
For Each Version In DlOptiFabricLoader.Output
|
||||
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
|
||||
Next
|
||||
If Versions.Count = 0 Then Exit Sub
|
||||
If Not Versions.Any() Then Exit Sub
|
||||
'排序
|
||||
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
|
||||
'可视化
|
||||
|
||||
@@ -28,7 +28,7 @@
|
||||
PanMain.Children.Clear()
|
||||
'转化为 UI
|
||||
For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict
|
||||
If Pair.Value.Count = 0 Then Continue For
|
||||
If Not Pair.Value.Any() Then Continue For
|
||||
'增加卡片
|
||||
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 10}
|
||||
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
|
||||
|
||||
@@ -33,22 +33,19 @@
|
||||
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
|
||||
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
|
||||
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
|
||||
<local:MyComboBoxItem Content="1.20.6" />
|
||||
<local:MyComboBoxItem Content="1.20.4" />
|
||||
<local:MyComboBoxItem Content="1.20.3" />
|
||||
<local:MyComboBoxItem Content="1.20.2" />
|
||||
<local:MyComboBoxItem Content="1.20.1" />
|
||||
<local:MyComboBoxItem Content="1.20" />
|
||||
<local:MyComboBoxItem Content="1.19.4" />
|
||||
<local:MyComboBoxItem Content="1.19.2" />
|
||||
<local:MyComboBoxItem Content="1.18.2" />
|
||||
<local:MyComboBoxItem Content="1.17.1" />
|
||||
<local:MyComboBoxItem Content="1.16.5" />
|
||||
<local:MyComboBoxItem Content="1.15.2" />
|
||||
<local:MyComboBoxItem Content="1.14.4" />
|
||||
<local:MyComboBoxItem Content="1.13.2" />
|
||||
<local:MyComboBoxItem Content="1.12.2" />
|
||||
<local:MyComboBoxItem Content="1.11.2" />
|
||||
<local:MyComboBoxItem Content="1.10.2" />
|
||||
<local:MyComboBoxItem Content="1.9.4" />
|
||||
<local:MyComboBoxItem Content="1.8.9" />
|
||||
<local:MyComboBoxItem Content="1.7.10" />
|
||||
</local:MyComboBox>
|
||||
|
||||
@@ -32,7 +32,7 @@
|
||||
PanMain.Children.Clear()
|
||||
'转化为 UI
|
||||
For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict
|
||||
If Pair.Value.Count = 0 Then Continue For
|
||||
If Not Pair.Value.Any() Then Continue For
|
||||
'增加卡片
|
||||
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 3}
|
||||
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
|
||||
|
||||
@@ -32,22 +32,19 @@
|
||||
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
|
||||
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
|
||||
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
|
||||
<local:MyComboBoxItem Content="1.20.6" />
|
||||
<local:MyComboBoxItem Content="1.20.4" />
|
||||
<local:MyComboBoxItem Content="1.20.3" />
|
||||
<local:MyComboBoxItem Content="1.20.2" />
|
||||
<local:MyComboBoxItem Content="1.20.1" />
|
||||
<local:MyComboBoxItem Content="1.20" />
|
||||
<local:MyComboBoxItem Content="1.19.4" />
|
||||
<local:MyComboBoxItem Content="1.19.2" />
|
||||
<local:MyComboBoxItem Content="1.18.2" />
|
||||
<local:MyComboBoxItem Content="1.17.1" />
|
||||
<local:MyComboBoxItem Content="1.16.5" />
|
||||
<local:MyComboBoxItem Content="1.15.2" />
|
||||
<local:MyComboBoxItem Content="1.14.4" />
|
||||
<local:MyComboBoxItem Content="1.13.2" />
|
||||
<local:MyComboBoxItem Content="1.12.2" />
|
||||
<local:MyComboBoxItem Content="1.11.2" />
|
||||
<local:MyComboBoxItem Content="1.10.2" />
|
||||
<local:MyComboBoxItem Content="1.9.4" />
|
||||
<local:MyComboBoxItem Content="1.8.9" />
|
||||
<local:MyComboBoxItem Content="1.7.10" />
|
||||
</local:MyComboBox>
|
||||
|
||||
@@ -33,7 +33,7 @@
|
||||
<Path Name="PathTypeOne" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="{DynamicResource ColorBrush3}" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center"
|
||||
Data="">
|
||||
<Path.RenderTransform>
|
||||
<ScaleTransform ScaleX="1.2" ScaleY="1.2" />
|
||||
<ScaleTransform ScaleX="1.05" ScaleY="1.05" />
|
||||
</Path.RenderTransform>
|
||||
</Path>
|
||||
<TextBlock Name="LabTypeOne" Text="" FontSize="14" VerticalAlignment="Center" Grid.Column="1" Foreground="{DynamicResource ColorBrush3}" Margin="15,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
|
||||
|
||||
@@ -19,51 +19,53 @@
|
||||
RefreshButtonsUI()
|
||||
|
||||
'加载版本
|
||||
RunInNewThread(Sub()
|
||||
'确认 Minecraft 文件夹存在
|
||||
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
|
||||
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
|
||||
'无效的文件夹
|
||||
If PathMcFolder = "" Then
|
||||
Log("[Launch] 没有已储存的 Minecraft 文件夹")
|
||||
Else
|
||||
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & PathMcFolder, LogLevel.Debug)
|
||||
End If
|
||||
McFolderListLoader.WaitForExit(IsForceRestart:=True)
|
||||
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
|
||||
End If
|
||||
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
|
||||
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
|
||||
'确认 Minecraft 版本存在
|
||||
Dim Selection As String = Setup.Get("LaunchVersionSelect")
|
||||
Dim Version As McVersion
|
||||
If Selection = "" Then
|
||||
Version = Nothing
|
||||
Else
|
||||
Version = New McVersion(Selection)
|
||||
End If
|
||||
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
|
||||
'无效的版本
|
||||
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
|
||||
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
|
||||
If McVersionList.Count = 0 OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
|
||||
Version = Nothing
|
||||
Setup.Set("LaunchVersionSelect", "")
|
||||
Log("[Launch] 无可用 Minecraft 版本")
|
||||
Else
|
||||
Version = McVersionList.First.Value(0)
|
||||
Setup.Set("LaunchVersionSelect", Version.Name)
|
||||
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path)
|
||||
End If
|
||||
End If
|
||||
RunInUi(Sub()
|
||||
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
|
||||
IsLoadFinished = True
|
||||
RefreshButtonsUI()
|
||||
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
|
||||
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
|
||||
End Sub)
|
||||
End Sub, "Version Check", ThreadPriority.AboveNormal)
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
'确认 Minecraft 文件夹存在
|
||||
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
|
||||
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
|
||||
'无效的文件夹
|
||||
If PathMcFolder = "" Then
|
||||
Log("[Launch] 没有已储存的 Minecraft 文件夹")
|
||||
Else
|
||||
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & PathMcFolder, LogLevel.Debug)
|
||||
End If
|
||||
McFolderListLoader.WaitForExit(IsForceRestart:=True)
|
||||
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
|
||||
End If
|
||||
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
|
||||
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
|
||||
'确认 Minecraft 版本存在
|
||||
Dim Selection As String = Setup.Get("LaunchVersionSelect")
|
||||
Dim Version As McVersion
|
||||
If Selection = "" Then
|
||||
Version = Nothing
|
||||
Else
|
||||
Version = New McVersion(Selection)
|
||||
End If
|
||||
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
|
||||
'无效的版本
|
||||
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
|
||||
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
|
||||
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
|
||||
Version = Nothing
|
||||
Setup.Set("LaunchVersionSelect", "")
|
||||
Log("[Launch] 无可用 Minecraft 版本")
|
||||
Else
|
||||
Version = McVersionList.First.Value(0)
|
||||
Setup.Set("LaunchVersionSelect", Version.Name)
|
||||
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path)
|
||||
End If
|
||||
End If
|
||||
RunInUi(
|
||||
Sub()
|
||||
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
|
||||
IsLoadFinished = True
|
||||
RefreshButtonsUI()
|
||||
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
|
||||
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
|
||||
End Sub)
|
||||
End Sub, "Version Check", ThreadPriority.AboveNormal)
|
||||
|
||||
'改变页面
|
||||
Dim LoginType As McLoginType = Setup.Get("LoginType")
|
||||
@@ -286,7 +288,7 @@ UnknownType:
|
||||
Setup.Set("LoginType", McLoginType.Ms)
|
||||
PanType.Visibility = Visibility.Collapsed
|
||||
PanTypeOne.Visibility = Visibility.Visible
|
||||
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonMs)
|
||||
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonShield)
|
||||
LabTypeOne.Text = "正版登录"
|
||||
RadioLoginType5.Visibility = Visibility.Visible
|
||||
RadioLoginType0.Visibility = Visibility.Collapsed
|
||||
@@ -295,7 +297,7 @@ UnknownType:
|
||||
Setup.Set("LoginType", McLoginType.Legacy)
|
||||
PanType.Visibility = Visibility.Collapsed
|
||||
PanTypeOne.Visibility = Visibility.Visible
|
||||
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonUser)
|
||||
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline)
|
||||
LabTypeOne.Text = "离线登录"
|
||||
Case 3 '统一通行证
|
||||
If Setup.Get("CacheNideAccess") = "" Then
|
||||
|
||||
@@ -67,7 +67,7 @@ Download:
|
||||
End If
|
||||
Case 3
|
||||
Select Case Setup.Get("UiCustomPreset")
|
||||
Case 0 '你知道吗
|
||||
Case 0
|
||||
Log("[Page] 主页预设:你知道吗")
|
||||
Content = "
|
||||
<local:MyCard Title=""你知道吗?"" Margin=""0,0,0,15"">
|
||||
@@ -76,7 +76,7 @@ Download:
|
||||
EventType=""刷新主页"" EventData=""/""
|
||||
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
|
||||
</local:MyCard>"
|
||||
Case 1 '回声洞
|
||||
Case 1
|
||||
Log("[Page] 主页预设:回声洞")
|
||||
Content = "
|
||||
<local:MyCard Title=""回声洞"" Margin=""0,0,0,15"">
|
||||
@@ -85,17 +85,17 @@ Download:
|
||||
EventType=""刷新主页"" EventData=""/""
|
||||
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
|
||||
</local:MyCard>"
|
||||
Case 2 '新闻
|
||||
Case 2
|
||||
Log("[Page] 主页预设:Minecraft 新闻")
|
||||
Url = "http://pcl.mcnews.thestack.top"
|
||||
GoTo Download
|
||||
Case 3 '简单主页
|
||||
Case 3
|
||||
Log("[Page] 主页预设:简单主页")
|
||||
Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
|
||||
GoTo Download
|
||||
Case 4 '历史上的今天
|
||||
Log("[Page] 主页预设:历史上的今天")
|
||||
Url = "https://pclnews.52chye.cn/custom.xaml"
|
||||
Case 4
|
||||
Log("[Page] 主页预设:每日整合包推荐")
|
||||
Url = "https://pclsub.sodamc.com/"
|
||||
GoTo Download
|
||||
End Select
|
||||
End Select
|
||||
|
||||
@@ -85,50 +85,51 @@
|
||||
Hint("正在更改皮肤……")
|
||||
IsChanging = True
|
||||
'开始实际获取
|
||||
RunInNewThread(Async Sub()
|
||||
Try
|
||||
RunInNewThread(
|
||||
Async Sub()
|
||||
Try
|
||||
Retry:
|
||||
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
|
||||
Dim AccessToken As String = Setup.Get("CacheMsAccess")
|
||||
Dim Uuid As String = Setup.Get("CacheMsUuid")
|
||||
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
|
||||
Dim AccessToken As String = Setup.Get("CacheMsAccess")
|
||||
Dim Uuid As String = Setup.Get("CacheMsUuid")
|
||||
|
||||
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
|
||||
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
|
||||
Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*"))
|
||||
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
|
||||
Dim Contents As New Net.Http.MultipartFormDataContent From {
|
||||
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
|
||||
{New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
|
||||
}
|
||||
Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync
|
||||
If Result.Contains("request requires user authentication") Then
|
||||
Hint("正在登录,将在登录完成后继续更改皮肤……")
|
||||
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
|
||||
GoTo Retry
|
||||
ElseIf Result.Contains("""error""") Then
|
||||
Hint("更改皮肤失败:" & GetJson(Result)("error"), HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
'获取新皮肤地址
|
||||
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
For Each Skin As JObject In ResultJson("skins")
|
||||
If Skin("state").ToString = "ACTIVE" Then
|
||||
MySkin.ReloadCache(Skin("url"))
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
Throw New Exception("未知错误(" & Result & ")")
|
||||
Catch ex As Exception
|
||||
If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then
|
||||
Hint("更改皮肤失败:与 Mojang 皮肤服务器的连接超时,请检查你的网络是否通畅!", HintType.Critical)
|
||||
Else
|
||||
Log(ex, "更改皮肤失败", LogLevel.Hint)
|
||||
End If
|
||||
Finally
|
||||
IsChanging = False
|
||||
End Try
|
||||
End Sub, "Ms Skin Upload")
|
||||
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
|
||||
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
|
||||
Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*"))
|
||||
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
|
||||
Dim Contents As New Net.Http.MultipartFormDataContent From {
|
||||
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
|
||||
{New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
|
||||
}
|
||||
Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync
|
||||
If Result.Contains("request requires user authentication") Then
|
||||
Hint("正在登录,将在登录完成后继续更改皮肤……")
|
||||
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
|
||||
GoTo Retry
|
||||
ElseIf Result.Contains("""error""") Then
|
||||
Hint("更改皮肤失败:" & GetJson(Result)("error"), HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
'获取新皮肤地址
|
||||
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
For Each Skin As JObject In ResultJson("skins")
|
||||
If Skin("state").ToString = "ACTIVE" Then
|
||||
MySkin.ReloadCache(Skin("url"))
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
Throw New Exception("未知错误(" & Result & ")")
|
||||
Catch ex As Exception
|
||||
If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then
|
||||
Hint("更改皮肤失败:与 Mojang 皮肤服务器的连接超时,请检查你的网络是否通畅!", HintType.Critical)
|
||||
Else
|
||||
Log(ex, "更改皮肤失败", LogLevel.Hint)
|
||||
End If
|
||||
Finally
|
||||
IsChanging = False
|
||||
End Try
|
||||
End Sub, "Ms Skin Upload")
|
||||
End Sub
|
||||
|
||||
'保存皮肤
|
||||
|
||||
@@ -58,307 +58,21 @@
|
||||
|
||||
'检查网络状态
|
||||
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("PCL 的联机服务由速聚授权提供。" & 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("$PCL 没法连上网……" & vbCrLf & "如果你改变了网络环境,请重启 PCL。")
|
||||
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 GetExceptionSummary(ex).Contains("(404)") Then
|
||||
Throw New CertOutdatedException '索引码无效或已过期
|
||||
ElseIf GetExceptionSummary(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 = GetFileSHA1(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 = GetFileSHA1(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 = GetFileSHA1(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)
|
||||
|
||||
@@ -389,40 +103,6 @@ FinishMcbFileCheck:
|
||||
''' </summary>
|
||||
Public Shared Function HiperStop(SleepWhenKilled As Boolean) As Boolean
|
||||
Return False
|
||||
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。
|
||||
@@ -430,125 +110,10 @@ FinishMcbFileCheck:
|
||||
''' 若程序正在运行,则会先停止其运行。
|
||||
''' </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 ""PCL 联机房间"""
|
||||
}
|
||||
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
|
||||
|
||||
@@ -643,42 +208,6 @@ FinishMcbFileCheck:
|
||||
'每 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
|
||||
@@ -711,14 +240,6 @@ FinishMcbFileCheck:
|
||||
|
||||
'创建房间
|
||||
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)
|
||||
'记录信息
|
||||
@@ -730,34 +251,6 @@ FinishMcbFileCheck:
|
||||
|
||||
'加入房间
|
||||
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("你的 PCL 版本与房主的 PCL 版本不一致!", HintType.Critical) : Exit Sub
|
||||
' Hint("你输入的联机码无效!", HintType.Critical)
|
||||
End Sub
|
||||
Private Sub RoomJoin(Ip As String, Port As Integer)
|
||||
'记录信息
|
||||
@@ -773,54 +266,6 @@ FinishMcbFileCheck:
|
||||
|
||||
'承接状态切换的 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 & "失败:" & GetExceptionSummary(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)
|
||||
@@ -888,10 +333,6 @@ FinishMcbFileCheck:
|
||||
|
||||
'复制联机码
|
||||
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 房主
|
||||
|
||||
@@ -1,204 +1,10 @@
|
||||
Imports System.Net
|
||||
Imports System.Net.Sockets
|
||||
Imports System.Net.Sockets
|
||||
|
||||
Public Class PageLinkIoi
|
||||
Public Const RequestVersion As Integer = 4
|
||||
Public Const IoiVersion As Integer = 10 '由于已关闭更新渠道,在提升 IoiVersion 时必须提升 RequestVersion
|
||||
Public Shared PathIoi As String = PathAppdata & "联机模块\IOI 联机模块.exe"
|
||||
|
||||
#Region "初始化"
|
||||
|
||||
'页面初始化
|
||||
Private IsLoad As Boolean = False
|
||||
Private Sub MeLoaded() Handles Me.Loaded
|
||||
FormMain.EndProgramForce(Result.Aborted)
|
||||
|
||||
'重复加载部分
|
||||
PanBack.ScrollToHome()
|
||||
RefreshUi()
|
||||
|
||||
'非重复加载部分
|
||||
If IsLoad Then Exit Sub
|
||||
IsLoad = True
|
||||
|
||||
'更新线程
|
||||
RunInNewThread(Sub()
|
||||
Do While True
|
||||
Thread.Sleep(200)
|
||||
If FrmMain.PageCurrent.Page = FormMain.PageType.Link AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.LinkIoi Then RunInUiWait(Sub() FrmLinkIoi.RefreshUi())
|
||||
RefreshWorker()
|
||||
Loop
|
||||
End Sub, "Link Timer")
|
||||
|
||||
End Sub
|
||||
|
||||
'加载器初始化与左边栏处理
|
||||
Private Sub LoaderInit() Handles Me.Initialized
|
||||
PageLoaderInit(Load, PanLoad, PanBack, PanAlways, InitLoader, Sub()
|
||||
End Sub)
|
||||
End Sub
|
||||
|
||||
'初始化加载器与步骤
|
||||
Public Shared WithEvents InitLoader As New LoaderCombo(Of Integer)("联机模块初始化", {
|
||||
New LoaderTask(Of Integer, Integer)("端口检查", AddressOf InitPortCheck) With {.ProgressWeight = 1},
|
||||
New LoaderTask(Of Integer, Integer)("启动请求核心", AddressOf StartSocketListener) With {.ProgressWeight = 1},
|
||||
New LoaderTask(Of Integer, List(Of NetFile))("初次启动尝试", AddressOf InitFirst) With {.ProgressWeight = 4},
|
||||
New LoaderDownload("下载更新文件", New List(Of NetFile)) With {.ProgressWeight = 6},
|
||||
New LoaderTask(Of List(Of NetFile), Boolean)("二次启动尝试", AddressOf InitSecond) With {.ProgressWeight = 3},
|
||||
New LoaderTask(Of Boolean, Boolean)("创建请求核心房间", AddressOf InitRequest) With {.ProgressWeight = 2}
|
||||
})
|
||||
'判断端口是否被占用
|
||||
Private Shared Sub InitPortCheck()
|
||||
'检查协议
|
||||
If Not Setup.Get("LinkEula") Then
|
||||
Reopen:
|
||||
Select Case MyMsgBox("PCL 的联机服务由速聚授权提供。" & 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
|
||||
'先掐死
|
||||
IoiStop(True)
|
||||
'检查端口
|
||||
Dim HasConflict As Boolean = False
|
||||
For Each Port In Net.NetworkInformation.IPGlobalProperties.GetIPGlobalProperties().GetActiveTcpListeners()
|
||||
If Port.Port <> 55555 AndAlso Port.Port <> 55557 Then Continue For
|
||||
Log("[IOI] 发现端口 " & Port.Port & " 被占用")
|
||||
HasConflict = True
|
||||
Next
|
||||
If Not HasConflict Then Exit Sub
|
||||
'对应的报错
|
||||
For Each Line As String In ShellAndGetOutput("netstat", "-ano", 30000).Split({vbCrLf}, StringSplitOptions.RemoveEmptyEntries)
|
||||
If Not (Line.Contains("127.0.0.1:55555") OrElse Line.Contains("127.0.0.1:55557")) Then Continue For
|
||||
Dim ProcessName As String
|
||||
Try
|
||||
ProcessName = Process.GetProcessById(Line.Split(" ").Last).ProcessName
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取占用端口的进程信息失败,假定进程已结束")
|
||||
Continue For
|
||||
End Try
|
||||
If ProcessName = "联机模块" Then
|
||||
Throw New Exception("由于一个已知问题,请在重启电脑后再尝试使用联机功能")
|
||||
ElseIf ProcessName = "Idle" Then
|
||||
'不知道为啥反正又没占用了
|
||||
Log("[IOI] 未发现占用此端口的程序,继续执行")
|
||||
Else
|
||||
Throw New Exception("端口被程序 " & ProcessName & " 占用,无法启动联机模块,请在任务管理器关闭此程序后再试")
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
'下载更新前尝试启动
|
||||
Private Shared Sub InitFirst(Task As LoaderTask(Of Integer, List(Of NetFile)))
|
||||
'初次启动尝试
|
||||
If IoiVersion <> Setup.Get("LinkIoiVersion") Then
|
||||
Log("[IOI] 设置版本强制要求联机模块更新")
|
||||
Setup.Set("LinkIoiVersion", IoiVersion)
|
||||
ElseIf File.Exists(PathIoi) Then
|
||||
Task.Progress = 0.2
|
||||
CheckFirewall()
|
||||
If IoiStart() Then
|
||||
'已完成启动与初始化
|
||||
Task.Output = New List(Of NetFile)
|
||||
Exit Sub
|
||||
Else
|
||||
'需要更新
|
||||
IoiStop(True)
|
||||
File.Delete(PathIoi)
|
||||
GoTo StartDownload
|
||||
End If
|
||||
'如果抛出异常则直接使加载器失败
|
||||
End If
|
||||
'开始下载
|
||||
StartDownload:
|
||||
Task.Progress = 0.8
|
||||
Log("[IOI] 需要下载联机模块")
|
||||
If File.Exists(PathTemp & "联机模块.zip") Then File.Delete(PathTemp & "联机模块.zip")
|
||||
Task.Output = New List(Of NetFile) From {New NetFile(
|
||||
{"https://gitcode.net/to/cato_bin/-/raw/master/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip",
|
||||
"http://mirror.hiper.cn.s2.the.bb/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip",
|
||||
"http://mirror.hiper.cn.s3.the.bb:175/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip",
|
||||
"https://pcl2-server-1253424809.file.myqcloud.com/link/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip{CDN}"},
|
||||
PathTemp & "联机模块.zip")}
|
||||
End Sub
|
||||
'下载更新后尝试启动
|
||||
Private Shared Sub InitSecond(Task As LoaderTask(Of List(Of NetFile), Boolean))
|
||||
'若首次尝试已经成功,则直接跳过
|
||||
If IoiState = LoadState.Finished Then Exit Sub
|
||||
'解压更新包
|
||||
Log("[IOI] 解压联机模块以完成下载")
|
||||
If File.Exists(PathTemp & "ioi.exe") Then File.Delete(PathTemp & "ioi.exe")
|
||||
If File.Exists(PathIoi) Then File.Delete(PathIoi)
|
||||
ExtractFile(PathTemp & "联机模块.zip", PathTemp)
|
||||
File.Delete(PathTemp & "联机模块.zip")
|
||||
CopyFile(PathTemp & "ioi.exe", PathIoi)
|
||||
File.Delete(PathTemp & "ioi.exe")
|
||||
Task.Progress = 0.4
|
||||
'再次尝试启动
|
||||
CheckFirewall()
|
||||
If IoiStart() Then Exit Sub
|
||||
IoiStop(True)
|
||||
Throw New Exception("联机模块初始化失败")
|
||||
End Sub
|
||||
'在 IOI 启动后建立 55557 房间
|
||||
Private Shared Sub InitRequest()
|
||||
Try
|
||||
Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/port?proto=tcp&port=55557" & "&password=" & IoiPassword, "PUT", "", "", 100000))
|
||||
If Result("msg") IsNot Nothing Then Throw New InvalidOperationException(Result("msg").ToString)
|
||||
Catch ex As InvalidOperationException
|
||||
'API 返回的错误
|
||||
Log("创建请求核心房间失败:" & ex.Message, LogLevel.Msgbox)
|
||||
Catch ex As Exception
|
||||
'常规错误
|
||||
Log(ex, "创建请求核心房间失败", LogLevel.Msgbox)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'检查防火墙权限,并添加对应的权限
|
||||
Private Shared Sub CheckFirewall()
|
||||
Try
|
||||
Log("[IOI] Windows 防火墙:检测开始")
|
||||
If Not PageLinkLeft.FirewallIsBlock(PathIoi) Then Exit Try
|
||||
If PageLinkLeft.FirewallPolicy.CurrentProfile.ExceptionsNotAllowed Then
|
||||
'禁止白名单
|
||||
MyMsgBox("由于 Windows 防火墙阻止了所有传入连接,PCL 无法获取防火墙通行权限。" & vbCrLf &
|
||||
"联机会有很大概率失败,就算连上了,延迟也会变高……" & vbCrLf & vbCrLf &
|
||||
"请先关闭 Windows 防火墙中的 " & vbLQ & "阻止所有传入连接" & vbRQ & " 选项,然后重启 PCL。", "遭到防火墙拦截")
|
||||
ElseIf IsAdmin() Then
|
||||
'有管理员权限
|
||||
Log("[IOI] Windows 防火墙:尝试添加防火墙通行权限")
|
||||
Try
|
||||
PageLinkLeft.FirewallAddAuthorized("Plain Craft Launcher 启动器(IOI 联机模块)", PathIoi)
|
||||
Catch ex As Exception
|
||||
Log(ex, "无法将联机模块添加至防火墙白名单,可能导致联机失败", LogLevel.Msgbox)
|
||||
End Try
|
||||
Else
|
||||
'无管理员权限
|
||||
If MyMsgBox("由于你开启了 Windows 防火墙,PCL 需要获取防火墙通行权限。" & vbCrLf & vbCrLf &
|
||||
"若继续,PCL 将尝试以管理员权限重新启动。" & vbCrLf &
|
||||
"若拒绝,联机模块可能会被防火墙拦截,联机会有很大概率失败。", "需要管理员权限", "继续", "拒绝") = 1 Then
|
||||
Log("[IOI] Windows 防火墙:尝试提升权限")
|
||||
If RunAsAdmin("--link ioi") Then
|
||||
FrmMain.EndProgram(False) '已重新运行
|
||||
Else
|
||||
Hint("获取管理员权限失败,请尝试右键 PCL,选择 " & vbLQ & "以管理员身份运行" & vbRQ & ",然后再进入联机页面!", HintType.Critical)
|
||||
End If
|
||||
Else
|
||||
Hint("在没有防火墙权限的情况下尝试联机,很可能会导致联机失败!", HintType.Critical)
|
||||
End If
|
||||
End If
|
||||
Log("[IOI] Windows 防火墙:无防火墙通行权限")
|
||||
Catch ex As Exception
|
||||
Log(ex, "无法检测防火墙状态,可能导致联机失败", LogLevel.Msgbox)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "进程管理"
|
||||
|
||||
Private Shared IoiId As String, IoiPassword As String
|
||||
@@ -209,38 +15,7 @@ StartDownload:
|
||||
''' 若 Ioi 正在运行,则结束 Ioi 进程,同时初始化状态数据。返回是否关闭了对应进程。
|
||||
''' </summary>
|
||||
Public Shared Function IoiStop(SleepWhenKilled As Boolean) As Boolean
|
||||
IoiStop = False
|
||||
'发送断开信息
|
||||
Try
|
||||
If IoiProcess IsNot Nothing AndAlso Not IoiProcess.HasExited Then
|
||||
For i = 0 To UserList.Count - 1
|
||||
If i > UserList.Count - 1 Then Exit For
|
||||
Dim User = UserList.Values(i)
|
||||
SendDisconnectRequest(User)
|
||||
Next
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "结束 IOI 进程时发送 Disconnect 信息失败")
|
||||
End Try
|
||||
'关闭所有 Ioi 进程
|
||||
For Each ProcessObject In Process.GetProcesses
|
||||
If ProcessObject.ProcessName <> "IOI 联机模块" Then Continue For
|
||||
IoiStop = True
|
||||
Try
|
||||
ProcessObject.Kill()
|
||||
Log("[IOI] 已关闭联机模块:" & ProcessObject.Id)
|
||||
If SleepWhenKilled Then Thread.Sleep(3000) '等待 3 秒确认进程已退出
|
||||
Catch ex As Exception
|
||||
Log(ex, "关闭联机模块失败(" & ProcessObject.Id & ")")
|
||||
End Try
|
||||
Next
|
||||
'初始化
|
||||
IoiProcess = Nothing
|
||||
IoiId = Nothing
|
||||
IoiPassword = Nothing
|
||||
IoiState = LoadState.Waiting
|
||||
UserList = New Dictionary(Of String, LinkUserIoi)
|
||||
RoomListForMe = New List(Of RoomEntry)
|
||||
Return False
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 启动 Ioi,并等待初始化完成后退出运行,同时更新 IoiId 与 IoiPassword。
|
||||
@@ -248,130 +23,11 @@ StartDownload:
|
||||
''' 若 Ioi 正在运行,则会先停止其运行。
|
||||
''' </summary>
|
||||
Public Shared Function IoiStart() As Boolean
|
||||
IoiStop(True)
|
||||
Log("[IOI] 启动联机模块进程")
|
||||
Dim Info = New ProcessStartInfo With {
|
||||
.FileName = PathIoi,
|
||||
.UseShellExecute = False,
|
||||
.CreateNoWindow = True,
|
||||
.RedirectStandardError = True,
|
||||
.RedirectStandardOutput = True,
|
||||
.WorkingDirectory = PathTemp
|
||||
}
|
||||
IoiProcess = New Process() With {.StartInfo = Info}
|
||||
Using outputWaitHandle As New AutoResetEvent(False)
|
||||
Using errorWaitHandle As New AutoResetEvent(False)
|
||||
AddHandler IoiProcess.OutputDataReceived, Function(sender, e)
|
||||
Try
|
||||
If e.Data Is Nothing Then
|
||||
outputWaitHandle.[Set]()
|
||||
Else
|
||||
IoiLogLine(e.Data)
|
||||
End If
|
||||
Catch ex As ObjectDisposedException
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取联机模块信息失败")
|
||||
IoiState = LoadState.Failed
|
||||
End Try
|
||||
Return Nothing
|
||||
End Function
|
||||
AddHandler IoiProcess.ErrorDataReceived, Function(sender, e)
|
||||
Try
|
||||
If e.Data Is Nothing Then
|
||||
errorWaitHandle.[Set]()
|
||||
Else
|
||||
IoiLogLine(e.Data)
|
||||
End If
|
||||
Catch ex As ObjectDisposedException
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取联机模块错误信息失败")
|
||||
IoiState = LoadState.Failed
|
||||
End Try
|
||||
Return Nothing
|
||||
End Function
|
||||
IoiProcess.Start()
|
||||
IoiState = LoadState.Loading
|
||||
IoiProcess.BeginOutputReadLine()
|
||||
IoiProcess.BeginErrorReadLine()
|
||||
'等待
|
||||
Do Until IoiProcess.HasExited OrElse IoiState <> LoadState.Loading
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
'输出
|
||||
If IoiState = LoadState.Finished Then
|
||||
Log("[IOI] 联机模块启动成功")
|
||||
Return True
|
||||
Else
|
||||
Throw New Exception("联机模块启动失败")
|
||||
End If
|
||||
'Select Case IoiState
|
||||
' Case LoadState.Finished
|
||||
' Log("[IOI] 联机模块启动成功")
|
||||
' Return True
|
||||
' Case LoadState.Aborted
|
||||
' Log("[IOI] 联机模块要求更新")
|
||||
' Return False
|
||||
' Case LoadState.Failed
|
||||
' Log("[IOI] 联机模块启动出现异常")
|
||||
' Return False
|
||||
' Case Else 'LoadState.Loading
|
||||
' Throw New Exception("联机模块启动失败,请检查你的网络连接")
|
||||
'End Select
|
||||
End Using
|
||||
End Using
|
||||
Return False
|
||||
End Function
|
||||
|
||||
'Ioi 日志
|
||||
Private Shared Sub IoiLogLine(Content As String)
|
||||
|
||||
'初始化
|
||||
If Content.Contains(" > http://127.0.0.1:55555/") Then Exit Sub
|
||||
If Content.Contains("All done") Then
|
||||
If IoiId IsNot Nothing AndAlso IoiPassword IsNot Nothing Then
|
||||
IoiState = LoadState.Finished
|
||||
Else
|
||||
Log("[IOI] 联机模块汇报初始化完成,但未提供账户信息")
|
||||
IoiState = LoadState.Failed
|
||||
End If
|
||||
Exit Sub
|
||||
End If
|
||||
If Content.Contains("Password :: ") Then
|
||||
IoiPassword = Content.Split({"Password :: "}, StringSplitOptions.None)(1)
|
||||
Exit Sub '为保证安全不记录密码到 Log
|
||||
End If
|
||||
|
||||
'初始化
|
||||
If Content.Contains("ID :: ") Then IoiId = Content.Split({"ID :: "}, StringSplitOptions.None)(1)
|
||||
If Content.Contains("Initialization failed") OrElse Content.Contains("The version is ") Then IoiState = LoadState.Aborted
|
||||
|
||||
'系统回应
|
||||
If Content.Contains("'portssub' from ") Then LastPortsId = Content.Split(" ").Last
|
||||
If Content.Contains("Listening tcp ") Then
|
||||
If UserList.ContainsKey(LastPortsId) Then
|
||||
UserList(LastPortsId).Ports(Content.Split(" ").Last) = RegexSeek(Content, "(?<=Listening tcp )[^:]+")
|
||||
Else
|
||||
Log("[IOI] 未在列表中的用户出现意料外的连接信息")
|
||||
NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & LastPortsId & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
End If
|
||||
End If
|
||||
|
||||
'断开连接
|
||||
If Content.Contains("Closed tcp connection from ") AndAlso Content.Contains(":55557") Then
|
||||
For i = 0 To UserList.Count - 1
|
||||
Dim User = UserList.Values(i)
|
||||
If Not Content.Contains(User.Ports(55557)) OrElse User.IsDisposed Then Continue For
|
||||
Log("[IOI] 检测到 55557 端口断开(" & User.DisplayName & ")")
|
||||
UserRemove(User, True)
|
||||
Exit For
|
||||
Next
|
||||
End If
|
||||
|
||||
'写入日志
|
||||
If Not Content.Contains("read /dev/stdin: The handle is invalid.") AndAlso LogLinesCount < If(ModeDebug, 10000, 1000) Then
|
||||
LogLinesCount += 1
|
||||
Log("[IOI] " & Content)
|
||||
End If
|
||||
|
||||
End Sub
|
||||
Private Shared LogLinesCount As Integer = 0
|
||||
Private Shared LastPortsId As String = "" '上一个收到 portssub 的 ID,用于记录端口
|
||||
@@ -384,94 +40,10 @@ StartDownload:
|
||||
Private Shared UserListIdentifyCache As String = ""
|
||||
Private Shared RoomListIdentifyCache As String = ""
|
||||
Public Sub RefreshUi()
|
||||
Try
|
||||
'确认用户列表缓存
|
||||
Dim UserListIdentify As String = Join(UserList, vbCrLf)
|
||||
If UserListIdentify <> UserListIdentifyCache Then
|
||||
UserListIdentifyCache = UserListIdentify
|
||||
'刷新列表项
|
||||
PanUserList.Children.Clear()
|
||||
For i = 0 To UserList.Count - 1
|
||||
If i > UserList.Count - 1 Then Exit For
|
||||
PanUserList.Children.Add(UserList.Values(i).ToListItem)
|
||||
Next
|
||||
'刷新列表标题
|
||||
CardUser.Title = "已连接的玩家 (" & PanUserList.Children.Count & ")"
|
||||
End If
|
||||
'刷新用户列表项
|
||||
For Each UserItem As MyListItem In PanUserList.Children
|
||||
CType(UserItem.Tag, LinkUserIoi).RefreshUi(UserItem)
|
||||
Next
|
||||
'确认房间列表缓存
|
||||
Dim RoomListIdentify As String = Join(GetRoomList(), vbCrLf)
|
||||
If RoomListIdentify <> RoomListIdentifyCache Then
|
||||
RoomListIdentifyCache = RoomListIdentify
|
||||
'刷新列表项
|
||||
PanRoom.Children.Clear()
|
||||
For Each Room In GetRoomList()
|
||||
PanRoom.Children.Add(Room.ToListItem)
|
||||
Next
|
||||
End If
|
||||
'刷新房间列表项
|
||||
For Each RoomItem As MyListItem In PanRoom.Children
|
||||
CType(RoomItem.Tag, RoomEntry).RefreshUi(RoomItem)
|
||||
Next
|
||||
'刷新操作提示
|
||||
If UserList.Count = 0 Then
|
||||
If RoomListForMe.Count = 0 Then
|
||||
LabHint.Text = "若想创建房间,请点击创建房间按钮,并按说明进行操作。" & vbCrLf & "若想加入他人的房间,请点击建立连接,然后输入对方的联机码。"
|
||||
Else
|
||||
LabHint.Text = "若想让其他人加入你的房间,请点击复制联机码,然后让你的朋友输入你的联机码以建立连接。"
|
||||
End If
|
||||
Else
|
||||
If GetRoomList.Count = 0 Then
|
||||
LabHint.Text = "若想创建房间,请点击创建房间按钮,然后输入对局域网开放后 MC 显示的端口号,或本地服务端的端口号。"
|
||||
ElseIf RoomListForMe.Count = 0 Then
|
||||
'已有连接,本人没有房间,对方有房间
|
||||
LabHint.Text = "若想加入某个房间,直接点击该房间即可获取说明。"
|
||||
Else
|
||||
'已有连接,且本人有房间
|
||||
LabHint.Text = "指向你所创建的房间,能在右侧找到修改房间名称、关闭房间等选项。" &
|
||||
If(RoomListForMe.Count <> GetRoomList.Count, vbCrLf & "若想加入其他人的房间,直接点击该房间即可获取说明。", "")
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "联机模块 UI 时钟运行失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'工作线程刷新
|
||||
Public Sub RefreshWorker()
|
||||
Try
|
||||
'检测退出
|
||||
If InitLoader.State = LoadState.Finished AndAlso IoiProcess.HasExited Then
|
||||
Log("[IOI] 联机模块出现异常!", LogLevel.Hint)
|
||||
ModuleStopManually()
|
||||
End If
|
||||
'检测用户
|
||||
For i = 0 To UserList.Values.Count - 1
|
||||
If i > UserList.Values.Count - 1 Then Exit For
|
||||
Dim User = UserList.Values(i)
|
||||
If User.Progress < 1 Then Continue For '跳过连接中的用户
|
||||
'发送心跳包
|
||||
If Date.Now - User.LastSend > New TimeSpan(0, 0, RandomInteger(50, 30)) Then
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
SendUpdateRequest(User, 1)
|
||||
Catch ex As Exception
|
||||
Log(ex, "心跳包发送失败(" & User.DisplayName & ")", LogLevel.Normal)
|
||||
End Try
|
||||
End Sub, "Link Heartbeat " & User.Id)
|
||||
End If
|
||||
'检测被动离线
|
||||
If Date.Now - User.LastReceive > New TimeSpan(0, 2, 0) Then
|
||||
SendDisconnectRequest(User)
|
||||
Hint("与 " & User.DisplayName & " 的连接已中断!", HintType.Critical)
|
||||
End If
|
||||
Next
|
||||
Catch ex As Exception
|
||||
Log(ex, "联机模块工作时钟运行失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
@@ -482,65 +54,6 @@ StartDownload:
|
||||
''' 发送 Portsub 请求并等待获取控制台端口。进度将从 0 变化至 80%。
|
||||
''' </summary>
|
||||
Private Shared Sub SendPortsubRequest(User As LinkUserIoi)
|
||||
Log("[IOI] 尝试建立连接:" & User.Id)
|
||||
'向对方发送 portsub 请求
|
||||
Dim Retry As Integer = 0
|
||||
RetryLink:
|
||||
Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "PUT", "", "", 100000))
|
||||
'失败与重试
|
||||
If Result("msg") IsNot Nothing Then
|
||||
Dim ErrorMessage As String = Result("msg").ToString
|
||||
Select Case ErrorMessage
|
||||
Case "failed to find any peer in table"
|
||||
Retry += 1
|
||||
ErrorMessage = "我方网络环境不佳,连接失败。" '初始化对等机列表超时
|
||||
Log("[IOI] 尝试建立连接结果:未找到对等机,第 " & Retry & " 级重试")
|
||||
Case "routing: not found"
|
||||
Retry += 4
|
||||
ErrorMessage = "我方或对方网络环境不佳,或对方已关闭联机模块,未找到路由。" '未知情况
|
||||
Log("[IOI] 尝试建立连接结果:无法连接到路由,第 " & Retry & " 级重试")
|
||||
Case "you are already connected to specified host"
|
||||
If User.IsDisposed Then Throw New ThreadInterruptedException("用户对象已被释放")
|
||||
Log("[IOI] 尝试建立连接结果:已与对方连接")
|
||||
GoTo Done
|
||||
'Retry += 1
|
||||
'NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 100000)
|
||||
'ErrorMessage = "已与对方连接。" '双向连接偶尔导致
|
||||
'Log("[IOI] 已与对方连接,尝试中断现有连接,第 " & Retry & " 级重试")
|
||||
Case "dial backoff"
|
||||
Retry += 20
|
||||
ErrorMessage = "对方网络环境不佳,或对方已关闭联机模块。请尝试让对方主动连接你,而不是你去连接对方。" 'NAT2 连 NAT4 导致
|
||||
Log("[IOI] 尝试建立连接结果:NAT 异常,第 " & Retry & " 级重试")
|
||||
Case Else
|
||||
If ErrorMessage.Contains("all dials failed") Then
|
||||
Retry += 8
|
||||
ErrorMessage = "我方或对方网络环境不佳,或对方已关闭联机模块,连接失败。" '网络不佳,或对方已关闭模块
|
||||
Log("[IOI] 尝试建立连接结果:连接失败,第 " & Retry & " 级重试")
|
||||
Else
|
||||
Retry += 8
|
||||
Log("[IOI] 尝试建立连接结果:未知错误(" & ErrorMessage & "),第 " & Retry & " 级重试")
|
||||
End If
|
||||
End Select
|
||||
If User.IsDisposed Then Throw New ThreadInterruptedException("用户对象已被释放")
|
||||
If Retry <= 64 Then
|
||||
User.Progress = Retry * 0.01 + 0.05
|
||||
Thread.Sleep(3000)
|
||||
GoTo RetryLink
|
||||
Else
|
||||
Throw New InvalidOperationException(ErrorMessage)
|
||||
End If
|
||||
End If
|
||||
Log("[IOI] 尝试建立连接结果:成功")
|
||||
'等待获取对方端口
|
||||
Done:
|
||||
Dim WaitCount As Integer = 0
|
||||
Do Until User.Ports.ContainsKey(55555) AndAlso User.Ports.ContainsKey(55557)
|
||||
WaitCount += 1
|
||||
User.Progress = 0.7 + WaitCount / 200 * 0.1 '70% ~ 80%
|
||||
If WaitCount = 100 Then Throw New Exception("连接超时,请尝试重新连接(未收到端口回报)!")
|
||||
Thread.Sleep(150)
|
||||
Loop
|
||||
User.Progress = 0.8
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
@@ -584,20 +97,6 @@ Done:
|
||||
''' 尝试发送断开请求,并将其从用户列表中移除。
|
||||
''' </summary>
|
||||
Private Shared Sub SendDisconnectRequest(User As LinkUserIoi, Optional Message As String = Nothing, Optional IsError As Boolean = False)
|
||||
Dim RawJson As New JObject()
|
||||
RawJson("id") = IoiId
|
||||
RawJson("type") = "disconnect"
|
||||
If Message IsNot Nothing Then
|
||||
RawJson("message") = Message
|
||||
RawJson("isError") = IsError
|
||||
End If
|
||||
Try
|
||||
User.Send(RawJson)
|
||||
Thread.Sleep(50)
|
||||
Catch
|
||||
End Try
|
||||
NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
User.Dispose()
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
@@ -606,29 +105,9 @@ Done:
|
||||
|
||||
'刷新连接
|
||||
Private Shared Sub BtnListRefresh_Click(sender As MyIconButton, e As EventArgs)
|
||||
Dim User As LinkUserIoi = sender.Tag
|
||||
User.PingRecord.Clear()
|
||||
FrmLinkIoi.RefreshUi()
|
||||
RunInThread(Sub()
|
||||
Try
|
||||
SendUpdateRequest(User, 1)
|
||||
Catch ex As Exception
|
||||
If InitLoader.State = LoadState.Finished Then Log(ex, "刷新与 " & User.DisplayName & " 的连接失败", LogLevel.Hint)
|
||||
End Try
|
||||
End Sub)
|
||||
End Sub
|
||||
'断开连接
|
||||
Private Shared Sub BtnListDisconnect_Click(sender As MyIconButton, e As EventArgs)
|
||||
Dim User As LinkUserIoi = sender.Tag
|
||||
sender.IsEnabled = False
|
||||
RunInThread(Sub()
|
||||
If User.Progress < 1 AndAlso User.RelativeThread IsNot Nothing AndAlso User.RelativeThread.IsAlive Then
|
||||
NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
User.Dispose()
|
||||
Else
|
||||
SendDisconnectRequest(User, GetPlayerName() & " 主动断开了连接!")
|
||||
End If
|
||||
End Sub)
|
||||
End Sub
|
||||
'复制联机码
|
||||
Public Shared Sub BtnLeftCopy_Click() Handles BtnLeftCopy.Click
|
||||
@@ -680,46 +159,10 @@ Done:
|
||||
|
||||
#Region "请求核心"
|
||||
|
||||
Private Shared Listener As Socket = Nothing
|
||||
''' <summary>
|
||||
''' 启动 Socket 监听核心。
|
||||
''' </summary>
|
||||
Public Shared Sub StartSocketListener()
|
||||
If Listener IsNot Nothing Then Exit Sub '已经启动过了
|
||||
Listener = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) With {.ReceiveTimeout = 1000000000, .SendTimeout = 1000000000}
|
||||
Listener.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReuseAddress, True)
|
||||
Try
|
||||
Listener.Bind(New IPEndPoint(IPAddress.Any, 55557))
|
||||
Catch ex As Exception
|
||||
Log(ex, "初次启动 Socket 监听核心失败,开始重试")
|
||||
Thread.Sleep(1000)
|
||||
Listener.Bind(New IPEndPoint(IPAddress.Any, 55557))
|
||||
End Try
|
||||
Listener.Listen(100)
|
||||
Log("[IOI] 已启动 Socket 监听核心")
|
||||
RunInNewThread(Sub()
|
||||
While True
|
||||
Try
|
||||
'获取新的 Socket
|
||||
Dim bytes(1024) As Byte
|
||||
Dim ClientSocket As Socket = Listener.Accept()
|
||||
'获取初始输入信息
|
||||
Dim RequestInput As String = Encoding.UTF8.GetString(bytes, 0, ClientSocket.Receive(bytes))
|
||||
If Not RequestInput.StartsWith("PCL - ") Then Exit Sub
|
||||
Dim RawData As String
|
||||
Try
|
||||
RawData = SecretDecrypt(WebUtility.UrlDecode(RequestInput.Substring(6)))
|
||||
Log("[IOI] 接收到新的 Socket:" & RawData)
|
||||
PageLinkIoi.ReceiveJson(GetJson(RawData), ClientSocket)
|
||||
Catch ex As Exception
|
||||
Log(ex, "新的 Socket 处理出错(内容:" & RequestInput & ")")
|
||||
End Try
|
||||
Catch ex As Exception
|
||||
Log(ex, "Socket 监听出错")
|
||||
Thread.Sleep(3000) '防止死循环出错
|
||||
End Try
|
||||
End While
|
||||
End Sub, "Socket Listener")
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
@@ -738,40 +181,9 @@ Done:
|
||||
'请求管理
|
||||
Public Socket As Socket = Nothing
|
||||
Public Sub Send(Request As JObject)
|
||||
If Socket Is Nothing Then Throw New Exception("该用户尚未绑定 Socket")
|
||||
Dim Data As String = Request.ToString(Newtonsoft.Json.Formatting.None)
|
||||
If ModeDebug Then Log("[IOI] 发送联机数据包(" & DisplayName & "):" & Data)
|
||||
Data = "PCL - " & WebUtility.UrlEncode(SecretEncrypt(Data))
|
||||
Me.LastSend = Date.Now
|
||||
Socket.Send(Encoding.UTF8.GetBytes(Data))
|
||||
End Sub
|
||||
Public ListenerThread As Thread = Nothing
|
||||
Public Sub StartListener()
|
||||
If ListenerThread IsNot Nothing Then Exit Sub
|
||||
'启动监听
|
||||
ListenerThread = RunInNewThread(Sub()
|
||||
Try
|
||||
Dim bytes(1024) As Byte
|
||||
While PageLinkIoi.UserList.ContainsValue(Me)
|
||||
Dim RequestInput As String = Encoding.UTF8.GetString(bytes, 0, Socket.Receive(bytes))
|
||||
If Not RequestInput.StartsWith("PCL - ") Then Exit Sub
|
||||
Dim RawData As String = SecretDecrypt(WebUtility.UrlDecode(RequestInput.Substring(6)))
|
||||
If ModeDebug Then Log("[IOI] 接收联机数据包(" & DisplayName & "):" & RawData)
|
||||
PageLinkIoi.ReceiveJson(GetJson(RawData)) '调用去实际的联机模块
|
||||
End While
|
||||
Catch ex As ThreadInterruptedException
|
||||
Log("[IOI] 用户监听已中断(" & DisplayName & ")")
|
||||
Catch ex As Exception
|
||||
If IsDisposed Then Exit Sub
|
||||
If ex.GetType.Equals(GetType(SocketException)) AndAlso CType(ex, SocketException).SocketErrorCode = 10053 Then
|
||||
Log("[IOI] 客户端已关闭(" & DisplayName & ")")
|
||||
PageLinkIoi.UserRemove(CType(Me, PageLinkIoi.LinkUserIoi), True)
|
||||
Exit Sub
|
||||
End If
|
||||
Log(ex, "用户监听出错(" & DisplayName & ")")
|
||||
PageLinkIoi.UserRemove(CType(Me, PageLinkIoi.LinkUserIoi), True)
|
||||
End Try
|
||||
End Sub, "Link Listener " & DisplayName)
|
||||
End Sub
|
||||
Public Sub BindSocket(Socket As Socket)
|
||||
If Me.Socket IsNot Nothing Then Throw New Exception("该用户已经绑定了 Socket")
|
||||
@@ -846,7 +258,7 @@ Done:
|
||||
Public Function GetDescription() As String
|
||||
Return If(Progress < 1,
|
||||
"正在连接," & Math.Round(Progress * 100) & "%",
|
||||
"已连接," & If(PingRecord.Count = 0, "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
|
||||
"已连接," & If(Not PingRecord.Any(), "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
|
||||
End Function
|
||||
Public Function ToListItem() As MyListItem
|
||||
Dim Item As New MyListItem With {
|
||||
@@ -975,135 +387,12 @@ Done:
|
||||
|
||||
'正向与反向连接
|
||||
Public Shared Sub BtnLeftCreate_Click() Handles BtnLeftCreate.Click
|
||||
''获取信息
|
||||
'Dim Code As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateLength(9, 99999)}, "", "输入对方的联机码", "确定", "取消")
|
||||
'If Code Is Nothing Then Exit Sub
|
||||
''检查
|
||||
'If Code.StartsWith("P") AndAlso Code.Length < 48 Then
|
||||
' Hint("你输入的可能是 HiPer 的联机码,请在左侧的联机方式中选择 HiPer!", HintType.Critical) : Exit Sub
|
||||
'End If
|
||||
'Dim Id As String, DisplayName As String
|
||||
'Try '解密失败检查
|
||||
' Id = "12D3" & Code.Substring(0, 48)
|
||||
' DisplayName = SecretDecrypt(Code.Substring(48))
|
||||
'Catch
|
||||
' Hint("你输入的联机码有误!", HintType.Critical)
|
||||
' Exit Sub
|
||||
'End Try
|
||||
'If Id = IoiId Then '自我连接检查
|
||||
' Hint("我连我自己?搁这卡 Bug 呢?", HintType.Critical)
|
||||
' Exit Sub
|
||||
'End If
|
||||
''开始
|
||||
'Dim User As New LinkUserIoi(Id, DisplayName)
|
||||
'User.RelativeThread = RunInNewThread(Sub()
|
||||
' Dim WaitCount As Integer = 0
|
||||
' Try
|
||||
' '加入列表
|
||||
' If UserList.ContainsKey(Id) Then
|
||||
' Hint(UserList(Id).DisplayName & " 已在列表中,无需再次连接!")
|
||||
' Exit Sub
|
||||
' Else
|
||||
' UserList.Add(Id, User)
|
||||
' End If
|
||||
' '发送 portsub 请求(0% -> 80%)
|
||||
' SendPortsubRequest(User)
|
||||
' '构建 Socket(81% -> 82%)
|
||||
' Dim ClientSocket As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) With {.ReceiveTimeout = 1000000000, .SendTimeout = 1000000000}
|
||||
' ClientSocket.Connect(New IPEndPoint(IPAddress.Parse(User.Ports(55557)), 55557))
|
||||
' User.BindSocket(ClientSocket)
|
||||
' User.Progress = 0.82
|
||||
' '发送 connect 请求(83% -> 85%)
|
||||
' SendConnectRequest(User)
|
||||
' User.Progress = 0.85
|
||||
' '等待对方向自己请求
|
||||
' Log("[IOI] 加入成功,等待反向请求")
|
||||
' Do While User.Progress < 0.9999
|
||||
' User.Progress += 0.0002
|
||||
' If User.Progress > 0.98 AndAlso User.Progress < 0.9999 Then Throw New Exception("对方未回应连接请求!")
|
||||
' Thread.Sleep(100)
|
||||
' Loop
|
||||
' Hint("已连接到 " & User.DisplayName & "!", HintType.Finish)
|
||||
' Catch ex As ThreadInterruptedException
|
||||
' Log("[IOI] 已中断主动发起的连接(" & User.DisplayName & ")")
|
||||
' Catch ex As InvalidOperationException
|
||||
' 'API 返回的错误
|
||||
' NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
' User.Dispose()
|
||||
' If InitLoader.State = LoadState.Finished Then Log("与 " & DisplayName & " 建立连接失败:" & ex.Message, LogLevel.Msgbox)
|
||||
' Catch ex As Exception
|
||||
' '常规错误
|
||||
' NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
' User.Dispose()
|
||||
' If ex.InnerException IsNot Nothing AndAlso TypeOf ex.InnerException Is ThreadInterruptedException Then Exit Sub
|
||||
' If InitLoader.State = LoadState.Finished Then Log(ex, "与 " & DisplayName & " 建立连接失败", LogLevel.Msgbox)
|
||||
' End Try
|
||||
' End Sub, "Link Create " & DisplayName)
|
||||
End Sub
|
||||
Private Shared Sub SendPortsubBack(User As LinkUserIoi, TargetVersion As Integer)
|
||||
Try
|
||||
SendPortsubRequest(User)
|
||||
User.Progress = 0.9
|
||||
If TargetVersion > RequestVersion Then
|
||||
SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & ":对方的 PCL 版本过低!", True)
|
||||
Throw New InvalidOperationException("你的 PCL 版本过低!")
|
||||
ElseIf TargetVersion < RequestVersion Then
|
||||
SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & ":你的 PCL 版本过低!", True)
|
||||
Throw New InvalidOperationException("对方的 PCL 版本过低!")
|
||||
Else
|
||||
SendUpdateRequest(User, 1)
|
||||
User.Progress = 1
|
||||
Hint(User.DisplayName & " 已与你建立连接!")
|
||||
End If
|
||||
Catch ex As ThreadInterruptedException
|
||||
Log("[IOI] 已中断被动建立的连接(" & User.DisplayName & ")")
|
||||
Catch ex As InvalidOperationException
|
||||
'API 返回的错误
|
||||
NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
User.Dispose()
|
||||
If InitLoader.State = LoadState.Finished Then Log("与 " & User.DisplayName & " 建立连接失败:" & ex.Message, LogLevel.Hint)
|
||||
Catch ex As Exception
|
||||
'常规错误
|
||||
NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
User.Dispose()
|
||||
If InitLoader.State = LoadState.Finished Then Log(ex, "与 " & User.DisplayName & " 建立连接失败", LogLevel.Hint)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'创建房间
|
||||
Private Sub LinkCreate() Handles BtnCreate.Click
|
||||
'If MyMsgBox("请先进入 MC 并暂停游戏,在暂停页面选择对局域网开放,然后在下一个窗口输入 MC 显示的端口号。" & vbCrLf & "若使用服务端开服,则直接在下一个窗口输入服务器配置中的端口号即可。", "提示", "继续", "取消") = 2 Then Exit Sub
|
||||
''获取端口号
|
||||
'Dim Port As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {
|
||||
' New ValidateInteger(0, 65535),
|
||||
' New ValidateExceptSame({"55555", "55557"}, "端口不能为 %!"),
|
||||
' New ValidateExceptSame(RoomListForMe.Select(AddressOf RoomEntry.SelectPort), "端口 % 已创建过房间,请在删除该房间后继续!")
|
||||
' }, "", "输入端口号", "确定", "取消")
|
||||
'If Port Is Nothing Then Exit Sub
|
||||
''获取显示名称
|
||||
'Dim DisplayName As String = MyMsgBoxInput(GetPlayerName() & " 的房间 - " & Port, New ObjectModel.Collection(Of Validate) From {
|
||||
' New ValidateNullOrWhiteSpace(), New ValidateLength(1, 40), New ValidateFilter()
|
||||
' }, "", "输入房间名(建议包含游戏版本等信息)", "确定", "取消")
|
||||
'If DisplayName Is Nothing Then Exit Sub
|
||||
'DisplayName = DisplayName.Trim
|
||||
''开始
|
||||
'RunInThread(Sub()
|
||||
' Try
|
||||
' '请求
|
||||
' Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/port?proto=tcp&port=" & Port & "&password=" & IoiPassword, "PUT", "", "", 100000))
|
||||
' If Result("msg") IsNot Nothing Then Throw New InvalidOperationException(Result("msg").ToString)
|
||||
' '成功
|
||||
' RoomListForMe.Add(New RoomEntry(Port, DisplayName))
|
||||
' Hint("房间 " & DisplayName & " 已创建!", HintType.Finish)
|
||||
' SendUpdateRequestToAllUsers()
|
||||
' Catch ex As InvalidOperationException
|
||||
' 'API 返回的错误
|
||||
' Log("创建房间失败:" & ex.Message, LogLevel.Msgbox)
|
||||
' Catch ex As Exception
|
||||
' '常规错误
|
||||
' Log(ex, "创建房间失败", LogLevel.Msgbox)
|
||||
' End Try
|
||||
' End Sub)
|
||||
End Sub
|
||||
Private Shared Sub SendUpdateRequestToAllUsers()
|
||||
For i = 0 To UserList.Count - 1
|
||||
@@ -1119,18 +408,6 @@ Done:
|
||||
End Sub
|
||||
'修改房间名称
|
||||
Private Shared Sub BtnRoomEdit_Click(sender As MyIconButton, e As EventArgs)
|
||||
'Dim Room As RoomEntry = sender.Tag
|
||||
''获取房间名
|
||||
'Dim DisplayName As String = MyMsgBoxInput(Room.DisplayName, New ObjectModel.Collection(Of Validate) From {
|
||||
' New ValidateNullOrWhiteSpace(),
|
||||
' New ValidateLength(1, 40)
|
||||
' }, "", "输入房间名(建议包含游戏版本等信息)", "确定", "取消")
|
||||
'If DisplayName Is Nothing Then Exit Sub
|
||||
'DisplayName = DisplayName.Trim
|
||||
''修改
|
||||
'Room.DisplayName = DisplayName
|
||||
'FrmLinkIoi.RefreshUi()
|
||||
'SendUpdateRequestToAllUsers()
|
||||
End Sub
|
||||
'加入房间
|
||||
Private Shared Sub BtnRoom_Click(sender As MyListItem, e As EventArgs)
|
||||
@@ -1141,25 +418,6 @@ Done:
|
||||
End Sub
|
||||
'关闭房间
|
||||
Private Shared Sub BtnRoomClose_Click(sender As MyIconButton, e As EventArgs)
|
||||
Dim Room As RoomEntry = sender.Tag
|
||||
RunInThread(Sub()
|
||||
Try
|
||||
'远程移除
|
||||
Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/port?proto=tcp&port=" & Room.Port & "&password=" & IoiPassword, "DELETE", "", "", 100000))
|
||||
If Result("msg") IsNot Nothing Then Throw New InvalidOperationException(Result("msg").ToString)
|
||||
'本地移除
|
||||
RoomListForMe.Remove(Room)
|
||||
'成功
|
||||
RunInUi(Sub() FrmLinkIoi.RefreshUi())
|
||||
SendUpdateRequestToAllUsers()
|
||||
Catch ex As InvalidOperationException
|
||||
'API 返回的错误
|
||||
If InitLoader.State = LoadState.Finished Then Log("移除房间失败:" & ex.Message, LogLevel.Msgbox)
|
||||
Catch ex As Exception
|
||||
'常规错误
|
||||
If InitLoader.State = LoadState.Finished Then Log(ex, "移除房间失败", LogLevel.Msgbox)
|
||||
End Try
|
||||
End Sub)
|
||||
End Sub
|
||||
|
||||
'获取数据包
|
||||
@@ -1238,21 +496,9 @@ Done:
|
||||
''' 从用户列表中移除一位用户。提示信息视作该用户主动离开。
|
||||
''' </summary>
|
||||
Public Shared Sub UserRemove(User As LinkUserIoi, ShowLeaveMessage As Boolean)
|
||||
If Not UserList.ContainsKey(User.Id) Then Exit Sub
|
||||
If ShowLeaveMessage Then Hint(User.DisplayName & " 已离开!")
|
||||
NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
|
||||
User.Dispose()
|
||||
End Sub
|
||||
|
||||
'关闭联机模块按钮
|
||||
Private Shared Sub ModuleStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) Handles InitLoader.OnStateChangedUi
|
||||
If FrmLinkLeft IsNot Nothing Then CType(FrmLinkLeft.ItemIoi.Buttons(0), MyIconButton).Visibility = If(NewState = LoadState.Finished, Visibility.Visible, Visibility.Collapsed)
|
||||
End Sub
|
||||
Public Shared Sub ModuleStopManually()
|
||||
IoiStop(False)
|
||||
InitLoader.Error = New Exception("联机模块已关闭,点击以重新启动")
|
||||
InitLoader.State = LoadState.Failed
|
||||
IoiState = LoadState.Failed
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
@@ -1,6 +1,4 @@
|
||||
Imports NetFwTypeLib
|
||||
|
||||
Public Class PageLinkLeft
|
||||
Public Class PageLinkLeft
|
||||
|
||||
Private IsLoad As Boolean = False
|
||||
Private IsPageSwitched As Boolean = False '如果在 Loaded 前切换到其他页面,会导致触发 Loaded 时再次切换一次
|
||||
@@ -15,84 +13,6 @@ Public Class PageLinkLeft
|
||||
IsPageSwitched = False
|
||||
End Sub
|
||||
|
||||
#Region "Windows 防火墙"
|
||||
|
||||
'为联机模块添加防火墙通行权限的函数库
|
||||
'不加防火墙权限你要我怎么办,这联机根本连都连不上,球球你们别看到防火墙就说是后门了,真的很恼火……
|
||||
|
||||
''' <summary>
|
||||
''' 获取某个文件是否被 Windows 防火墙阻止。
|
||||
''' </summary>
|
||||
Public Shared Function FirewallIsBlock(FilePath As String) As Boolean
|
||||
'获取配置
|
||||
If FirewallPolicy Is Nothing Then
|
||||
Try
|
||||
FirewallPolicy = FirewallPolicyGet()
|
||||
Catch ex As Exception
|
||||
Log(ex, "Windows 防火墙:可能关闭得太死了,根本检测不到,笑死", LogLevel.Normal)
|
||||
Return False
|
||||
End Try
|
||||
End If
|
||||
'检查是否开启
|
||||
If Not FirewallPolicy.CurrentProfile.FirewallEnabled Then
|
||||
Log("[Link] Windows 防火墙:防火墙关闭")
|
||||
Return False
|
||||
End If
|
||||
'检查是否允许例外
|
||||
If FirewallPolicy.CurrentProfile.ExceptionsNotAllowed Then
|
||||
Log("[Link] Windows 防火墙:防火墙开启,不允许例外")
|
||||
Return True
|
||||
End If
|
||||
'检查白名单
|
||||
Dim Target As String = FilePath.Replace(PathTemp.Split("\").First, "").ToLower
|
||||
For Each App As INetFwAuthorizedApplication In FirewallPolicy.CurrentProfile.AuthorizedApplications
|
||||
If ModeDebug Then Log("[Link] 防火墙白名单(" & App.Enabled & "):" & App.ProcessImageFileName)
|
||||
If Not App.Enabled Then Continue For
|
||||
'信标的奇妙盘符 E:0/xxxxx/xxx 导致误判……
|
||||
Dim FileNameTrimmed As String = App.ProcessImageFileName.Replace(App.ProcessImageFileName.Split("\").First, "")
|
||||
If App.ProcessImageFileName.ToLower.Contains(FilePath) Then
|
||||
Log("[Link] Windows 防火墙:开启,已在白名单中(" & FilePath & ")")
|
||||
Return False
|
||||
End If
|
||||
Next
|
||||
Log("[Link] Windows 防火墙:开启,未在白名单中(" & FilePath & ")")
|
||||
Return True
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 添加防火墙通行权限。需要管理员权限。
|
||||
''' </summary>
|
||||
Public Shared Sub FirewallAddAuthorized(DisplayName As String, FilePath As String)
|
||||
Log("[Link] Windows 防火墙:添加通行权限(" & FilePath & ")")
|
||||
'获取配置
|
||||
If FirewallPolicy Is Nothing Then FirewallPolicy = FirewallPolicyGet()
|
||||
'添加项目
|
||||
FirewallPolicy.GetProfileByType(NET_FW_PROFILE_TYPE_.NET_FW_PROFILE_DOMAIN).AuthorizedApplications.Add(New FirewallApp(DisplayName, FilePath))
|
||||
FirewallPolicy.GetProfileByType(NET_FW_PROFILE_TYPE_.NET_FW_PROFILE_STANDARD).AuthorizedApplications.Add(New FirewallApp(DisplayName, FilePath))
|
||||
FirewallPolicy.CurrentProfile.AuthorizedApplications.Add(New FirewallApp(DisplayName, FilePath))
|
||||
End Sub
|
||||
Private Class FirewallApp
|
||||
Implements INetFwAuthorizedApplication
|
||||
Public Property Name As String Implements INetFwAuthorizedApplication.Name
|
||||
Public Property ProcessImageFileName As String Implements INetFwAuthorizedApplication.ProcessImageFileName
|
||||
Public Property IpVersion As NET_FW_IP_VERSION_ = NET_FW_IP_VERSION_.NET_FW_IP_VERSION_ANY Implements INetFwAuthorizedApplication.IpVersion
|
||||
Public Property Scope As NET_FW_SCOPE_ = NET_FW_SCOPE_.NET_FW_SCOPE_ALL Implements INetFwAuthorizedApplication.Scope
|
||||
Public Property RemoteAddresses As String = "*" Implements INetFwAuthorizedApplication.RemoteAddresses
|
||||
Public Property Enabled As Boolean = True Implements INetFwAuthorizedApplication.Enabled
|
||||
Public Sub New(DisplayName As String, FilePath As String)
|
||||
Name = DisplayName
|
||||
ProcessImageFileName = FilePath
|
||||
End Sub
|
||||
End Class
|
||||
'获取防火墙配置
|
||||
Public Shared FirewallPolicy As INetFwPolicy = Nothing
|
||||
Public Shared Function FirewallPolicyGet() As INetFwPolicy
|
||||
Const CLSID_FIREWALL_MANAGER As String = "{304CE942-6E39-40D8-943A-B913C40C9CD4}"
|
||||
Dim objType As Type = Type.GetTypeFromCLSID(New Guid(CLSID_FIREWALL_MANAGER))
|
||||
Return TryCast(Activator.CreateInstance(objType), INetFwMgr).LocalPolicy
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "页面切换"
|
||||
|
||||
''' <summary>
|
||||
@@ -184,7 +104,6 @@ Public Class PageLinkLeft
|
||||
PageLinkHiper.ModuleStopManually()
|
||||
End Sub
|
||||
Private Sub BtnIoiStop_Loaded(sender As Object, e As RoutedEventArgs)
|
||||
sender.Visibility = If(PageLinkIoi.InitLoader.State = LoadState.Finished, Visibility.Visible, Visibility.Collapsed)
|
||||
End Sub
|
||||
Private Sub BtnIoiStop_Click(sender As Object, e As EventArgs)
|
||||
PageLinkIoi.ModuleStopManually()
|
||||
|
||||
@@ -149,7 +149,7 @@
|
||||
'进行搜索,构造列表
|
||||
Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.08)
|
||||
PanSearchList.Children.Clear()
|
||||
If SearchResult.Count = 0 Then
|
||||
If Not SearchResult.Any() Then
|
||||
PanSearch.Title = "无搜索结果"
|
||||
PanSearchList.Visibility = Visibility.Collapsed
|
||||
Else
|
||||
|
||||
@@ -129,7 +129,7 @@
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
If McFolderList.Count = 0 Then
|
||||
If Not McFolderList.Any() Then
|
||||
Throw New ArgumentNullException("没有可用的 Minecraft 文件夹")
|
||||
Else
|
||||
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
|
||||
@@ -237,7 +237,7 @@
|
||||
If Not Version.Modable Then Continue For
|
||||
'4. 该版本的隔离文件夹下不存在 mods
|
||||
Dim ModIndieFolder As New DirectoryInfo(Version.Path & "mods\")
|
||||
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Count > 0 Then Exit Sub
|
||||
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Exit Sub
|
||||
'满足以上全部条件则视为根目录整合包
|
||||
Setup.Set("VersionArgumentIndie", 2, Version:=Version)
|
||||
Log("[Setup] 已自动关闭单版本隔离:" & Version.Name, LogLevel.Debug)
|
||||
@@ -301,7 +301,7 @@
|
||||
End If
|
||||
Next
|
||||
'保存
|
||||
Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|")))
|
||||
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
|
||||
Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Finish)
|
||||
McFolderListLoader.Start(IsForceRestart:=True)
|
||||
|
||||
@@ -325,7 +325,7 @@
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|")))
|
||||
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
|
||||
End If
|
||||
RunInNewThread(Sub()
|
||||
'删除文件夹
|
||||
|
||||
@@ -79,7 +79,7 @@
|
||||
<RowDefinition Height="Auto" />
|
||||
</Grid.RowDefinitions>
|
||||
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
|
||||
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。
支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {name}:游戏版本名
 · {time}:当前的系统时间
 · {version}:游戏对应的原版版本号" HintText="默认" MaxLength="100" />
|
||||
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。
支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {name}:游戏版本名
 · {date}、{time}:当前的系统时间
 · {version}:游戏对应的原版版本号" HintText="默认" MaxLength="100" />
|
||||
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
|
||||
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchArgumentInfo" Text="Plain Craft Launcher 2" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角">
|
||||
<local:MyTextBox.ValidateRules>
|
||||
@@ -115,7 +115,7 @@
|
||||
<local:MyComboBoxItem Content="中(平衡)" IsSelected="True" />
|
||||
<local:MyComboBoxItem Content="低(优先保证其他程序运行,但可能让游戏卡顿,适合挂机时使用)" />
|
||||
</local:MyComboBox>
|
||||
<TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="游戏窗口" Margin="0,0,25,0" />
|
||||
<TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="窗口大小" Margin="0,0,25,0" />
|
||||
<Grid x:Name="PanArgumentWindow" Grid.Row="10" Grid.ColumnSpan="2" Grid.Column="1">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition />
|
||||
@@ -125,11 +125,10 @@
|
||||
</Grid.ColumnDefinitions>
|
||||
<local:MyComboBox x:Name="ComboArgumentWindowType" Tag="LaunchArgumentWindowType">
|
||||
<local:MyComboBoxItem Content="全屏" />
|
||||
<local:MyComboBoxItem Content="默认大小" IsSelected="True" ToolTip="以 854×480 的默认窗口大小启动 Minecraft" />
|
||||
<local:MyComboBoxItem Content="与启动器窗口大小一致" />
|
||||
<local:MyComboBoxItem Content="自定义大小" ToolTip="注意:Forge 1.12 存在 Bug,会导致高度设定无效" />
|
||||
<local:MyComboBoxItem Content="默认" IsSelected="True" />
|
||||
<local:MyComboBoxItem Content="与启动器尺寸一致" />
|
||||
<local:MyComboBoxItem Content="自定义尺寸" ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" />
|
||||
<local:MyComboBoxItem Content="最大化" />
|
||||
<local:MyComboBoxItem Content="保持游戏默认" />
|
||||
</local:MyComboBox>
|
||||
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="1" Margin="50,0,0,0" x:Name="TextArgumentWindowWidth" Tag="LaunchArgumentWindowWidth" Width="60" HorizontalContentAlignment="Center" Text="854">
|
||||
<local:MyTextBox.ValidateRules>
|
||||
@@ -138,7 +137,7 @@
|
||||
</local:MyTextBox>
|
||||
<TextBlock x:Name="LabArgumentWindowMiddle" Visibility="Collapsed" Grid.Column="2" Text=" × " VerticalAlignment="Center" FontSize="18" />
|
||||
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="3" Width="60" HorizontalContentAlignment="Center" x:Name="TextArgumentWindowHeight" Tag="LaunchArgumentWindowHeight" Text="480"
|
||||
ToolTip="注意:Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
|
||||
ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
|
||||
<local:MyTextBox.ValidateRules>
|
||||
<local:ValidateInteger Min="1" Max="9999" />
|
||||
</local:MyTextBox.ValidateRules>
|
||||
@@ -175,11 +174,16 @@
|
||||
<RowDefinition Height="Auto" />
|
||||
<RowDefinition Height="9" />
|
||||
<RowDefinition Height="Auto" />
|
||||
<RowDefinition Height="9" />
|
||||
<RowDefinition Height="Auto" />
|
||||
</Grid.RowDefinitions>
|
||||
<local:MyRadioBox Text="自动配置" Width="110" Checked="True" x:Name="RadioRamType0" Tag="LaunchRamType/0" Margin="0,0,20,0"
|
||||
ToolTip="根据安装的 Mod 量与电脑剩余内存,动态调整为游戏分配的内存" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="-3" />
|
||||
<local:MyRadioBox Grid.Row="2" Text="自定义" x:Name="RadioRamType1" Tag="LaunchRamType/1" Margin="0,0,20,0" />
|
||||
<local:MySlider Grid.Row="2" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="LaunchRamCustom" MaxValue="49" Value="13" />
|
||||
<local:MyCheckBox Grid.Row="4" Grid.ColumnSpan="3" Text="启动游戏前进行内存优化" Height="22" x:Name="CheckArgumentRam" Tag="LaunchArgumentRam"
|
||||
ToolTipService.Placement="Left" ToolTipService.HorizontalOffset="525" ToolTipService.VerticalOffset="-30"
|
||||
ToolTip="内存优化能将当前物理内存占用降低约 1/3,不仅限于 MC!
如果使用机械硬盘,这还可能会导致一小段时间的严重卡顿。
使用 --memory 参数启动 PCL 可以静默执行内存优化。" />
|
||||
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
|
||||
</Grid>
|
||||
<Grid x:Name="PanRamDisplay" Margin="0,11,2,0" SnapsToDevicePixels="True" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="1">
|
||||
@@ -229,13 +233,13 @@
|
||||
<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 参数,在没有确定把握的情况下请不要尝试修改。
你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true"
|
||||
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。
你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" MaxLength="4000"
|
||||
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
|
||||
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
|
||||
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。
例如输入 --demo 则会以试玩模式启动游戏。" />
|
||||
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,0" />
|
||||
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="LaunchAdvanceRun" Grid.Column="1" HintText=""
|
||||
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。

可以使用以下替换标记实现相对路径(路径均以 \ 结尾):
 · {path}:PCL 的 exe 文件所在的文件夹
 · {minecraft}:.minecraft 文件夹
 · {verpath}:版本文件夹(.minecraft\versions\版本名\)
 · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹
 · {java}:游戏运行时的 Java 文件夹

除此之外,也支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {uuid}:玩家的 UUID
 · {name}:游戏版本名
 · {time}:当前的系统时间
 · {version}:游戏对应的原版版本号

例如:
 · "{verpath}test.exe" :运行版本文件夹下的 test.exe 程序
 · "{java}java.exe" -jar "{verpath}test.jar" :用 Java 运行版本文件夹下的 test.jar
 · notepad "{verindie}option.txt" :使用记事本打开该版本的设置文件

涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。" />
|
||||
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。

可以使用以下替换标记实现相对路径(路径均以 \ 结尾):
 · {path}:PCL 的 exe 文件所在的文件夹
 · {minecraft}:.minecraft 文件夹
 · {verpath}:版本文件夹(.minecraft\versions\版本名\)
 · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹
 · {java}:游戏运行时的 Java 文件夹

除此之外,也支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {uuid}:玩家的 UUID
 · {name}:游戏版本名
 · {date}、{time}:当前的系统时间
 · {version}:游戏对应的原版版本号

例如:
 · "{verpath}test.exe" :运行版本文件夹下的 test.exe 程序
 · "{java}java.exe" -jar "{verpath}test.jar" :用 Java 运行版本文件夹下的 test.jar
 · notepad "{verindie}option.txt" :使用记事本打开该版本的设置文件

涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。
执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
|
||||
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="LaunchAdvanceRunWait" Visibility="Collapsed"
|
||||
Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" />
|
||||
<StackPanel Margin="0,12,0,4" Orientation="Horizontal" Grid.Row="6" Grid.ColumnSpan="2">
|
||||
|
||||
@@ -38,6 +38,7 @@
|
||||
ComboArgumentWindowType.SelectedIndex = Setup.Get("LaunchArgumentWindowType")
|
||||
TextArgumentWindowWidth.Text = Setup.Get("LaunchArgumentWindowWidth")
|
||||
TextArgumentWindowHeight.Text = Setup.Get("LaunchArgumentWindowHeight")
|
||||
CheckArgumentRam.Checked = Setup.Get("LaunchArgumentRam")
|
||||
RefreshJavaComboBox()
|
||||
|
||||
'游戏内存
|
||||
@@ -71,6 +72,7 @@
|
||||
Setup.Reset("LaunchArgumentWindowWidth")
|
||||
Setup.Reset("LaunchArgumentWindowHeight")
|
||||
Setup.Reset("LaunchArgumentPriority")
|
||||
Setup.Reset("LaunchArgumentRam")
|
||||
Setup.Reset("LaunchRamType")
|
||||
Setup.Reset("LaunchRamCustom")
|
||||
Setup.Reset("LaunchSkinType")
|
||||
@@ -108,7 +110,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, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change
|
||||
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change, CheckArgumentRam.Change
|
||||
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
|
||||
End Sub
|
||||
|
||||
@@ -352,19 +354,19 @@
|
||||
'可安装 Mod 的版本
|
||||
Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\")
|
||||
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
|
||||
RamMininum = 0.4 + ModCount / 150
|
||||
RamTarget1 = 1.5 + ModCount / 100
|
||||
RamTarget2 = 3 + ModCount / 60
|
||||
RamTarget3 = 6 + ModCount / 30
|
||||
RamMininum = 0.5 + ModCount / 150
|
||||
RamTarget1 = 1.5 + ModCount / 90
|
||||
RamTarget2 = 2.7 + ModCount / 50
|
||||
RamTarget3 = 4.5 + ModCount / 25
|
||||
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
|
||||
'OptiFine 版本
|
||||
RamMininum = 0.3
|
||||
RamMininum = 0.5
|
||||
RamTarget1 = 1.5
|
||||
RamTarget2 = 3
|
||||
RamTarget3 = 6
|
||||
RamTarget3 = 5
|
||||
Else
|
||||
'普通版本
|
||||
RamMininum = 0.3
|
||||
RamMininum = 0.5
|
||||
RamTarget1 = 1.5
|
||||
RamTarget2 = 2.5
|
||||
RamTarget3 = 4
|
||||
@@ -372,27 +374,23 @@
|
||||
Dim RamDelta As Double
|
||||
'预分配内存,阶段一,0 ~ T1,100%
|
||||
RamDelta = RamTarget1
|
||||
RamAvailable = Math.Max(0, RamAvailable - 0.1)
|
||||
RamGive += Math.Min(RamAvailable * 1, RamDelta)
|
||||
RamAvailable -= RamDelta / 1 + 0.1
|
||||
RamGive += Math.Min(RamAvailable, RamDelta)
|
||||
RamAvailable -= RamDelta
|
||||
If RamAvailable < 0.1 Then GoTo PreFin
|
||||
'预分配内存,阶段二,T1 ~ T2,80%
|
||||
'预分配内存,阶段二,T1 ~ T2,70%
|
||||
RamDelta = RamTarget2 - RamTarget1
|
||||
RamAvailable = Math.Max(0, RamAvailable - 0.1)
|
||||
RamGive += Math.Min(RamAvailable * 0.8, RamDelta)
|
||||
RamAvailable -= RamDelta / 0.8 + 0.1
|
||||
RamGive += Math.Min(RamAvailable * 0.7, RamDelta)
|
||||
RamAvailable -= RamDelta / 0.7
|
||||
If RamAvailable < 0.1 Then GoTo PreFin
|
||||
'预分配内存,阶段三,T2 ~ T3,60%
|
||||
'预分配内存,阶段三,T2 ~ T3,40%
|
||||
RamDelta = RamTarget3 - RamTarget2
|
||||
RamAvailable = Math.Max(0, RamAvailable - 0.2)
|
||||
RamGive += Math.Min(RamAvailable * 0.6, RamDelta)
|
||||
RamAvailable -= RamDelta / 0.6 + 0.2
|
||||
If RamAvailable < 0.1 Then GoTo PreFin
|
||||
'预分配内存,阶段四,T3 ~ T3 * 2,40%
|
||||
RamDelta = RamTarget3
|
||||
RamAvailable = Math.Max(0, RamAvailable - 0.3)
|
||||
RamGive += Math.Min(RamAvailable * 0.4, RamDelta)
|
||||
RamAvailable -= RamDelta / 0.4 + 0.3
|
||||
RamAvailable -= RamDelta / 0.4
|
||||
If RamAvailable < 0.1 Then GoTo PreFin
|
||||
'预分配内存,阶段四,T3 ~ T3 * 2,15%
|
||||
RamDelta = RamTarget3
|
||||
RamGive += Math.Min(RamAvailable * 0.15, RamDelta)
|
||||
RamAvailable -= RamDelta / 0.15
|
||||
If RamAvailable < 0.1 Then GoTo PreFin
|
||||
PreFin:
|
||||
'不低于最低值
|
||||
@@ -444,7 +442,7 @@ PreFin:
|
||||
Log(ex, "更新设置 Java 下拉框失败", LogLevel.Feedback)
|
||||
End Try
|
||||
'更新选择项
|
||||
If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
|
||||
If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
|
||||
ComboArgumentJava.SelectedItem = SelectedItem
|
||||
'结束处理
|
||||
If SelectedItem Is Nothing Then
|
||||
@@ -515,15 +513,16 @@ PreFin:
|
||||
Hint("正在搜索 Java,请稍候!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
RunInThread(Sub()
|
||||
Hint("正在搜索 Java!")
|
||||
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
|
||||
If JavaList.Count = 0 Then
|
||||
Hint("未找到可用的 Java!", HintType.Critical)
|
||||
Else
|
||||
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish)
|
||||
End If
|
||||
End Sub)
|
||||
RunInThread(
|
||||
Sub()
|
||||
Hint("正在搜索 Java!")
|
||||
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
|
||||
If Not JavaList.Any() Then
|
||||
Hint("未找到可用的 Java!", HintType.Critical)
|
||||
Else
|
||||
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish)
|
||||
End If
|
||||
End Sub)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
@@ -548,12 +547,24 @@ PreFin:
|
||||
If AniControlEnabled <> 0 Then Exit Sub
|
||||
If ComboArgumentVisibie.SelectedIndex = 0 Then
|
||||
If MyMsgBox("若在游戏启动后立即关闭启动器,崩溃检测、更改游戏标题等功能将失效。" & vbCrLf &
|
||||
"如果想保留这些功能,可以选择让启动器在游戏启动后隐藏,游戏退出后自动关闭。", "提示", "继续", "取消") = 2 Then
|
||||
"如果想保留这些功能,可以选择让启动器在游戏启动后隐藏,游戏退出后自动关闭。", "提醒", "继续", "取消") = 2 Then
|
||||
ComboArgumentVisibie.SelectedItem = e.RemovedItems(0)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'开启自动内存优化的警告
|
||||
Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change
|
||||
If AniControlEnabled <> 0 Then Exit Sub
|
||||
If Not CheckArgumentRam.Checked Then Return
|
||||
If MyMsgBox("内存优化耗时较长,这会拖慢游戏的启动过程,建议仅在电脑内存不充裕时开启此选项。" & vbCrLf &
|
||||
"如果你在使用机械硬盘,这还可能会导致一小段时间的严重卡顿。" &
|
||||
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
|
||||
"提醒", "确定", "取消") = 2 Then
|
||||
CheckArgumentRam.Checked = False
|
||||
End If
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "高级设置"
|
||||
|
||||
@@ -26,6 +26,7 @@
|
||||
<RowDefinition Height="Auto" />
|
||||
<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">
|
||||
@@ -55,6 +56,9 @@
|
||||
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="8" Height="22" Grid.ColumnSpan="2"
|
||||
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt"
|
||||
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。
例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
|
||||
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="9" Height="22" Grid.ColumnSpan="2"
|
||||
x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
|
||||
ToolTip="在进行连接时,检查 SSL 证书是否正常。
进行验证会提高安全性,但疑似会导致少部分玩家的微软登录失败。" />
|
||||
</Grid>
|
||||
</StackPanel>
|
||||
</local:MyCard>
|
||||
|
||||
@@ -58,6 +58,7 @@
|
||||
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
|
||||
CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack")
|
||||
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt")
|
||||
CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert")
|
||||
|
||||
'Minecraft 更新提示
|
||||
CheckUpdateRelease.Checked = Setup.Get("ToolUpdateRelease")
|
||||
@@ -88,6 +89,7 @@
|
||||
Setup.Reset("ToolDownloadTranslate")
|
||||
Setup.Reset("ToolDownloadKeepModpack")
|
||||
Setup.Reset("ToolDownloadIgnoreQuilt")
|
||||
Setup.Reset("ToolDownloadCert")
|
||||
Setup.Reset("ToolUpdateRelease")
|
||||
Setup.Reset("ToolUpdateSnapshot")
|
||||
Setup.Reset("ToolHelpChinese")
|
||||
@@ -109,7 +111,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, CheckDownloadKeepModpack.Change, CheckDownloadIgnoreQuilt.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, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.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
|
||||
@@ -124,23 +126,21 @@
|
||||
|
||||
'滑动条
|
||||
Private Sub SliderLoad()
|
||||
SliderDownloadThread.GetHintText = Function(Value As Integer)
|
||||
Return Value + 1
|
||||
End Function
|
||||
SliderDownloadSpeed.GetHintText = Function(Value As Integer)
|
||||
If Value <= 14 Then
|
||||
Return (Value + 1) * 0.1 & " M/s"
|
||||
ElseIf Value <= 31 Then
|
||||
Return (Value - 11) * 0.5 & " M/s"
|
||||
ElseIf Value <= 41 Then
|
||||
Return (Value - 21) & " M/s"
|
||||
Else
|
||||
Return "无限制"
|
||||
End If
|
||||
End Function
|
||||
SliderDebugAnim.GetHintText = Function(Value As Integer)
|
||||
Return If(Value > 29, "关闭", (Value / 10 + 0.1) & "x")
|
||||
End Function
|
||||
SliderDownloadThread.GetHintText = Function(v) v + 1
|
||||
SliderDownloadSpeed.GetHintText =
|
||||
Function(v)
|
||||
Select Case v
|
||||
Case Is <= 14
|
||||
Return (v + 1) * 0.1 & " M/s"
|
||||
Case Is <= 31
|
||||
Return (v - 11) * 0.5 & " M/s"
|
||||
Case Is <= 41
|
||||
Return (v - 21) & " M/s"
|
||||
Case Else
|
||||
Return "无限制"
|
||||
End Select
|
||||
End Function
|
||||
SliderDebugAnim.GetHintText = Function(v) If(v > 29, "关闭", (v / 10 + 0.1) & "x")
|
||||
End Sub
|
||||
Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange
|
||||
If SliderDownloadThread.Value < 100 Then Exit Sub
|
||||
|
||||
@@ -36,7 +36,7 @@
|
||||
Try
|
||||
|
||||
#Region "更新左边栏"
|
||||
If LoaderTaskbar.Count = 0 Then
|
||||
If Not LoaderTaskbar.Any() Then
|
||||
'无任务
|
||||
LabProgress.Text = "100 %"
|
||||
LabSpeed.Text = "0 B/s"
|
||||
@@ -214,13 +214,14 @@
|
||||
End Sub
|
||||
Public Sub TaskRemove(Loader As Object)
|
||||
If RightCards.ContainsKey(Loader.Name) Then
|
||||
RunInUiWait(Sub()
|
||||
'移除已有的卡片
|
||||
Dim Card As Grid = RightCards(Loader.Name)
|
||||
FrmSpeedRight.PanMain.Children.Remove(Card)
|
||||
RightCards.Remove(Loader.Name)
|
||||
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
|
||||
End Sub)
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
'移除已有的卡片
|
||||
Dim Card As Grid = RightCards(Loader.Name)
|
||||
FrmSpeedRight.PanMain.Children.Remove(Card)
|
||||
RightCards.Remove(Loader.Name)
|
||||
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
|
||||
End Sub)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -47,6 +47,8 @@
|
||||
</local:MyCard.RenderTransform>
|
||||
<TextBlock x:Name="LabSelect" Text="已选择 8 个文件" HorizontalAlignment="Center" VerticalAlignment="Top" Margin="9" Foreground="{DynamicResource ColorBrush2}" />
|
||||
<StackPanel Orientation="Horizontal" Margin="5,28,5,5">
|
||||
<local:MyIconTextButton x:Name="BtnSelectUpdate" Text="更新"
|
||||
LogoScale="1" Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
|
||||
<local:MyIconTextButton x:Name="BtnSelectEnable" Text="启用"
|
||||
LogoScale="1.05" Logo="M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z" />
|
||||
<local:MyIconTextButton x:Name="BtnSelectDisable" Text="禁用"
|
||||
|
||||
@@ -25,7 +25,6 @@
|
||||
''' 刷新 Mod 列表。
|
||||
''' </summary>
|
||||
Public Sub RefreshList(Optional ForceReload As Boolean = False)
|
||||
If McModLoader.State = LoadState.Loading Then Exit Sub
|
||||
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
|
||||
Log("[System] 已刷新 Mod 列表")
|
||||
PanBack.ScrollToHome()
|
||||
@@ -65,12 +64,12 @@
|
||||
PanBack.Visibility = Visibility.Collapsed
|
||||
Exit Sub
|
||||
End If
|
||||
SearchBox.Text = ""
|
||||
'输出结果
|
||||
ModItems.Clear()
|
||||
For Each ModEntity As McMod In Mods
|
||||
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
|
||||
Next
|
||||
SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频
|
||||
RefreshResult(Mods)
|
||||
Catch ex As Exception
|
||||
Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback)
|
||||
@@ -80,7 +79,7 @@
|
||||
AniControlEnabled += 1
|
||||
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
|
||||
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)}
|
||||
AddHandler Entry.OnGetCompProject, AddressOf NewItem.Refresh
|
||||
AddHandler Entry.OnCompUpdate, AddressOf NewItem.Refresh
|
||||
NewItem.Refresh()
|
||||
AniControlEnabled -= 1
|
||||
Return NewItem
|
||||
@@ -102,17 +101,14 @@
|
||||
ToolTipService.SetVerticalOffset(BtnCont, 30)
|
||||
ToolTipService.SetHorizontalOffset(BtnCont, 2)
|
||||
AddHandler BtnCont.Click, AddressOf Info_Click
|
||||
AddHandler sender.MouseRightButtonDown, AddressOf Info_Click
|
||||
AddHandler sender.MouseRightButtonUp, AddressOf Info_Click
|
||||
Dim BtnDelete As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonDelete, .Tag = sender}
|
||||
BtnDelete.ToolTip = "删除"
|
||||
ToolTipService.SetPlacement(BtnDelete, Primitives.PlacementMode.Center)
|
||||
ToolTipService.SetVerticalOffset(BtnDelete, 30)
|
||||
ToolTipService.SetHorizontalOffset(BtnDelete, 2)
|
||||
AddHandler BtnDelete.Click, AddressOf Delete_Click
|
||||
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine,
|
||||
"M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z",
|
||||
"M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"),
|
||||
.Tag = sender}
|
||||
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine, Logo.IconButtonStop, Logo.IconButtonCheck), .Tag = sender}
|
||||
BtnED.ToolTip = If(sender.Entry.State = McMod.McModState.Fine, "禁用", "启用")
|
||||
ToolTipService.SetPlacement(BtnED, Primitives.PlacementMode.Center)
|
||||
ToolTipService.SetVerticalOffset(BtnED, 30)
|
||||
@@ -181,7 +177,7 @@
|
||||
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
|
||||
Try
|
||||
Dim Result = McModCheck(PageVersionLeft.Version, McModLoader.Output)
|
||||
If Result.Count > 0 Then
|
||||
If Result.Any Then
|
||||
MyMsgBox(Join(Result, vbCrLf & vbCrLf), "Mod 检查结果")
|
||||
Else
|
||||
Hint("Mod 检查完成,未发现任何问题!", HintType.Finish)
|
||||
@@ -240,10 +236,12 @@
|
||||
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
|
||||
'按钮可用性
|
||||
If Selected Then
|
||||
Dim HasUpdate As Boolean = False
|
||||
Dim HasEnabled As Boolean = False
|
||||
Dim HasDisabled As Boolean = False
|
||||
For Each ModEntity In McModLoader.Output
|
||||
If SelectedMods.Contains(ModEntity.RawFileName) Then
|
||||
If ModEntity.CanUpdate Then HasUpdate = True
|
||||
If ModEntity.State = McMod.McModState.Fine Then
|
||||
HasEnabled = True
|
||||
ElseIf ModEntity.State = McMod.McModState.Disabled Then
|
||||
@@ -253,9 +251,9 @@
|
||||
Next
|
||||
BtnSelectDisable.IsEnabled = HasEnabled
|
||||
BtnSelectEnable.IsEnabled = HasDisabled
|
||||
BtnSelectUpdate.IsEnabled = HasUpdate
|
||||
End If
|
||||
'更新显示状态
|
||||
CardSelect.IsHitTestVisible = Selected
|
||||
If AniControlEnabled = 0 Then
|
||||
If Selected Then
|
||||
'仅在数量增加时播放出现/跳跃动画
|
||||
@@ -333,20 +331,33 @@
|
||||
End Sub
|
||||
Private Sub EDMods(ModList As IEnumerable(Of McMod), IsEnable As Boolean)
|
||||
Dim IsSuccessful As Boolean = True
|
||||
For Each ModEntity In ModList.ToList
|
||||
For Each ModE In ModList.ToList
|
||||
Dim ModEntity = ModE '仅用于去除迭代变量无法修改的限制
|
||||
Dim NewPath As String = Nothing
|
||||
If ModEntity.State = McMod.McModState.Fine AndAlso Not IsEnable Then
|
||||
'禁用
|
||||
NewPath = ModEntity.Path & ".disabled"
|
||||
NewPath = ModEntity.Path & If(File.Exists(ModEntity.Path & ".old"), ".old", ".disabled")
|
||||
ElseIf ModEntity.State = McMod.McModState.Disabled AndAlso IsEnable Then
|
||||
'启用
|
||||
NewPath = ModEntity.Path.Replace(".disabled", "").Replace(".old", "")
|
||||
NewPath = ModEntity.RawPath
|
||||
Else
|
||||
Continue For
|
||||
End If
|
||||
'重命名
|
||||
Try
|
||||
If File.Exists(NewPath) AndAlso Not File.Exists(ModEntity.Path) Then Continue For '因为未知原因 Mod 的状态已经切换完了
|
||||
If File.Exists(NewPath) Then
|
||||
If File.Exists(ModEntity.Path) Then
|
||||
'同时存在两个名称的 Mod
|
||||
If GetFileMD5(ModEntity.Path) <> GetFileMD5(NewPath) Then
|
||||
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件:{vbCrLf} - {NewPath}{vbCrLf} - {ModEntity.Path}{vbCrLf}{vbCrLf}注意,这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后,才能继续操作。", "存在文件冲突")
|
||||
Continue For
|
||||
End If
|
||||
Else
|
||||
'已经重命名过了
|
||||
Log("[Mod] Mod 的状态已被切换", LogLevel.Debug)
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
File.Delete(NewPath)
|
||||
FileSystem.Rename(ModEntity.Path, NewPath)
|
||||
Catch ex As FileNotFoundException
|
||||
@@ -359,7 +370,7 @@
|
||||
End Try
|
||||
'更改 Loader 中的列表
|
||||
Dim NewModEntity As New McMod(NewPath)
|
||||
NewModEntity.Comp = ModEntity.Comp
|
||||
NewModEntity.FromJson(ModEntity.ToJson)
|
||||
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
|
||||
McModLoader.Output.RemoveAt(IndexOfLoader)
|
||||
McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
|
||||
@@ -380,15 +391,143 @@
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'更新
|
||||
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
|
||||
UpdateMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate))
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
|
||||
''' </summary>
|
||||
Public Shared UpdatingVersions As New List(Of String)
|
||||
Public Sub UpdateMods(ModList As IEnumerable(Of McMod))
|
||||
'更新前警告
|
||||
If Not Setup.Get("HintUpdateMod") Then
|
||||
If MyMsgBox($"新版本 Mod 可能不兼容老版本的存档或者其他 Mod,这可能导致游戏崩溃,甚至存档损坏!{vbCrLf}除非整合包作者要求你更新,否则不要私自更新整合包里的 Mod!{vbCrLf}在更新 Mod 前,请先备份存档,并检查它的更新日志!{vbCrLf}更新时,老版本的 Mod 会被移动到回收站,以防万一。{vbCrLf}{vbCrLf}请在认真阅读上述警告后再继续!", "Mod 更新警告", "我已了解上述风险,继续更新", "取消", IsWarn:=True) = 1 Then
|
||||
Setup.Set("HintUpdateMod", True)
|
||||
Else
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Try
|
||||
'构造下载信息
|
||||
ModList = ModList.ToList() '防止刷新影响迭代器
|
||||
Dim FileList As New List(Of NetFile)
|
||||
Dim FileCopyList As New Dictionary(Of String, String)
|
||||
For Each Entry As McMod In ModList
|
||||
Dim File As CompFile = Entry.UpdateFile
|
||||
If Not File.Available Then Continue For
|
||||
'确认更新后的文件名
|
||||
Dim CurrentReplaceName = Entry.CompFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
|
||||
Dim NewestReplaceName = Entry.UpdateFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
|
||||
Dim CurrentSegs = CurrentReplaceName.Split("-"c).ToList()
|
||||
Dim NewestSegs = NewestReplaceName.Split("-"c).ToList()
|
||||
Dim Shortened As Boolean = False
|
||||
For Each Seg In CurrentSegs.ToList()
|
||||
If Not NewestSegs.Contains(Seg) Then Continue For
|
||||
CurrentSegs.Remove(Seg)
|
||||
NewestSegs.Remove(Seg)
|
||||
Shortened = True
|
||||
Next
|
||||
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
|
||||
CurrentReplaceName = Join(CurrentSegs, "-")
|
||||
NewestReplaceName = Join(NewestSegs, "-")
|
||||
End If
|
||||
'添加到下载列表
|
||||
Dim TempAddress As String = PathTemp & "DownloadedMods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
|
||||
Dim RealAddress As String = GetPathFromFullPath(Entry.Path) & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
|
||||
FileList.Add(File.ToNetFile(TempAddress))
|
||||
FileCopyList(TempAddress) = RealAddress
|
||||
Next
|
||||
'构造加载器
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
Dim FinishedFileNames As New List(Of String)
|
||||
InstallLoaders.Add(New LoaderDownload("下载新版 Mod 文件", FileList) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件",
|
||||
Sub()
|
||||
Try
|
||||
For Each Entry As McMod In ModList
|
||||
If File.Exists(Entry.Path) Then
|
||||
My.Computer.FileSystem.DeleteFile(Entry.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
|
||||
Else
|
||||
Log($"[Mod] 未找到更新前的 Mod 文件,跳过对它的删除:{Entry.Path}", LogLevel.Debug)
|
||||
End If
|
||||
Next
|
||||
For Each Entry As KeyValuePair(Of String, String) In FileCopyList
|
||||
If File.Exists(Entry.Value) Then
|
||||
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
|
||||
Log($"[Mod] 更新后的 Mod 文件已存在,将会把它放入回收站:{Entry.Value}", LogLevel.Debug)
|
||||
End If
|
||||
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then
|
||||
File.Move(Entry.Key, Entry.Value)
|
||||
FinishedFileNames.Add(GetFileNameFromPath(Entry.Value))
|
||||
Else
|
||||
Log($"[Mod] 更新后的目标文件夹已被删除:{Entry.Value}", LogLevel.Debug)
|
||||
End If
|
||||
Next
|
||||
Catch ex As OperationCanceledException
|
||||
Log(ex, "替换旧版 Mod 文件时被主动取消")
|
||||
End Try
|
||||
End Sub))
|
||||
'结束处理
|
||||
Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新:" & PageVersionLeft.Version.Name, InstallLoaders)
|
||||
Dim PathMods As String = PageVersionLeft.Version.PathIndie & "mods\"
|
||||
Loader.OnStateChanged =
|
||||
Sub()
|
||||
'结果提示
|
||||
Select Case Loader.State
|
||||
Case LoadState.Finished
|
||||
Hint(If(FinishedFileNames.Count > 1, $"已成功更新 {FinishedFileNames.Count} 个 Mod!", $"已成功更新:{FinishedFileNames.Single}"), HintType.Finish)
|
||||
Case LoadState.Failed
|
||||
Hint("Mod 更新失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
|
||||
Case LoadState.Aborted
|
||||
Hint("Mod 更新已中止!", HintType.Info)
|
||||
Case Else
|
||||
Exit Sub
|
||||
End Select
|
||||
UpdatingVersions.Remove(PathMods)
|
||||
'清理缓存
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
For Each TempFile In FileCopyList.Keys
|
||||
If File.Exists(TempFile) Then File.Delete(TempFile)
|
||||
Next
|
||||
Catch ex As Exception
|
||||
Log(ex, "清理 Mod 更新缓存失败")
|
||||
End Try
|
||||
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
|
||||
End Sub
|
||||
'启动加载器
|
||||
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod")
|
||||
UpdatingVersions.Add(PathMods)
|
||||
Loader.Start()
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
RefreshList(True)
|
||||
Catch ex As Exception
|
||||
Log(ex, "初始化 Mod 更新失败")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'删除
|
||||
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
|
||||
Dim DeleteList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList()
|
||||
DeleteMods(DeleteList)
|
||||
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
|
||||
End Sub
|
||||
Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
|
||||
Try
|
||||
Dim IsSuccessful As Boolean = True
|
||||
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
|
||||
'确认需要删除的文件
|
||||
ModList = ModList.SelectMany(
|
||||
Function(Target As McMod)
|
||||
If Target.State = McMod.McModState.Fine Then
|
||||
Return {Target.Path, Target.Path & If(File.Exists(Target.Path & ".old"), ".old", ".disabled")}
|
||||
Else
|
||||
Return {Target.Path, Target.RawPath}
|
||||
End If
|
||||
End Function).Distinct.Where(Function(m) File.Exists(m)).Select(Function(m) New McMod(m)).ToList()
|
||||
'实际删除文件
|
||||
For Each ModEntity In ModList
|
||||
'删除
|
||||
Try
|
||||
@@ -410,8 +549,8 @@
|
||||
'更改 Loader 和 UI 中的列表
|
||||
McModLoader.Output.Remove(ModEntity)
|
||||
ModItems.Remove(ModEntity.RawFileName)
|
||||
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).First(Function(i) i.Entry Is ModEntity))
|
||||
PanList.Children.RemoveAt(IndexOfUi)
|
||||
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity)))
|
||||
If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi)
|
||||
Next
|
||||
RefreshTitle()
|
||||
If Not IsSuccessful Then
|
||||
@@ -481,13 +620,13 @@
|
||||
If ModEntry.ModId IsNot Nothing Then
|
||||
DebugInfo.Add("Mod ID:" & ModEntry.ModId)
|
||||
End If
|
||||
If ModEntry.Dependencies.Count > 0 Then
|
||||
If ModEntry.Dependencies.Any Then
|
||||
DebugInfo.Add("依赖于:")
|
||||
For Each Dep In ModEntry.Dependencies
|
||||
DebugInfo.Add(" - " & Dep.Key & If(Dep.Value Is Nothing, "", ",版本:" & Dep.Value))
|
||||
Next
|
||||
End If
|
||||
If DebugInfo.Count > 0 Then
|
||||
If DebugInfo.Any Then
|
||||
ContentLines.Add("")
|
||||
ContentLines.AddRange(DebugInfo)
|
||||
End If
|
||||
|
||||
@@ -26,7 +26,7 @@
|
||||
<RowDefinition Height="28" />
|
||||
</Grid.RowDefinitions>
|
||||
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
|
||||
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则使用全局设置的值。
支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {name}:游戏版本名
 · {time}:当前的系统时间
 · {version}:游戏对应的原版版本号" HintText="使用全局设置" MaxLength="100" />
|
||||
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则使用全局设置的值。
支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {name}:游戏版本名
 · {date}、{time}:当前的系统时间
 · {version}:游戏对应的原版版本号" HintText="使用全局设置" MaxLength="100" />
|
||||
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
|
||||
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionArgumentInfo" Grid.Column="1" HintText="使用全局设置" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。
若留空,则使用全局设置的值。">
|
||||
<local:MyTextBox.ValidateRules>
|
||||
@@ -168,10 +168,8 @@
|
||||
<Grid Height="35" Name="PanServerNide" Margin="0,12,0,0">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
|
||||
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
|
||||
</Grid.ColumnDefinitions>
|
||||
<local:MyButton x:Name="BtnServerNideWeb" Grid.Column="0" MinWidth="140" Text="服主后台" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
|
||||
<local:MyButton x:Name="BtnServerNideBbs" Grid.Column="1" MinWidth="140" Text="查看简介" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
|
||||
</Grid>
|
||||
<local:MyButton x:Name="BtnServerAuthLittle" Height="35" MinWidth="150" Margin="0,12,0,0" Text="设置为 LittleSkin" HorizontalAlignment="Left" ColorType="Highlight" />
|
||||
</StackPanel>
|
||||
@@ -193,13 +191,13 @@
|
||||
<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="VersionAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。
若留空,则使用全局设置的值。" HintText="使用全局设置"
|
||||
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" MaxLength="4000" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。
若留空,则使用全局设置的值。" HintText="使用全局设置"
|
||||
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
|
||||
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
|
||||
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。
例如输入 --demo 则会以试玩模式启动游戏。
若留空,则使用全局设置的值。" HintText="使用全局设置" />
|
||||
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,3" />
|
||||
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3"
|
||||
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。

在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。

可以使用以下替换标记实现相对路径(路径均以 \ 结尾):
 · {path}:PCL 的 exe 文件所在的文件夹
 · {minecraft}:.minecraft 文件夹
 · {verpath}:版本文件夹(.minecraft\versions\版本名\)
 · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹
 · {java}:游戏运行时的 Java 文件夹

除此之外,也支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {uuid}:玩家的 UUID
 · {name}:游戏版本名
 · {time}:当前的系统时间
 · {version}:游戏对应的原版版本号

例如:
 · "{verpath}test.exe" :运行版本文件夹下的 test.exe 程序
 · "{java}java.exe" -jar "{verpath}test.jar" :用 Java 运行版本文件夹下的 test.jar
 · notepad "{verindie}option.txt" :使用记事本打开该版本的设置文件

涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。" />
|
||||
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。

在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。

可以使用以下替换标记实现相对路径(路径均以 \ 结尾):
 · {path}:PCL 的 exe 文件所在的文件夹
 · {minecraft}:.minecraft 文件夹
 · {verpath}:版本文件夹(.minecraft\versions\版本名\)
 · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹
 · {java}:游戏运行时的 Java 文件夹

除此之外,也支持以下替换标记:
 · {user}:玩家名字
 · {login}:玩家的登录方式
 · {uuid}:玩家的 UUID
 · {name}:游戏版本名
 · {date}、{time}:当前的系统时间
 · {version}:游戏对应的原版版本号

例如:
 · "{verpath}test.exe" :运行版本文件夹下的 test.exe 程序
 · "{java}java.exe" -jar "{verpath}test.jar" :用 Java 运行版本文件夹下的 test.jar
 · notepad "{verindie}option.txt" :使用记事本打开该版本的设置文件

涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。
执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
|
||||
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="VersionAdvanceRunWait" Visibility="Collapsed"
|
||||
Text="等待命令执行完成后再继续启动" Margin="0,5,0,0" />
|
||||
<StackPanel Margin="0,10,0,0" Orientation="Horizontal" Grid.Row="6" Grid.ColumnSpan="2">
|
||||
|
||||
@@ -33,7 +33,7 @@
|
||||
If Indie = -1 Then
|
||||
Dim ModFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "mods\")
|
||||
Dim SaveFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "saves\")
|
||||
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then
|
||||
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
|
||||
'自动开启
|
||||
Setup.Set("VersionArgumentIndie", 1, Version:=PageVersionLeft.Version)
|
||||
Log("[Setup] 已自动开启单版本隔离:" & PageVersionLeft.Version.Name)
|
||||
@@ -121,9 +121,10 @@
|
||||
End Sub
|
||||
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextServerEnter.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextServerNide.ValidatedTextChanged, TextServerAuthName.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged
|
||||
If AniControlEnabled = 0 Then
|
||||
Dim HandledText As String = sender.Text
|
||||
If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/")
|
||||
Setup.Set(sender.Tag, HandledText, Version:=PageVersionLeft.Version)
|
||||
'#3194,不能删减 /
|
||||
'Dim HandledText As String = sender.Text
|
||||
'If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/")
|
||||
Setup.Set(sender.Tag, sender.Text, Version:=PageVersionLeft.Version)
|
||||
End If
|
||||
End Sub
|
||||
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
|
||||
@@ -398,14 +399,12 @@ PreFin:
|
||||
Private Sub BtnServerNideWeb_Click(sender As Object, e As EventArgs) Handles BtnServerNideWeb.Click
|
||||
OpenWebsite("https://login.mc-user.com:233/server/intro")
|
||||
End Sub
|
||||
Private Sub BtnServerNideBbs_Click(sender As Object, e As EventArgs) Handles BtnServerNideBbs.Click
|
||||
OpenWebsite("https://www.mcbbs.net/thread-729821-1-1.html")
|
||||
End Sub
|
||||
|
||||
'LittleSkin
|
||||
Private Sub BtnServerAuthLittle_Click(sender As Object, e As EventArgs) Handles BtnServerAuthLittle.Click
|
||||
If TextServerAuthServer.Text <> "" AndAlso TextServerAuthServer.Text <> "https://littleskin.cn/api/yggdrasil" AndAlso
|
||||
MyMsgBox("即将把第三方登录设置覆盖为自动使用 LittleSkin 登录,是否继续?", "覆盖确认", "确定", "取消") = 2 Then Exit Sub
|
||||
MyMsgBox("即将把第三方登录设置覆盖为 LittleSkin 登录。" & vbCrLf & "除非你是服主,或者服主要求你这样做,否则请不要继续。" & vbCrLf & vbCrLf & "是否确实需要覆盖当前设置?",
|
||||
"设置覆盖确认", "继续", "取消") = 2 Then Exit Sub
|
||||
TextServerAuthServer.Text = "https://littleskin.cn/api/yggdrasil"
|
||||
TextServerAuthRegister.Text = "https://littleskin.cn/auth/register"
|
||||
TextServerAuthName.Text = "LittleSkin 登录"
|
||||
@@ -439,7 +438,7 @@ PreFin:
|
||||
Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback)
|
||||
End Try
|
||||
'更新选择项
|
||||
If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then
|
||||
If SelectedItem Is Nothing AndAlso JavaList.Any Then
|
||||
If SelectedBySetup = "" Then
|
||||
SelectedItem = ComboArgumentJava.Items(1) '选中 “自动选择”
|
||||
Else
|
||||
|
||||
@@ -838,9 +838,6 @@
|
||||
<ItemGroup>
|
||||
<Resource Include="Images\Blocks\Fabric.png" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<Resource Include="Images\Heads\MCBBS.png" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<None Include="Resources\forge-installer.jar" />
|
||||
</ItemGroup>
|
||||
@@ -916,5 +913,8 @@
|
||||
<Resource Include="Images\Icons\Disabled.png" />
|
||||
<Resource Include="Images\Icons\Unavaliable.png" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<Resource Include="Images\Heads\MCBBS.png" />
|
||||
</ItemGroup>
|
||||
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
|
||||
</Project>
|
||||
@@ -30,7 +30,7 @@
|
||||
Text="任意项目都可以添加 Width 与 Height 属性来控制宽高。HorizontalAlignment 属性可以控制对齐:Center 代表居中,Right 代表居右,例如这段文本就被居右了。" />
|
||||
<TextBlock TextWrapping="Wrap" Margin="0,0,0,6"
|
||||
Text="Image 代表图片,你需要在它的 Source 属性中填写一个网址或文件路径,它会从该处获取图片并显示。通常需要使用 Height 限制它的高度。" />
|
||||
<Image Height="50" HorizontalAlignment="Center" Source="https://www.mcbbs.net/template/mcbbs/image/logo_sc.png" />
|
||||
<Image Height="50" HorizontalAlignment="Center" Source="https://zh.minecraft.wiki/images/Grass_Block_JE7_BE6.png?bf67e" />
|
||||
</StackPanel>
|
||||
</local:MyCard>
|
||||
|
||||
@@ -58,7 +58,7 @@
|
||||
<TextBlock TextWrapping="Wrap" Margin="0,0,0,10"
|
||||
Text="将按钮的 EventType 属性设为 打开网页,然后在 EventData 属性中写入网址,即可通过点击按钮打开网页。" />
|
||||
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
|
||||
Text="打开 MCBBS" EventType="打开网页" EventData="https://www.mcbbs.net/" />
|
||||
Text="打开 Minecraft Wiki" EventType="打开网页" EventData="https://zh.minecraft.wiki/" />
|
||||
<TextBlock TextWrapping="Wrap" Margin="0,10,0,10"
|
||||
Text="或者将 EventType 属性改为 弹出窗口,然后在 EventData 属性中写入弹窗的标题与内容……" />
|
||||
<local:MyButton Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
|
||||
@@ -119,7 +119,7 @@
|
||||
<TextBlock Margin="0,0,0,4"
|
||||
Text="· 下载文件:在点击时要求选择文件保存位置,并且下载 EventData 的链接中的文件" />
|
||||
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
|
||||
Text="下载 MCBBS 的 Logo" EventType="下载文件" EventData="https://www.mcbbs.net/template/mcbbs/image/logo_sc.png" />
|
||||
Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" />
|
||||
<TextBlock Margin="0,4,0,4"
|
||||
Text="· 打开帮助:跳转到 EventData 对应的帮助文件(输入相对 Help 文件夹的路径)"/>
|
||||
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
|
||||
@@ -153,7 +153,7 @@
|
||||
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
|
||||
Text="内存优化" EventType="内存优化" />
|
||||
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
|
||||
Text="下载作者的头像" EventType="下载文件" EventData="https://www.mcbbs.net/uc_server/data/avatar/000/14/51/06_avatar_small.jpg?ts=1471402592" />
|
||||
Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" />
|
||||
</StackPanel>
|
||||
</StackPanel>
|
||||
</local:MyCard>
|
||||
@@ -227,7 +227,7 @@
|
||||
<TextBlock TextWrapping="Wrap" Text=" 浓度 7 " Margin="5,0" Background="{DynamicResource ColorBrush7}" />
|
||||
<TextBlock TextWrapping="Wrap" Text=" 浓度 8 " Margin="5,0" Background="{DynamicResource ColorBrush8}" />
|
||||
</StackPanel>
|
||||
<TextBlock Margin="0,15,0,8" Foreground="{DynamicResource ColorBrush2}" Background="{DynamicResource ColorBrush6}"
|
||||
<TextBlock TextWrapping="Wrap" Margin="0,15,0,8" Foreground="{DynamicResource ColorBrush2}" Background="{DynamicResource ColorBrush6}"
|
||||
Text="除了字体颜色,你也可以将主题色用于背景色、边框颜色等颜色参数。例如这行字的颜色为浓度 2,背景为浓度 6。" />
|
||||
</StackPanel>
|
||||
</local:MyCard>
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large.
Load diff
Binary file not shown.
Binary file not shown.
@@ -29,8 +29,8 @@
|
||||
<!-- Windows Vista -->
|
||||
<!--<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />-->
|
||||
|
||||
<!-- Windows 7 -->
|
||||
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />
|
||||
<!-- Windows 7 --><!--
|
||||
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />-->
|
||||
|
||||
<!-- Windows 8 -->
|
||||
<!--<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />-->
|
||||
@@ -38,7 +38,7 @@
|
||||
<!-- Windows 8.1 -->
|
||||
<!--<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />-->
|
||||
|
||||
<!-- Windows 10 -->
|
||||
<!-- Windows 10+ -->
|
||||
<supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />
|
||||
|
||||
</application>
|
||||
|
||||
@@ -1,21 +1,29 @@
|
||||
## Plain Craft Launcher 2 源代码库
|
||||
# Plain Craft Launcher 源代码库
|
||||
|
||||
[](https://github.com/Hex-Dragon/PCL2/)
|
||||
[](https://github.com/Hex-Dragon/PCL2/issues)
|
||||
[](https://afdian.net/@LTCat)
|
||||
|
||||
<br/>
|
||||
|
||||
## 介绍
|
||||
|
||||
这里提供了 PCL 的大多数源代码,包括 UI 库、动画模块、下载模块、Minecraft 启动模块等!
|
||||
|
||||
PCL 的代码绝大多数其实都是几年前学生时代的产物了……那时候英语还不过关……所以经常出现奇葩命名,还有令人高血压的高耦合啊,没做单例啊,瞎勾八乱糊啊之类的问题……额,我也不可能把这一堆玩意儿再从头写一次,各位就基于能跑就行的原则凑合凑合着看吧,求求别喷了(run
|
||||
PCL 的代码绝大多数其实都是几年前学生时代的产物了……那时候英语还不过关……所以经常出现奇葩命名,还有令人高血压的高耦合啊,没做单例啊,瞎勾八乱糊啊之类的问题……额,我也不可能把这一堆玩意儿再从头写一次,各位就基于能跑就行的原则凑合凑合着看吧,求求别喷了……
|
||||
|
||||
你也可以丢 Pull Request,虽然这个源代码库并不能直接编译,但一些简单的修改应该还是没问题的……
|
||||
|
||||
|
||||
<br/>
|
||||
|
||||
**相关内容:**
|
||||
## 相关内容
|
||||
- [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的帖子!
|
||||
- [程序下载](https://afdian.net/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
|
||||
- [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 帮助文档在 GitHub 上的存储库(是的,帮助库在另一个 Repo……)
|
||||
|
||||
|
||||
<br/>
|
||||
|
||||
**一些无趣的小细节:**
|
||||
- 别想在这里面找到解密游戏的线索,那部分的代码被我抠掉了(笑)
|
||||
- 哦,对,解锁隐藏主题的相关代码也都被抠掉了,所以别想着用翻源代码这种歪门邪道来绕过解密了.jpg
|
||||
## 一些无趣的小细节
|
||||
- 别想在这里面找到解密游戏的线索,那部分的代码被我抠掉了
|
||||
- 解锁隐藏主题的相关代码也被抠掉了,所以别想着用翻源代码这种歪门邪道来绕过解密了.jpg
|
||||
- 源代码库并不是即时更新的,而是在每次 PCL 发布更新时(手动)同步一次
|
||||
Reference in new issue
Block a user