root/Gitcloned-PCL-CE
1
1
Fork 0
Code Issues Pull Requests Projects Releases 2 Activity

2.4.4

Browse Source
This commit is contained in:
龙腾猫跃
2022-12-12 02:34:19 +08:00
parent 5fb5a3b963
commit fd329037e7
39 changed files with 624 additions and 423 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
Plain Craft Launcher 2/Application.xaml
View File

@@ -23,7 +23,9 @@
<SolidColorBrush x:Key="ColorBrush6">#d5e6fd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush7">#e0eafd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush8">#eaf2fe</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush9">#80e0eafd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBg0">#96c0f9</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBg1">#bee0eafd</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBg2">#50e0eafd</SolidColorBrush>
<Color x:Key="ColorObject1">#343d4a</Color>
<Color x:Key="ColorObject2">#0b5bcb</Color>
<Color x:Key="ColorObject3">#1370f3</Color>
@@ -32,7 +34,9 @@
<Color x:Key="ColorObject6">#d5e6fd</Color>
<Color x:Key="ColorObject7">#e0eafd</Color>
<Color x:Key="ColorObject8">#eaf2fe</Color>
<Color x:Key="ColorObject9">#40eaf2fe</Color>
<Color x:Key="ColorObjectBg0">#96c0f9</Color>
<Color x:Key="ColorObjectBg1">#bee0eafd</Color>
<Color x:Key="ColorObjectBg2">#50e0eafd</Color>
<SolidColorBrush x:Key="ColorBrushGray1">#404040</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray2">#737373</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushGray3">#8c8c8c</SolidColorBrush>
@@ -53,6 +57,8 @@
<SolidColorBrush x:Key="ColorBrushRedLight">#ff4c4c</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushRedDark">#ce2111</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushHalfWhite" Color="#44ffffff" />
<SolidColorBrush x:Key="ColorBrushSemiWhite" Color="#bbffffff" />
<SolidColorBrush x:Key="ColorBrushWhite" Color="#ffffff" />
<SolidColorBrush x:Key="ColorBrushTransparent" Color="Transparent" />
<SolidColorBrush x:Key="ColorBrushSemiTransparent">#01eaf2fe</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#D2FFFFFF" />
@@ -258,7 +264,7 @@
<!-- TextBox -->
<Style TargetType="local:MyTextBox">
<Setter Property="BorderThickness" Value="1" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="Background" Value="{StaticResource ColorBrushBg2}" />
<Setter Property="FontSize" Value="13" />
<Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
@@ -274,7 +280,7 @@
<Setter Property="Stylus.IsFlicksEnabled" Value="False"/>
<Setter Property="UndoLimit" Value="15" />
<Setter Property="MaxLength" Value="10000" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush1}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="TextBox">
@@ -283,14 +289,14 @@
<RowDefinition MinHeight="28" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" VerticalAlignment="Center" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{StaticResource ColorBrushGray3}" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<Border x:Name="border" BorderThickness="{TemplateBinding BorderThickness}" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" CornerRadius="3">
<ScrollViewer x:Name="PART_ContentHost" Style="{StaticResource ScrollViewerNoMargin}" RenderOptions.ClearTypeHint="Enabled" BorderThickness="0"
Margin="5,0,0,0" Cursor="IBeam" />
<!-- 由于未知原因，TextView 会有 2,0 的 Margin -->
</Border>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" VerticalAlignment="Center" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.3" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" />
</Grid>
</ControlTemplate>
@@ -302,8 +308,8 @@
<Setter Property="VerticalContentAlignment" Value="Top" />
<Setter Property="SelectionBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Background" Value="{StaticResource ColorBrushBg2}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="KeyboardNavigation.TabNavigation" Value="None"/>
<Setter Property="HorizontalContentAlignment" Value="Left"/>
<Setter Property="FocusVisualStyle" Value="{x:Null}"/>
@@ -317,19 +323,20 @@
<ControlTemplate.Triggers>
<Trigger Property="IsEnabled" Value="False">
<Trigger.Setters>
<Setter Property="Foreground" Value="{StaticResource ColorBrushGray4}" />
<Setter Property="BorderBrush" Value="{StaticResource ColorBrushGray4}" />
<Setter Property="BorderBrush" Value="{StaticResource ColorBrushGray5}" />
<Setter Property="Background" Value="{StaticResource ColorBrushGray6}" />
</Trigger.Setters>
</Trigger>
<Trigger Property="IsMouseOver" Value="True">
<Trigger.Setters>
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush4}" />
<Setter Property="Background" Value="{DynamicResource ColorBrush7}" />
</Trigger.Setters>
</Trigger>
<Trigger Property="IsFocused" Value="True">
<Trigger.Setters>
<Setter Property="Background" Value="{DynamicResource ColorBrush9}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush4}" />
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrush3}" />
<Setter Property="Background" Value="{DynamicResource ColorBrushSemiWhite}" />
</Trigger.Setters>
</Trigger>
</ControlTemplate.Triggers>
@@ -348,16 +355,12 @@
</local:MyListItem.Buttons>
</local:MyListItem>
</DataTemplate>
<!--<DataTemplate x:Key="ComboBoxItemTemplateNormal">
<local:MyListItem Title="{Binding}" FontSize="13" PaddingRight="40" Height="26" Margin="-1,0,0,0" />
</DataTemplate>-->
<Style TargetType="local:MyComboBox">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="SnapsToDevicePixels" Value="True" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrush1}" />
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="Foreground" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="Background" Value="{DynamicResource ColorBrushBg2}" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<!--<Setter Property="ItemTemplate" Value="{StaticResource ComboBoxItemTemplateNormal}"/>-->
<Setter Property="FontSize" Value="13" />
<Setter Property="MaxDropDownHeight" Value="160" />
<Setter Property="Template">

10
Plain Craft Launcher 2/Application.xaml.vb
View File

@@ -49,7 +49,7 @@ Public Class Application
Directory.CreateDirectory(PathTemp)
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL2 没有对 " & PathTemp & " 的访问权限")
Catch ex As Exception
MyMsgBox("手动设置的缓存文件夹不可用，PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因：" & GetString(ex, False), "缓存文件夹不可用")
MyMsgBox("手动设置的缓存文件夹不可用，PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因：" & GetExceptionDetail(ex), "缓存文件夹不可用")
Setup.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\"
End Try
@@ -104,7 +104,7 @@ Public Class Application
#End If
AniControlEnabled += 1
Catch ex As Exception
MsgBox(GetString(ex, False, True), MsgBoxStyle.Critical, "PCL2 初始化错误")
MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL2 初始化错误")
FormMain.EndProgramForce(Result.Exception)
End Try
End Sub
@@ -126,13 +126,13 @@ Public Class Application
Exit Sub
End If
IsCritErrored = True
Dim ExceptionString As String = GetString(e.Exception, False, True)
Dim ExceptionString As String = GetExceptionDetail(e.Exception, True)
If ExceptionString.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse
ExceptionString.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse
ExceptionString.Contains(".Net Framework") OrElse ' “自动错误判断” 的结果分析
ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析
ExceptionString.Contains("未能加载文件或程序集") Then
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
MsgBox("你的 .Net Framework 版本过低或损坏，请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试！", MsgBoxStyle.Information, "运行环境错误")
MsgBox("你的 .NET Framework 版本过低或损坏，请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试！", MsgBoxStyle.Information, "运行环境错误")
FormMain.EndProgramForce(Result.Cancel)
Else
FeedbackInfo()

2
Plain Craft Launcher 2/Controls/MyButton.xaml.vb
View File

@@ -177,7 +177,7 @@
}, "MyButton Scale " & Uuid)
End Sub
Private Sub Button_MouseEnter() Handles Me.MouseEnter
AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush9"), AnimationColorIn), "MyButton Background " & Uuid)
AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrushBg1"), AnimationColorIn), "MyButton Background " & Uuid)
End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub

4
Plain Craft Launcher 2/Controls/MyCard.vb
View File

@@ -130,7 +130,9 @@
Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7
Stack.Children.Add(McDownloadListItem(Data, AddressOf FrmDownloadInstall.MinecraftSelected, False))
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) '不能使用 AddressOf，这导致了 #535，原因完全不明，疑似是编译器 Bug
FrmDownloadInstall.MinecraftSelected(sender, e)
End Sub, False))
Case 8
Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Save_Click))
Case 9

2
Plain Craft Launcher 2/Controls/MyCheckBox.xaml
View File

@@ -5,7 +5,7 @@
FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True" d:DesignWidth="126.4" d:DesignHeight="44.8">
<TextBlock IsHitTestVisible="False" FontSize="13" x:Name="LabText" Padding="0" Margin="26,0,0,0" Text="Checkbox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" />
<Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushHalfWhite}" />
<Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushBg2}" />
<Path IsHitTestVisible="False" x:Name="ShapeCheck" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding BorderBrush, ElementName=ShapeBorder}" Width="12" Height="12" Margin="4,0,0,0" Data="M0,6L1.5,4.5 4.5,7.5 10.5,1.5 12,3 4.5,10.5 0,6z">
<Path.RenderTransform>
<ScaleTransform CenterX="6" CenterY="6" ScaleX="0" ScaleY="0" />

6
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
View File

@@ -124,13 +124,13 @@
Log("[Control] 按下复选框（" & (Not Checked).ToString & "）：" & Text)
MouseDowned = False
SetChecked(Not Checked, True, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg2", 100), "MyCheckBox Background " & Uuid)
End Sub
Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
If Not AllowMouseDown Then Exit Sub
MouseDowned = True
Focus()
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrush9", 100), "MyCheckBox Background " & Uuid)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg1", 100), "MyCheckBox Background " & Uuid)
If Checked Then
AniStart({
AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True),
@@ -143,7 +143,7 @@
Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
MouseDowned = False
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg2", 100), "MyCheckBox Background " & Uuid)
If Checked Then
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True),

40
Plain Craft Launcher 2/Controls/MyComboBox.vb
View File

@@ -62,44 +62,40 @@
'指向动画
Public Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp, Me.GotKeyboardFocus
'判断当前颜色
Dim ColorName As String
Dim BackName As String
Dim ForeColorName As String
Dim BackColorName As String
Dim Time As Integer
If IsEnabled Then
If IsEditable AndAlso Template.FindName("PART_EditableTextBox", Me).IsFocused Then
ColorName = "ColorBrush4"
BackName = "ColorBrush9"
Time = 60
ElseIf IsMouseDown OrElse IsDropDownOpen Then
ColorName = "ColorBrush3"
BackName = "ColorBrush9"
Time = 60
If IsMouseDown OrElse IsDropDownOpen OrElse (IsEditable AndAlso Template.FindName("PART_EditableTextBox", Me).IsFocused) Then
ForeColorName = "ColorBrush3"
BackColorName = "ColorBrushSemiWhite"
Time = 10
ElseIf IsMouseOver Then
ColorName = "ColorBrush3"
BackName = "ColorBrushHalfWhite"
Time = 100
ForeColorName = "ColorBrush4"
BackColorName = "ColorBrush7"
Time = 50
Else
ColorName = "ColorBrush1"
BackName = "ColorBrushHalfWhite"
Time = 200
ForeColorName = "ColorBrushBg0"
BackColorName = "ColorBrushBg2"
Time = 50
End If
Else
ColorName = "ColorBrushGray4"
BackName = "ColorBrushHalfWhite"
ForeColorName = "ColorBrushGray5"
BackColorName = "ColorBrushGray6"
Time = 200
End If
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({
AaColor(Me, ForegroundProperty, ColorName, Time),
AaColor(Me, BackgroundProperty, BackName, Time)
AaColor(Me, ForegroundProperty, ForeColorName, Time),
AaColor(Me, BackgroundProperty, BackColorName, Time)
}, "MyComboBox Color " & Uuid)
Else
'无动画
AniStop("MyComboBox Color " & Uuid)
SetResourceReference(ForegroundProperty, ColorName)
SetResourceReference(BackgroundProperty, BackName)
SetResourceReference(ForegroundProperty, ForeColorName)
SetResourceReference(BackgroundProperty, BackColorName)
End If
End Sub

43
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
View File

@@ -507,27 +507,26 @@
'触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
'触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then
ModEvent.TryStartEvent(EventType, EventData)
e.Handled = True
End If
If e.Handled Then Exit Sub
'实际的单击处理
Select Case Type
Case CheckType.Clickable
Log("[Control] 按下单击列表项：" & Title)
Case CheckType.RadioBox
Log("[Control] 按下单选列表项：" & Title)
If Not Checked Then SetChecked(True, True, True)
Case CheckType.CheckBox
Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title)
SetChecked(Not Checked, True, True)
End Select
If Not IsMouseDown Then Exit Sub
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
'触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then
ModEvent.TryStartEvent(EventType, EventData)
e.Handled = True
End If
If e.Handled Then Exit Sub
'实际的单击处理
Select Case Type
Case CheckType.Clickable
Log("[Control] 按下单击列表项：" & Title)
Case CheckType.RadioBox
Log("[Control] 按下单选列表项：" & Title)
If Not Checked Then SetChecked(True, True, True)
Case CheckType.CheckBox
Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title)
SetChecked(Not Checked, True, True)
End Select
'AniStart({
' AaScaleTransform(Me, 1.004 - CType(RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent),
' AaScaleTransform(Me, -0.004, 100, 150, New AniEaseInFluent)
@@ -603,7 +602,7 @@
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush9"), Time),
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsScaleAnimationEnabled Then
@@ -630,7 +629,7 @@
If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then
If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1
'由于鼠标已经移入，所以直接实例化 RectBack
RectBack.Background = Color9
RectBack.Background = ColorBg1
RectBack.Opacity = 1
RectBack.RenderTransform = New ScaleTransform(1, 1)
Me.RenderTransform = New ScaleTransform(1, 1)

6
Plain Craft Launcher 2/Controls/MyRadioBox.xaml
View File

@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Text="Radiobox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushHalfWhite}" />
<Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" />
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Text="Radiobox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushBg2}" />
<Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" />
</Grid>

6
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
View File

@@ -170,12 +170,12 @@
MouseDowned = False
Log("[Control] 按下单选框：" & Text)
SetChecked(True, True, True)
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushBg2", 100), "MyRadioBox Background " & Uuid)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
MouseDowned = True
Focus()
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrush9", 100), "MyRadioBox Background " & Uuid)
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushBg1", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then
AniStart(AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid)
End If
@@ -183,7 +183,7 @@
Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
MouseDowned = False
AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushBg2", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then
AniStart(AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid)
End If

10
Plain Craft Launcher 2/Controls/MySlider.xaml
View File

@@ -6,11 +6,13 @@
mc:Ignorable="d"
d:DesignHeight="16" d:DesignWidth="162"
FocusVisualStyle="{x:Null}"
MinHeight="16" UseLayoutRounding="False" SnapsToDevicePixels="False" BorderBrush="{DynamicResource ColorBrush1}" Name="PanBack" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
MinHeight="16" UseLayoutRounding="False" SnapsToDevicePixels="False" BorderBrush="{DynamicResource ColorBrush4}" Name="PanBack" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<Grid x:Name="PanMain" MinHeight="16" MaxHeight="16" IsHitTestVisible="False">
<Line Height="4" Name="LineBack" Stroke="{StaticResource ColorBrushGray5}" StrokeThickness="1.1" X2="10000" Y1="2" Y2="2" HorizontalAlignment="Right" Width="0" SnapsToDevicePixels="True" Margin="0,0,1,0" />
<Line Height="4" Name="LineFore" Stroke="{Binding ElementName=PanBack, Path=BorderBrush}" StrokeThickness="1.1" X2="10000" Y1="2" Y2="2" Width="0" HorizontalAlignment="Left" SnapsToDevicePixels="True" Margin="1,0,0,0" />
<Ellipse HorizontalAlignment="Left" Width="16" Stroke="{Binding BorderBrush, ElementName=PanBack}" StrokeThickness="1.1" Fill="{StaticResource ColorBrushHalfWhite}" Name="ShapeDot" Height="16" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5">
<Line Height="4" Name="LineBack" Stroke="{DynamicResource ColorBrushBg0}" Opacity="0.3" StrokeThickness="1.6" X2="10000" Y1="2" Y2="2" HorizontalAlignment="Right" Width="0" SnapsToDevicePixels="True" Margin="0,0,1,0" />
<Line Height="4" Name="LineFore" Stroke="{Binding ElementName=PanBack, Path=BorderBrush}" StrokeThickness="1.6" X2="10000" Y1="2" Y2="2" Width="0" HorizontalAlignment="Left" SnapsToDevicePixels="True" Margin="1,0,0,0" />
<Ellipse HorizontalAlignment="Left" Width="10" Height="10"
Stroke="{Binding BorderBrush, ElementName=PanBack}" StrokeThickness="1.2"
Fill="{DynamicResource ColorBrush4}" Name="ShapeDot" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5">
<Ellipse.RenderTransform>
<ScaleTransform />
</Ellipse.RenderTransform>

46
Plain Craft Launcher 2/Controls/MySlider.xaml.vb
View File

@@ -45,13 +45,13 @@
End If
If IsLoaded AndAlso AniControlEnabled = 0 Then
If ActualWidth < 16 Then Exit Property
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16)
Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - 16) - _Value / MaxValue)
If ActualWidth < ShapeDot.Width Then Exit Property
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - ShapeDot.Width) - _Value / MaxValue)
Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
AniStart({
AaWidth(LineFore, Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) - LineFore.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
AaWidth(LineBack, Math.Max(0, ActualWidth - 16 - NewWidth + If(ActualWidth - 16 - NewWidth < 0.5, 0, 0.5)) - LineBack.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
AaWidth(LineBack, Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5)) - LineBack.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)),
AaX(ShapeDot, NewWidth - ShapeDot.Margin.Left, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear))
}, "MySlider Progress " & Uuid)
Else
@@ -67,9 +67,9 @@
Private Sub RefreshWidth(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not IsNothing(e) Then PanMain.Width = e.NewSize.Width
AniStop("MySlider Progress " & Uuid)
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16)
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5))
LineBack.Width = Math.Max(0, ActualWidth - 16 - NewWidth + If(ActualWidth - 16 - NewWidth < 0.5, 0, 0.5))
LineBack.Width = Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5))
SetLeft(ShapeDot, NewWidth)
End Sub
@@ -79,9 +79,10 @@
Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
e.Handled = True '防止 ScrollViewer 失焦问题
DragControl = Me
RefreshColor()
FrmMain.DragDoing()
AniStart({
AaScaleTransform(ShapeDot, 0.8 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 75,, New AniEaseOutFluent)
AaScaleTransform(ShapeDot, 1.3 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 40,, New AniEaseOutFluent)
}, "MySlider Scale " & Uuid)
'更新 Popup
If GetHintText IsNot Nothing Then
@@ -91,7 +92,7 @@
End If
End Sub
Public Sub DragDoing()
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - 8) / (ActualWidth - 16), 0, 1)
Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then
Value = NewValue
@@ -113,28 +114,39 @@
Try
'判断当前颜色
Dim ColorName As String
Dim ForegroundName As String, DotFillName As String
Dim AnimationTime As Integer
If IsEnabled Then
If IsMouseOver OrElse (Not IsNothing(DragControl) AndAlso DragControl.Equals(Me)) Then
ColorName = "ColorBrush3"
AnimationTime = 100
If Not IsNothing(DragControl) AndAlso DragControl.Equals(Me) Then
ForegroundName = "ColorBrush3"
DotFillName = "ColorBrush3"
AnimationTime = 40
ElseIf IsMouseOver Then
ForegroundName = "ColorBrush3"
DotFillName = "ColorBrush3"
AnimationTime = 40
Else
ColorName = "ColorBrush1"
AnimationTime = 200
ForegroundName = "ColorBrush4"
DotFillName = "ColorBrush4"
AnimationTime = 100
End If
Else
ColorName = "ColorBrushGray4"
ForegroundName = "ColorBrushGray5"
DotFillName = "ColorBrushGray5"
AnimationTime = 200
End If
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
AniStart({AaColor(Me, BorderBrushProperty, ColorName, AnimationTime)}, "MySlider Color " & Uuid)
AniStart({
AaColor(Me, BorderBrushProperty, ForegroundName, AnimationTime),
AaColor(ShapeDot, Ellipse.FillProperty, DotFillName, AnimationTime)
}, "MySlider Color " & Uuid)
Else
'无动画
AniStop("MySlider Color " & Uuid)
SetResourceReference(BorderBrushProperty, ColorName)
SetResourceReference(BorderBrushProperty, ForegroundName)
ShapeDot.SetResourceReference(Ellipse.FillProperty, DotFillName)
End If
Catch ex As Exception

33
Plain Craft Launcher 2/Controls/MyTextBox.vb
View File

@@ -212,35 +212,26 @@
If IsEnabled Then
If ValidateResult = "" OrElse Not IsTextChanged Then
If IsFocused Then
ForeColorName = "ColorBrush4"
BackColorName = "ColorBrush9"
AnimationTime = 60
ElseIf IsMouseOver Then
ForeColorName = "ColorBrush3"
BackColorName = "ColorBrushHalfWhite"
AnimationTime = 100
Else
ForeColorName = "ColorBrush1"
BackColorName = "ColorBrushHalfWhite"
AnimationTime = 200
BackColorName = "ColorBrushSemiWhite"
AnimationTime = 10
ElseIf IsMouseOver Then
ForeColorName = "ColorBrush4"
BackColorName = "ColorBrush7"
AnimationTime = 50
Else '未选中
ForeColorName = "ColorBrushBg0"
BackColorName = "ColorBrushBg2"
AnimationTime = 50
End If
Else
ForeColorName = "ColorBrushRedLight"
BackColorName = "ColorBrushRedBack"
AnimationTime = 200
'If IsFocused OrElse IsMouseOver Then
' ForeColorName = "ColorBrushRedLight"
' BackColorName = "ColorBrushRedBack"
' AnimationTime = 100
'Else
' ForeColorName = "ColorBrushRedDark"
' BackColorName = "ColorBrushHalfWhite"
' AnimationTime = 200
'End If
End If
Else
ForeColorName = "ColorBrushGray4"
BackColorName = "ColorBrushHalfWhite"
ForeColorName = "ColorBrushGray5"
BackColorName = "ColorBrushGray6"
AnimationTime = 200
End If
'触发颜色动画

2
Plain Craft Launcher 2/FormMain.xaml
View File

@@ -160,7 +160,7 @@
</Border>
</Border>
</Grid>
<StackPanel x:Name="PanHint" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" IsHitTestVisible="False" Grid.RowSpan="2" />
<StackPanel x:Name="PanHint" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" Grid.RowSpan="2" />
<StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15">
<local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed"
Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" />

19
Plain Craft Launcher 2/FormMain.xaml.vb
View File

@@ -10,11 +10,14 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 270 Then 'Release 2.4.3
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 += 6
BugCount += 15
FeatureCount += 13
BugCount += 23
End If
If LastVersion < 268 Then 'Release 2.4.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
@@ -106,6 +109,14 @@ Public Class FormMain
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'1：BUG-
If LastVersion < 273 Then 'Snapshot 2.4.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修改部分配色，让整体边框变得更淡"))
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"))
@@ -1062,7 +1073,7 @@ Install:
''' <summary>
''' 上层页面的编号堆栈，用于返回。
''' </summary>
Private ReadOnly PageStack As New List(Of PageStackData)
Public PageStack As New List(Of PageStackData)
Public Class PageStackData
Public Page As PageType

154
Plain Craft Launcher 2/Modules/Base/ModBase.vb
View File

@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.4.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.3." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.4.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.4." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 270 'Release
Public Const VersionCode As Integer = 272 'Release
#Else
Public Const VersionCode As Integer = 271 'Snapshot
Public Const VersionCode As Integer = 273 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -789,7 +789,7 @@ Public Module ModBase
''' 读取文件，如果失败则返回空字符串。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String) As String
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Try
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
@@ -799,7 +799,7 @@ Public Module ModBase
ReDim FileBytes(ReadStream.Length - 1)
ReadStream.Read(FileBytes, 0, ReadStream.Length)
End Using
ReadFile = DecodeBytes(FileBytes)
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
Else
Log("[System] 欲读取的文件不存在，已返回空字符串：" & FilePath)
Return ""
@@ -1223,7 +1223,7 @@ Re:
Return Nothing
Catch ex As Exception
Log(ex, "检查文件出错")
Return GetString(ex)
Return GetExceptionSummary(ex)
End Try
End Function
End Class
@@ -1325,59 +1325,99 @@ Re:
Public vbRQ As Char = Convert.ToChar(8221)
''' <summary>
''' 提取 Exception 摘要。
''' 提取 Exception 的具体描述与堆栈。
''' </summary>
''' <param name="IsLine">输出是否强制为单行，单行模型下不会输出调用堆栈。</param>
Public Function GetString(Ex As Exception, Optional IsLine As Boolean = True, Optional ShowAllTrace As Boolean = False) As String
''' <param name="ShowAllTrace">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllTrace As Boolean = False) As String
If Ex Is Nothing Then Return "无可用错误信息！"
Dim Desc As New List(Of String)
'自动错误判断
Dim RealEx = Ex
Do Until RealEx.InnerException Is Nothing
RealEx = RealEx.InnerException
'获取最底层的异常
Dim InnerEx As Exception = Ex
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
Loop
If TypeOf RealEx Is TypeLoadException OrElse TypeOf RealEx Is MissingMethodException OrElse TypeOf RealEx Is NotImplementedException OrElse TypeOf RealEx Is TypeInitializationException Then
Desc.Add("系统环境存在问题，请尝试重装 .Net Framework 4.6.2 后再试")
ElseIf TypeOf RealEx Is UnauthorizedAccessException Then
Desc.Add("PCL2 权限不足，请尝试右键 PCL2，选择以管理员身份运行")
ElseIf TypeOf RealEx Is OutOfMemoryException Then
Desc.Add("电脑运行内存不足，PCL2 无法继续运行")
'获取各级错误的描述与堆栈信息
Dim DescList As New List(Of String)
Dim StackList As New List(Of String)
Do Until Ex Is Nothing
DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
If Ex.StackTrace IsNot Nothing Then
For Each St As String In Ex.StackTrace.Split(vbCrLf)
If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then StackList.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
Next
End If
Ex = Ex.InnerException
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 CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL2 的权限不足。请尝试右键 PCL2，选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
CommonReason = "你的电脑运行内存不足，导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳，导致难以连接到服务器。请重试，或尝试使用 VPN。"
End If
If IsLine Then
'无内部错误的快速处理
If Ex.InnerException Is Nothing Then
If Desc.Count = 0 Then
Return Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " ")
Else
Return Desc.First
End If
End If
'构造输出信息
Do Until Ex Is Nothing
Desc.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " "))
Ex = Ex.InnerException
Loop
Desc.Reverse() '让最深层错误在最左边
GetString = Join(Desc, " → ")
'获取错误类型
Dim TypeDesc As String = If(InnerEx.GetType.FullName = "System.Exception", "", vbCrLf & "错误类型：" & InnerEx.GetType.FullName)
'构造输出信息
If CommonReason Is Nothing Then
Return Desc & Stack & TypeDesc
Else
Dim Stack As New List(Of String)
'逐级追加描述与堆栈
Do Until Ex Is Nothing
Desc.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
If Ex.StackTrace IsNot Nothing Then
For Each St As String In Ex.StackTrace.Split(vbCrLf)
If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then Stack.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
Next
End If
Ex = Ex.InnerException
Loop
'构造输出信息
Dim TypeName As String = RealEx.GetType.FullName
GetString = Join(Desc, vbCrLf & "Caused By: ") & If(Stack.Count > 0, vbCrLf & Join(Stack, vbCrLf), "") & If(TypeName = "System.Exception", "", vbCrLf & "错误类型：" & TypeName)
Return DescList.First & vbCrLf & CommonReason & vbCrLf & "————————————" & vbCrLf &
"详细错误信息：" & vbCrLf & "→ " & Join(DescList.GetRange(1, DescList.Count - 1), vbCrLf & "→ ") & Stack & TypeDesc
End If
End Function
''' <summary>
''' 提取 Exception 描述，汇总到一行。
''' </summary>
Public Function GetExceptionSummary(Ex As Exception) As String
If Ex Is Nothing Then Return "无可用错误信息！"
'获取最底层的异常
Dim InnerEx As Exception = Ex
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
Loop
'获取各级错误的描述
Dim DescList As New List(Of String)
Do Until Ex Is Nothing
DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " "))
Ex = Ex.InnerException
Loop
DescList = DescList.Distinct.ToList
'常见错误
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL2 的权限不足。请尝试右键 PCL2，选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
CommonReason = "你的电脑运行内存不足，导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳，导致难以连接到服务器。请重试，或尝试使用 VPN。"
End If
'构造输出信息
If CommonReason IsNot Nothing Then
Return DescList.First & "：" & CommonReason
Else
DescList.Reverse() '让最深层错误在最左边
Return Join(DescList, " → ")
End If
End Function
''' <summary>
''' 返回一个枚举对应的字符串。
''' </summary>
@@ -2432,10 +2472,10 @@ Retry:
IsErrorTriggered = True
'获取错误信息
Dim ExFull As String = Desc & "：" & GetString(Ex, False)
Dim ExFull As String = Desc & "：" & GetExceptionDetail(Ex)
'输出日志
Dim AppendText As String = "[" & GetTimeNow() & "] " & Desc & "：" & GetString(Ex, False, True) & vbCrLf '减轻同步锁占用
Dim AppendText As String = "[" & GetTimeNow() & "] " & Desc & "：" & GetExceptionDetail(Ex, True) & vbCrLf '减轻同步锁占用
If ModeDebug Then
SyncLock LogListLock
LogList.Append(AppendText)
@@ -2453,19 +2493,19 @@ Retry:
Case LogLevel.Normal
#If DEBUG Then
Case LogLevel.Developer
Dim ExLine As String = Desc & "：" & GetString(Ex, True)
Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
Hint("[开发者模式] " & ExLine, HintType.Info, False)
Case LogLevel.Debug
Dim ExLine As String = Desc & "：" & GetString(Ex, True)
Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
Hint("[调试模式] " & ExLine, HintType.Info, False)
#Else
Case LogLevel.Developer
Case LogLevel.Debug
Dim ExLine As String = Desc & "：" & GetString(Ex, True)
Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False)
#End If
Case LogLevel.Hint
Dim ExLine As String = Desc & "：" & GetString(Ex, True)
Dim ExLine As String = Desc & "：" & GetExceptionSummary(Ex)
Hint(ExLine, HintType.Critical, False)
Case LogLevel.Msgbox
MyMsgBox(ExFull, Title)

16
Plain Craft Launcher 2/Modules/Base/ModNet.vb
View File

@@ -412,7 +412,7 @@ RequestFinished:
Throw
Catch ex As WebException
If ex.Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时，请检查你的网络环境是否良好（" & Url & "）", ex)
Throw New WebException("连接服务器超时，请检查你的网络环境是否良好（" & Url & "）", ex)
Else
'获取请求失败的返回
Dim Res As String = ""
@@ -1183,10 +1183,10 @@ SourceBreak:
Next
End SyncLock
End SyncLock
Dim IsTimeoutString As String = GetString(ex, False).ToLower.Replace(" ", "")
Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
IsTimeoutString.Contains("超时") OrElse IsTimeoutString.Contains("timeout") OrElse IsTimeoutString.Contains("timedout")
Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#：超时（" & (Timeout * 0.001) & "s）", "#：出错，" & GetString(ex, False)))
Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#：超时（" & (Timeout * 0.001) & "s）", "#：出错，" & GetExceptionDetail(ex)))
Info.State = NetState.Error
''使用该下载源的线程是否没有速度
''下载超时也会导致没有速度，容易误判下载失败，所以已弃用此方法
@@ -1697,12 +1697,16 @@ Retry:
SyncLock LockState
If State > LoadState.Loading Then Exit Sub
If ExList Is Nothing OrElse ExList.Count = 0 Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
[Error] = ExList(0)
'寻找第一个不是 404 的下载源
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0))
'获取实际失败的文件
SyncLock FilesLock
For Each File In Files
If File.State = NetState.Error Then
[Error] = New Exception("文件下载失败：" & File.LocalPath & "（第一下载源：" & File.Sources(0).Url & "）", ExList(0))
[Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf & Join(
File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")).ToList(),
vbCrLf), [Error])
Exit For
End If
Next
@@ -1719,7 +1723,7 @@ Retry:
'在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList
ErrOutput.Add(GetString(Ex, False))
ErrOutput.Add(GetExceptionDetail(Ex))
Next
Log("[Download] " & Join(ArrayNoDouble(ErrOutput.ToArray), vbCrLf))
End Sub

6
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
View File

@@ -88,7 +88,7 @@
If FilePath.Contains("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, File.ReadAllLines(FilePath, Encoding.UTF8)))
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath, Encoding.UTF8).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
End If
Catch ex As Exception
Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）")
@@ -135,7 +135,7 @@
If TargetFile.Name.StartsWith("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, File.ReadAllLines(TargetFile.FullName, Encoding.UTF8)))
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr)))
End If
End If
Catch ex As Exception
@@ -771,7 +771,7 @@ Redo:
Case CrashReason.内存不足
ResultString = "Minecraft 内存不足，导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足，或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存，删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效，请在开始游戏前尽量关闭其他软件，或者……换台电脑？\h"
Case CrashReason.使用OpenJ9
ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java 8，然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。"
ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java，然后再启动游戏。"
Case CrashReason.使用JDK
ResultString = "游戏似乎因为使用 JDK，或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8（Java 8），然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。"
Case CrashReason.Java版本过高

10
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
View File

@@ -610,7 +610,7 @@
Try
Result = NetGetCodeByDownload("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
Catch ex As Exception
If GetString(ex).Contains("(404)") Then
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
Else
Throw
@@ -1254,6 +1254,12 @@
''' CurseForge 工程列表获取事件。
''' </summary>
Public Sub DlCfProjectSub(Task As LoaderTask(Of DlCfProjectRequest, DlCfProjectResult))
'拒绝 1.13- Quilt（这个版本根本没有 Quilt）
If Not Task.Input.IsModPack AndAlso
If(Task.Input.ModLoader, 0) = 5 AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion)
End If
Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim
Task.Input.SearchFilter = RawFilter
RawFilter = RawFilter.ToLower
@@ -1487,7 +1493,7 @@
Dim Versions As New List(Of String)
For Each Version In Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower)
If Version.StartsWith("1.") OrElse Version.Contains("w") Then
Versions.Add(Version)
Versions.Add(Version.Replace("-snapshot", " 快照"))
ElseIf Version = "forge" OrElse Version = "fabric" OrElse Version = "quilt" OrElse Version = "rift" Then
ModLoaders.Add(Version.First.ToString.ToUpper & Version.Substring(1))
End If

158
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
View File

@@ -4,22 +4,73 @@ Public Module ModLaunch
#Region "开始"
Public Class McLaunchOptions
''' <summary>
''' 强制指定在启动后进入的服务器 IP。
''' 默认值：Nothing。使用版本设置的值。
''' </summary>
Public ServerIp As String = Nothing
''' <summary>
''' 将启动脚本保存到该地址，然后取消启动。这同时会改变启动时的提示等。
''' 默认值：Nothing。不保存。
''' </summary>
Public SaveBatch As String = Nothing
''' <summary>
''' 强行指定启动的 MC 版本。
''' 默认值：Nothing。使用 McVersionCurrent。
''' </summary>
Public Version As McVersion = Nothing
End Class
''' <summary>
''' 尝试启动 Minecraft。必须在 UI 线程调用。
''' 返回是否实际开始了启动（如果没有，则一定弹出了错误提示）。
''' </summary>
Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
Options = If(Options, New McLaunchOptions)
'预检查
If Not RunInUi() Then
Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
End If
If McLaunchLoader.State = LoadState.Loading Then
Hint("已有游戏正在启动中！", HintType.Critical)
Return False
End If
'强制切换需要启动的版本
If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then
McLaunchLog("在启动前切换到版本 " & Options.Version.Name)
'检查版本
Options.Version.Load()
If Options.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft：" & Options.Version.Info, HintType.Critical)
Return False
End If
'切换版本
McVersionCurrent = Options.Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
FrmLaunchLeft.RefreshButtonsUI()
End If
FrmMain.AprilGiveup()
'禁止进入版本选择页面（否则就可以在启动中切换 McVersionCurrent 了）
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.VersionSelect).ToList
'实际启动加载器
McLaunchLoader.Start(Options, IsForceRestart:=True)
Return True
End Function
''' <summary>
''' 记录启动日志。
''' </summary>
Public Sub McLaunchLog(Text As String)
RunInUi(Sub()
FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text
End Sub)
RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
Log("[Launch] " & Text)
End Sub
'启动状态切换
Public McLaunchLoader As New LoaderTask(Of String, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState}
Public McLaunchLoader As New LoaderTask(Of McLaunchOptions, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState}
Public McLaunchLoaderReal As LoaderCombo(Of Object)
Public McLaunchProcess As Process
Public McLaunchWatcher As Watcher
Private Sub McLaunchState(Loader As LoaderTask(Of String, Object))
Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
Select Case McLaunchLoader.State
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Aborted
FrmLaunchLeft.PageChangeToLogin()
@@ -28,7 +79,13 @@ Public Module ModLaunch
FrmLaunchRight.LabLog.Text = ""
End Select
End Sub
Private Sub McLaunchStart(Loader As LoaderTask(Of String, Object))
''' <summary>
''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
''' </summary>
Private AbortHint As String = Nothing
'实际的启动方法
Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
'开始动画
RunInUiWait(AddressOf FrmLaunchLeft.PageChangeToLaunching)
'预检测（预检测的错误将直接抛出）
@@ -48,7 +105,6 @@ Public Module ModLaunch
}) With {.ProgressWeight = 2, .Show = False, .Block = False},
McLoginLoader,
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True},
New LoaderTask(Of Integer, String)("提供参数中的服务器 IP", Sub(InnerLoader As LoaderTask(Of Integer, String)) InnerLoader.Output = Loader.Input) With {.ProgressWeight = 0.01, .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},
@@ -59,6 +115,7 @@ Public Module ModLaunch
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader
AbortHint = Nothing
LaunchLoader.Start()
'任务栏进度条
LoaderTaskbarAdd(LaunchLoader)
@@ -72,7 +129,11 @@ Public Module ModLaunch
Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish)
Case LoadState.Aborted
Hint("已取消启动！", HintType.Info)
If AbortHint Is Nothing Then
Hint("已取消启动！", HintType.Info)
Else
Hint(AbortHint, HintType.Finish)
End If
Case LoadState.Failed
Throw LaunchLoader.Error
Case Else
@@ -92,7 +153,7 @@ NextInner:
GoTo NextInner
Else
'没有特殊处理过的错误信息
McLaunchLog("错误：" & GetString(ex, False))
McLaunchLog("错误：" & GetExceptionDetail(ex))
Log(ex, "Minecraft 启动失败", LogLevel.Msgbox, "启动失败")
Throw
End If
@@ -492,7 +553,7 @@ SkipLogin:
McLoginRequestValidate(Data)
GoTo LoginFinish
Catch ex As Exception
Dim AllMessage = GetString(ex)
Dim AllMessage = GetExceptionSummary(ex)
McLaunchLog("验证登录失败：" & AllMessage)
If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
McLaunchLog("已触发超时登录失败")
@@ -507,7 +568,7 @@ Refresh:
McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish
Catch ex As Exception
McLaunchLog("刷新登录失败：" & GetString(ex))
McLaunchLog("刷新登录失败：" & GetExceptionSummary(ex))
End Try
Data.Progress = If(NeedRefresh, 0.85, 0.45)
End If
@@ -516,7 +577,7 @@ Refresh:
If Data.IsAborted Then Throw New ThreadInterruptedException
NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception
McLaunchLog("登录失败：" & GetString(ex))
McLaunchLog("登录失败：" & GetExceptionSummary(ex))
Throw
End Try
If NeedRefresh Then
@@ -599,7 +660,7 @@ LoginFinish:
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
Catch ex As Exception
Dim AllMessage As String = GetString(ex)
Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
Dim ThrowEx As Exception = ex
If AllMessage.Contains("403") Then
@@ -607,7 +668,7 @@ LoginFinish:
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
ThrowEx = New Exception("$登录失败：连接登录服务器超时。" & vbCrLf & "请检查 HiPer 联机模块的连接状况是否良好，或选择其他登录方式！")
End If
McLaunchLog("登录失败：" & GetString(ThrowEx))
McLaunchLog("登录失败：" & GetExceptionSummary(ThrowEx))
Throw ThrowEx
End Try
End Sub
@@ -737,7 +798,7 @@ LoginFinish:
McLaunchLog("登录成功（Login, " & Data.Input.Token & "）")
Return NeedRefresh
Catch ex As Exception
Dim AllMessage As String = GetString(ex)
Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
If AllMessage.Contains("410") AndAlso AllMessage.Contains("Migrated") Then
Throw New Exception("$登录失败：该 Mojang 账号已迁移至微软账号，请在上方的登录方式中选择 微软 并再次尝试登录！")
@@ -944,7 +1005,7 @@ SystemBrowser:
Try
Result = NetRequestMuity("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
Catch ex As Net.WebException
Dim Message As String = GetString(ex)
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
Log(ex, "微软登录第 5 步汇报 429")
Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
@@ -968,13 +1029,22 @@ SystemBrowser:
Try
Result = NetRequestMuity("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Catch ex As Net.WebException
Dim Message As String = GetString(ex)
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
Log(ex, "微软登录第 6 步汇报 429")
Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
ElseIf Message.Contains("(404)") Then
Log(ex, "微软登录第 6 步汇报 404")
Throw New Exception("$你可能没有在购买后去 Minecraft 官网创建游戏档案，或者没有购买 Minecraft。")
RunInNewThread(Sub()
Select Case MyMsgBox("你可能没有在 Minecraft 官网创建档案，或者没有购买 Minecraft。" & vbCrLf &
"如果你已经购买了游戏，请在官网上创建档案后再试。", "登录失败", "创建档案", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
Case 2
OpenWebsite("https://www.minecraft.net/zh-hans/store/minecraft-java-bedrock-edition-pc")
End Select
End Sub, "Login Failed: Create Profile")
Throw New Exception("$$")
Else
Throw
End If
@@ -1165,10 +1235,8 @@ SystemBrowser:
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
If Not File.Exists(WrapperPath) OrElse New FileInfo(WrapperPath).Length <> 16818 Then
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Log("[Java] 已自动释放 Java Wrapper：" & WrapperPath)
End If
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Log("[Java] 已释放 Java Wrapper：" & WrapperPath)
Return WrapperPath
End Function
''' <summary>
@@ -1228,7 +1296,7 @@ SystemBrowser:
'全屏
If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
'进服
Dim Server As String = If(String.IsNullOrEmpty(Loader.Input), Setup.Get("VersionServerEnter", McVersionCurrent), Loader.Input)
Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp)
If Server.Length > 0 Then
If Server.Contains(":") Then
'包含端口号
@@ -1579,7 +1647,7 @@ NextVersion:
File.Delete(FilePath)
Catch ex As UnauthorizedAccessException
McLaunchLog("删除原 dll 访问被拒绝，这通常代表有一个 MC 正在运行，跳过解压：" & FilePath)
McLaunchLog("实际的错误信息：" & GetString(ex))
McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
Exit For
End Try
End If
@@ -1599,7 +1667,7 @@ NextVersion:
File.Delete(FileName)
Catch ex As UnauthorizedAccessException
McLaunchLog("删除多余文件访问被拒绝，跳过删除步骤")
McLaunchLog("实际的错误信息：" & GetString(ex))
McLaunchLog("实际的错误信息：" & GetExceptionSummary(ex))
Exit Sub
End Try
Next
@@ -1832,6 +1900,30 @@ IgnoreCustomSkin:
End Sub
Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
'输出 bat
Try
Dim CmdString As String =
"@echo off" & vbCrLf &
"title 启动 - " & McVersionCurrent.Name & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
"set APPDATA=""" & PathMcFolder & """" & vbCrLf &
"cd /D """ & PathMcFolder & """" & vbCrLf &
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), CmdString, Encoding:=Encoding.GetEncoding("GB18030"))
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
AbortHint = "导出启动脚本成功！"
OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """")
Loader.Parent.Abort()
Exit Sub '导出脚本完成
End If
Catch ex As Exception
Log(ex, "输出启动脚本失败")
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
End Try
'启动信息
Dim GameProcess = New Process()
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw)
@@ -1861,22 +1953,6 @@ IgnoreCustomSkin:
Loader.Output = GameProcess
McLaunchProcess = GameProcess
'输出 bat
Try
Dim CmdString As String =
"@echo off" & vbCrLf &
"title 启动 - " & McVersionCurrent.Name & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
"set APPDATA=""" & PathMcFolder & """" & vbCrLf &
"cd /D """ & PathMcFolder & """" & vbCrLf &
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(Path & "PCL\LatestLaunch.bat", CmdString, Encoding:=Encoding.GetEncoding("GB18030"))
Catch ex As Exception
Log(ex, "输出启动脚本失败")
End Try
'进程优先级处理
Try
If GameProcess.HasExited Then Exit Try '可能在启动游戏进程的同时刚好取消了启动

29
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
View File

@@ -1271,7 +1271,7 @@ Recheck:
'检查文件夹
If Not Directory.Exists(Path) Then
State = McVersionState.Error
Info = "该文件夹不存在"
Info = "未找到版本 " & Name
Return False
End If
'检查权限
@@ -1307,7 +1307,7 @@ Recheck:
Catch ex As Exception
Log(ex, "依赖版本检查出错（" & Name & "）")
State = McVersionState.Error
Info = "未知错误：" & GetString(ex)
Info = "未知错误：" & GetExceptionSummary(ex)
Return False
End Try
@@ -1319,7 +1319,6 @@ Recheck:
''' </summary>
Public Function Load() As McVersion
Try
Directory.CreateDirectory(Path & "PCL")
'检查版本，若出错则跳过数据确定阶段
If Not Check() Then GoTo ExitDataLoad
#Region "确定版本分类"
@@ -1424,9 +1423,11 @@ ExitDataLoad:
'确定版本显示种类
DisplayType = ReadIni(Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto)
'写入缓存
WriteIni(Path & "PCL\Setup.ini", "State", State)
WriteIni(Path & "PCL\Setup.ini", "Info", Info)
WriteIni(Path & "PCL\Setup.ini", "Logo", Logo)
If Directory.Exists(Path) Then
WriteIni(Path & "PCL\Setup.ini", "State", State)
WriteIni(Path & "PCL\Setup.ini", "Info", Info)
WriteIni(Path & "PCL\Setup.ini", "Logo", Logo)
End If
If State <> McVersionState.Error Then
WriteIni(Path & "PCL\Setup.ini", "ReleaseTime", ReleaseTime.ToString("yyyy-MM-dd HH:mm:ss"))
WriteIni(Path & "PCL\Setup.ini", "VersionFabric", Version.FabricVersion)
@@ -1439,7 +1440,7 @@ ExitDataLoad:
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalSub", Version.McCodeSub)
End If
Catch ex As Exception
Info = "未知错误：" & GetString(ex)
Info = "未知错误：" & GetExceptionSummary(ex)
Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
State = McVersionState.Error
Log(ex, "加载版本失败（" & Name & "）", LogLevel.Feedback)
@@ -1454,6 +1455,14 @@ ExitDataLoad:
Dim version = TryCast(obj, McVersion)
Return version IsNot Nothing AndAlso Path = version.Path
End Function
Public Shared Operator =(a As McVersion, b As McVersion) As Boolean
If a Is Nothing AndAlso b Is Nothing Then Return True
If a Is Nothing OrElse b Is Nothing Then Return False
Return a.Path = b.Path
End Operator
Public Shared Operator <>(a As McVersion, b As McVersion) As Boolean
Return Not (a = b)
End Operator
End Class
Public Enum McVersionState
@@ -3661,7 +3670,7 @@ VersionFindFail:
End If
Next
Catch ex As Exception
Result.Add("检查 Mod 时出错：" & GetString(ex) & vbCrLf & " - " & ModEntity.FileName)
Result.Add("检查 Mod 时出错：" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
Log(ex, "检查 Mod 时出错")
End Try
Next
@@ -3737,8 +3746,8 @@ VersionFindFail:
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
End If
Dim Lefts = RegexSearch(Left.ToLower, "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.ToLower, "[a-z]+|[0-9]+")
Dim Lefts = RegexSearch(Left.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim i As Integer = 0
While True
'两边均缺失，感觉是一个东西

25
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
View File

@@ -12,7 +12,7 @@
''' <summary>
''' 安装一个给定的整合包文件，返回是否安装成功。必须在工作线程执行。
''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True) As Boolean
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean
Log("[ModPack] 整合包安装请求：" & If(File, "null"))
Dim Archive As Compression.ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
@@ -54,7 +54,7 @@
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
Next
Catch ex As Exception
If GetString(ex, False, True).Contains("Error.WinIOError") Then
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
ElseIf File.ToLower.EndsWith(".rar") Then
@@ -69,7 +69,7 @@
Select Case PackType
Case 0
Log("[ModPack] 整合包种类：CurseForge")
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName)
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 1
Log("[ModPack] 整合包种类：HMCL")
InstallPackHMCL(File, Archive, ArchiveBaseFolder)
@@ -156,7 +156,7 @@ Retry:
''' 获取安装 CurseForge 整合包的加载器，若失败或跳过则返回 Nothing。
''' 加载器以安装目标版本文件夹为输入。
''' </summary>
Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String) As LoaderCombo(Of String)
Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
@@ -280,9 +280,18 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("清理安装文件",
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
'设置图标
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("[Download] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
Dim Target As String = VersionFolder & "原始整合包.zip"
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[Download] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target)
@@ -304,7 +313,7 @@ Retry:
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Return Loader
End Function
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing)
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
@@ -326,7 +335,7 @@ Retry:
End If
'启动加载器
Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName)
Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName, Logo)
If Loader Is Nothing Then Exit Sub
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader)

31
Plain Craft Launcher 2/Modules/ModEvent.vb
View File

@@ -31,10 +31,10 @@
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
@@ -45,28 +45,9 @@
End Try
End Sub)
Case "启动游戏"
'初始化与前置条件检测
If Not (FrmLaunchLeft.BtnLaunch.IsEnabled AndAlso FrmLaunchLeft.BtnLaunch.Visibility = Visibility.Visible AndAlso FrmLaunchLeft.BtnLaunch.IsHitTestVisible) Then
Hint("已有游戏正在启动中！", HintType.Critical) : Exit Sub
If McLaunchStart(New McLaunchOptions With {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
Hint("正在启动 " & Data(0) & "……")
End If
If Not Directory.Exists(PathMcFolder & "versions\" & Data(0)) Then
Hint("未在当前 Minecraft 文件夹找到版本 " & Data(0) & "！", HintType.Critical) : Exit Sub
End If
Dim ButtonVersion As New McVersion(Data(0))
ButtonVersion.Load()
If ButtonVersion.State = McVersionState.Error Then
Hint("无法启动 " & Data(0) & "：" & ButtonVersion.Info, HintType.Critical) : Exit Sub
End If
'实际启动
McVersionCurrent = ButtonVersion
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
FrmLaunchLeft.PageLaunchLeft_Loaded()
FrmLaunchLeft.RefreshButtonsUI()
FrmMain.AprilGiveup()
FrmLaunchLeft.LaunchButtonClick(If(Data.Length >= 2, Data(1), ""))
FrmMain.PageChange(FormMain.PageType.Launch)
Case "复制文本"
ClipboardSet(Join(Data, "|"))

4
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
View File

@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.4.3.0")>
<Assembly: AssemblyFileVersion("2.4.3.0")>
<Assembly: AssemblyVersion("2.4.4.0")>
<Assembly: AssemblyFileVersion("2.4.4.0")>
<Assembly: NeutralResourcesLanguage("")>

4
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
View File

@@ -1822,7 +1822,7 @@ Public Module ModDownloadLib
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '清空缓存（合并安装会先生成文件夹，这会在刷新时误判为可以使用缓存）
Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical)
Hint(Loader.Name & "失败：" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info)
Case LoadState.Loading
@@ -1839,7 +1839,7 @@ Public Module ModDownloadLib
Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical)
Hint(Loader.Name & "失败：" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info)
Case LoadState.Loading

3
Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml.vb
View File

@@ -3,7 +3,6 @@
#Region "Logo"
'Public CacheLogo As Boolean = True '是否缓存 Logo：通过下载量确定是否为默认页
Private _Logo As String = ""
Public Property Logo As String
Get
@@ -157,7 +156,7 @@ RetryStart:
Dim Ani As New List(Of AniData)
If IsMouseOver Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush9"), Time),
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then

13
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml.vb
View File

@@ -96,7 +96,7 @@
PanMain.Children.Add(NewCard)
'确定卡片是否展开
If Pair.Key = TopVersion Then
MyCard.StackInstall(NewStack, 8, Pair.Key)
MyCard.StackInstall(NewStack, If(Project.IsModPack, 9, 8), Pair.Key)
Else
NewCard.IsSwaped = True
End If
@@ -164,17 +164,20 @@
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
Dim LogoFileAddress As String = PathTemp & "CFLogo\" & GetHash(CfItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub()
If Not ModpackInstall(Target, VersionName) Then Throw New Exception("整合包安装出现异常！")
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
Throw New Exception("整合包安装出现异常！")
End If
End Sub) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败：" & GetString(MyLoader.Error), HintType.Critical)
Hint(MyLoader.Name & "失败：" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消！", HintType.Info)
Case LoadState.Loading
@@ -228,7 +231,7 @@
If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False
If File.GameVersion.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersion.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain) Then Return False
Not File.GameVersion.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
@@ -255,7 +258,7 @@
If SuitableVersions.Count = 0 Then
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中未找到适合这个 Mod 的游戏版本")
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本！")
Else
Log("[Download] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
End If

2
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
View File

@@ -131,7 +131,7 @@
End Sub
'页面切换触发
Public Sub MinecraftSelected(sender As MyListItem, e As Object)
Public Sub MinecraftSelected(sender As MyListItem, e As MouseButtonEventArgs)
SelectedMinecraftId = sender.Title
SelectedMinecraftJsonUrl = sender.Tag("url").ToString
SelectedMinecraftIcon = sender.Logo

55
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
View File

@@ -352,10 +352,10 @@ UnknownType:
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
ElseIf GetString(ex).Contains("429") Then
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then
ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else
@@ -400,10 +400,10 @@ Finish:
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
ElseIf GetString(ex).Contains("429") Then
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then
ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else
@@ -470,7 +470,7 @@ UseDefault:
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
ElseIf GetString(ex).Contains("429") Then
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log("获取离线登录使用的正版皮肤失败（" & ID & "）：获取皮肤太过频繁，请 5 分钟后再试！")
Else
@@ -522,10 +522,10 @@ UseDefault:
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
ElseIf GetString(ex).Contains("429") Then
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取统一通行证皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then
ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else
@@ -570,10 +570,10 @@ Finish:
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
ElseIf GetString(ex).Contains("429") Then
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint)
ElseIf GetString(ex).Contains("未设置自定义皮肤") Then
ElseIf GetExceptionSummary(ex).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Else
@@ -601,26 +601,23 @@ Finish:
FrmMain.PageChange(FormMain.PageType.VersionSelect)
End Sub
'启动按钮
Private Sub BtnLaunch_Click() Handles BtnLaunch.Click
LaunchButtonClick()
End Sub
Public Sub LaunchButtonClick(Optional ServerIp As String = "")
If BtnLaunch.IsEnabled AndAlso BtnLaunch.Visibility = Visibility.Visible AndAlso BtnLaunch.IsHitTestVisible Then
If BtnLaunch.Text = "启动游戏" Then
McLaunchLoader.Start(ServerIp, IsForceRestart:=True)
ElseIf BtnLaunch.Text = "下载游戏" Then
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End If
'愚人节处理
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁！")
IsAprilGiveup = True
FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
FrmLaunchLeft.AprilPosTrans.X = 0
FrmLaunchLeft.AprilPosTrans.Y = 0
FrmMain.BtnExtraApril.ShowRefresh()
End If
Public Sub LaunchButtonClick() Handles BtnLaunch.Click
If Not BtnLaunch.IsEnabled Then Exit Sub
'愚人节处理
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁！")
IsAprilGiveup = True
FrmLaunchLeft.AprilScaleTrans.ScaleX = 1
FrmLaunchLeft.AprilScaleTrans.ScaleY = 1
FrmLaunchLeft.AprilPosTrans.X = 0
FrmLaunchLeft.AprilPosTrans.Y = 0
FrmMain.BtnExtraApril.ShowRefresh()
End If
'实际的启动
If BtnLaunch.Text = "启动游戏" Then
McLaunchStart()
ElseIf BtnLaunch.Text = "下载游戏" Then
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End If
End Sub
Private BtnLaunchState As Integer = 0

6
Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb
View File

@@ -145,9 +145,9 @@ Reopen:
Try
CertRaw = NetRequestOnce("https://cert.mcer.cn/" & Cert & ".yml", "GET", "", "")
Catch ex As Exception
If GetString(ex).Contains("(404)") Then
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New CertOutdatedException '索引码无效或已过期
ElseIf GetString(ex).Contains("too many requests") Then
ElseIf GetExceptionSummary(ex).Contains("too many requests") Then
Throw New Exception("你的尝试太频繁了，请暂时啥都别点，等两分钟后再试……")
Else
Throw
@@ -799,7 +799,7 @@ WrongCode:
LabLoadDesc.Text = RealException.Message.TrimStart("$") & vbCrLf &
"点击镐子重试，或者点击灰色的 × 取消。"
Else
LabLoadDesc.Text = LoadStep & "失败：" & GetString(RealException) & vbCrLf &
LabLoadDesc.Text = LoadStep & "失败：" & GetExceptionSummary(RealException) & vbCrLf &
"点击镐子重试，或者点击灰色的 × 取消。"
End If
Log(Loader.Error, "HiPer 联机尝试失败")

10
Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb
View File

@@ -125,9 +125,13 @@
'打开网页
Public Shared Sub TryFeedback() Handles ItemFeedback.Click
If Not CanFeedback(True) Then Exit Sub
If MyMsgBox("是否要打开反馈列表网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。",
"提醒", "打开", "取消") = 2 Then Exit Sub
Feedback(True, False)
Select Case MyMsgBox("是否要打开反馈列表网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。",
"反馈提示", "提交新反馈", "查看反馈列表", "取消")
Case 1
Feedback(True, False)
Case 2
OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
End Select
End Sub
Public Shared Sub TryVote() Handles ItemVote.Click
If MyMsgBox("是否要打开新功能投票网页？" & vbCrLf & "如果无法打开该网页，请尝试使用加速器或 VPN。",

4
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml
View File

@@ -16,10 +16,10 @@
<Setter Property="Background">
<Setter.Value>
<LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
<GradientStop Color="{DynamicResource ColorObject9}" Offset="0"/>
<GradientStop Color="{DynamicResource ColorObjectBg1}" Offset="0"/>
<GradientStop Color="{DynamicResource ColorObject3}" Offset="0.02"/>
<GradientStop Color="{DynamicResource ColorObject3}" Offset="0.98"/>
<GradientStop Color="{DynamicResource ColorObject9}" Offset="1"/>
<GradientStop Color="{DynamicResource ColorObjectBg1}" Offset="1"/>
</LinearGradientBrush>
</Setter.Value>
</Setter>

2
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb
View File

@@ -91,7 +91,7 @@
Card.Children.Clear()
Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTipService.ShowDuration=""2333333"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
Tb.Text = GetString(Loader.Error, False)
Tb.Text = GetExceptionDetail(Loader.Error)
AddHandler Tb.MouseDown, Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False)
Hint("已复制错误详情！", HintType.Finish)

8
Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb
View File

@@ -7,11 +7,11 @@
Public Sub RefreshModDisabled() Handles Me.Loaded
If Version IsNot Nothing AndAlso Version.Modable Then
ItemMod.Visibility = Visibility.Visible
ItemModDisabled.Visibility = Visibility.Collapsed
ItemMod.Height = 36
ItemModDisabled.Height = 0
Else
ItemMod.Visibility = Visibility.Collapsed
ItemModDisabled.Visibility = Visibility.Visible
ItemMod.Height = 0
ItemModDisabled.Height = 36
End If
End Sub

2
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
View File

@@ -267,7 +267,7 @@
Case McMod.McModState.Disabled
NewPath = ModEntity.Path.Substring(0, ModEntity.Path.Count - ".disabled".Count)
Case McMod.McModState.Unavaliable
MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetString(ModEntity.FileUnavailableReason, False), "Mod 读取失败")
MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetExceptionDetail(ModEntity.FileUnavailableReason), "Mod 读取失败")
Exit Sub
End Select
'重命名

39
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml
View File

@@ -7,10 +7,12 @@
d:DesignWidth="800" d:DesignHeight="800" Grid.IsSharedSizeScope="True">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard Margin="0,15" Title="个性化" x:Name="PanDisplay">
<local:MyCard Margin="0,15" Title="">
<Grid Margin="10,7" Name="PanDisplayItem" />
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="个性化" x:Name="PanDisplay">
<StackPanel Margin="25,40,25,15">
<Grid Margin="-7,-3,0,12" Name="PanDisplayItem" />
<Grid x:Name="PanDisplayIcon" Margin="0,0,0,11" HorizontalAlignment="Stretch">
<Grid x:Name="PanDisplayIcon" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
@@ -20,7 +22,7 @@
<RowDefinition Height="9" />
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本图标" Margin="0,0,25,0" />
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="图标" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" x:Name="ComboDisplayLogo">
<local:MyComboBoxItem Content="自动" IsSelected="True" Tag="" />
<local:MyComboBoxItem Content="自定义..." x:Name="ItemDisplayLogoCustom" />
@@ -36,7 +38,7 @@
<local:MyComboBoxItem Content="鸡蛋" Tag="pack://application:,,,/images/Blocks/Egg.png" />
<local:MyComboBoxItem Content="布料（Fabric）" Tag="pack://application:,,,/images/Blocks/Fabric.png" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本分类" Margin="0,0,25,0" />
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="分类" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" Grid.Row="2" x:Name="ComboDisplayType">
<local:MyComboBoxItem Content="自动" IsSelected="True" />
<local:MyComboBoxItem Content="从版本列表中隐藏" ToolTip="该版本默认将不会在版本列表中显示。&#xA;在版本列表页面按下 F11，即可查看所有隐藏的版本。" ToolTipService.ShowDuration="2333333" />
@@ -46,19 +48,19 @@
<local:MyComboBoxItem Content="愚人节版本" />
</local:MyComboBox>
</Grid>
<Grid Margin="0,0,0,7" Height="35">
<Grid Margin="0,15,0,7" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDisplayRename" Text="重命名版本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnDisplayDesc" Text="更改描述" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnDisplayStar" Text="加入收藏夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" />
<local:MyButton x:Name="BtnDisplayRename" Text="修改版本名" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnDisplayDesc" Text="修改版本描述" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnDisplayDelete" Text="删除版本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" ColorType="Red" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="管理" x:Name="PanManage">
<local:MyCard Margin="0,0,0,15" Title="快捷方式" x:Name="PanFolder">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,2,0,7" Height="35">
<Grid.ColumnDefinitions>
@@ -66,9 +68,22 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnManageFolder" Text="打开版本文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnFolderVersion" Text="版本文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnFolderSaves" Text="存档文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnFolderMods" Text="Mod 文件夹" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="高级管理" x:Name="PanManage">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,2,0,7" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnManageScript" Text="导出启动脚本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnManageCheck" Text="补全文件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" ToolTip="校验版本依赖文件是否完整，并重新下载 Assets 索引与缺失、校验失败的文件。&#xa;若游戏缺失音效，请尝试此项。" ToolTipService.ShowDuration="2333333" />
<local:MyButton x:Name="BtnManageDelete" Text="删除版本" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2" ColorType="Red" />
</Grid>
</StackPanel>
</local:MyCard>

193
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb
View File

@@ -26,7 +26,7 @@
'刷新设置项目
ComboDisplayType.SelectedIndex = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto)
BtnDisplayStar.Text = If(PageVersionLeft.Version.IsStar, "从收藏夹中移除", "加入收藏夹")
BtnFolderMods.Visibility = If(PageVersionLeft.Version.Modable, Visibility.Visible, Visibility.Collapsed)
'刷新版本显示
PanDisplayItem.Children.Clear()
ItemVersion = PageSelectRight.McVersionListItem(PageVersionLeft.Version)
@@ -49,7 +49,7 @@
AniControlEnabled -= 1
End Sub
#Region "设置临时接口"
#Region "卡片：个性化"
'版本分类
Private Sub ComboDisplayType_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayType.SelectionChanged
@@ -67,6 +67,7 @@
Catch ex As Exception
Log(ex, "修改版本分类失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback)
End Try
Reload() '更新 “打开 Mod 文件夹” 按钮
Else
'改为隐藏
Try
@@ -85,6 +86,7 @@
End Try
End If
End Sub
'更改描述
Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click
Try
@@ -98,6 +100,7 @@
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 描述更改失败", LogLevel.Msgbox)
End Try
End Sub
'重命名版本
Private Sub BtnDisplayRename_Click(sender As Object, e As EventArgs) Handles BtnDisplayRename.Click
Try
@@ -171,80 +174,7 @@
Log(ex, "重命名版本失败", LogLevel.Msgbox)
End Try
End Sub
'收藏夹
Private Sub BtnDisplayStar_Click(sender As Object, e As EventArgs) Handles BtnDisplayStar.Click
Try
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "IsStar", Not PageVersionLeft.Version.IsStar)
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
Reload()
McVersionListForceRefresh = True
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 收藏状态更改失败", LogLevel.Msgbox)
End Try
End Sub
'补全文件
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then
Hint("正在处理中，请稍候！", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
End Try
End Sub
'删除版本
Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click
'修改此代码时，同时修改 PageSelectRight 中的代码
Try
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
Select Case MyMsgBox("你确定要删除版本 " & PageVersionLeft.Version.Name & " 吗？" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, True)
Case 1
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站！", HintType.Finish)
Case 2
' DeleteDirectory(PageVersionLeft.Version.Path)
' Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除！", HintType.Finish)
'Case 3
Exit Sub
End Select
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack()
Catch ex As Exception
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Msgbox)
End Try
End Sub
'打开版本文件夹
Private Sub BtnManageFolder_Click() Handles BtnManageFolder.Click
OpenVersionFolder(PageVersionLeft.Version)
End Sub
Public Shared Sub OpenVersionFolder(Version As McVersion)
OpenExplorer("""" & Version.Path & """")
End Sub
'版本图标
Private Sub ComboDisplayLogo_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayLogo.SelectionChanged
If Not (IsLoad AndAlso AniControlEnabled = 0) Then Exit Sub
@@ -280,6 +210,117 @@
End Try
End Sub
'删除版本
Private Sub BtnDisplayDelete_Click(sender As Object, e As EventArgs) Handles BtnDisplayDelete.Click
'修改此代码时，同时修改 PageSelectRight 中的代码
Try
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
Select Case MyMsgBox("你确定要删除版本 " & PageVersionLeft.Version.Name & " 吗？" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, True)
Case 1
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站！", HintType.Finish)
Case 2
' DeleteDirectory(PageVersionLeft.Version.Path)
' Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除！", HintType.Finish)
'Case 3
Exit Sub
End Select
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack()
Catch ex As Exception
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Msgbox)
End Try
End Sub
#End Region
#Region "卡片：快捷方式"
'版本文件夹
Private Sub BtnFolderVersion_Click() Handles BtnFolderVersion.Click
OpenVersionFolder(PageVersionLeft.Version)
End Sub
Public Shared Sub OpenVersionFolder(Version As McVersion)
OpenExplorer("""" & Version.Path & """")
End Sub
'存档文件夹
Private Sub BtnFolderSaves_Click() Handles BtnFolderSaves.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "saves\"
Directory.CreateDirectory(FolderPath)
OpenExplorer("""" & FolderPath & """")
End Sub
'Mod 文件夹
Private Sub BtnFolderMods_Click() Handles BtnFolderMods.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "mods\"
Directory.CreateDirectory(FolderPath)
OpenExplorer("""" & FolderPath & """")
End Sub
#End Region
#Region "卡片：管理"
'导出启动脚本
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
Try
'弹窗要求指定脚本的保存位置
Dim SavePath As String = SelectAs("选择脚本保存位置", "启动 " & PageVersionLeft.Version.Name & ".bat", "批处理文件(*.bat)|*.bat")
If SavePath = "" Then Exit Sub
'检查中断（等玩家选完弹窗指不定任务就结束了呢……）
If McLaunchLoader.State = LoadState.Loading Then
Hint("请在当前启动任务结束后再试！", HintType.Critical)
Exit Sub
End If
'生成脚本
If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Version = PageVersionLeft.Version}) Then
If Setup.Get("LoginType") = McLoginType.Legacy Then
Hint("正在导出启动脚本……")
Else
Hint("正在导出启动脚本……（注意，使用脚本启动可能会导致登录失效！）")
End If
End If
Catch ex As Exception
Log(ex, "导出启动脚本失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
End Try
End Sub
'补全文件
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then
Hint("正在处理中，请稍候！", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Sub()
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消！", HintType.Info)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
End Try
End Sub
#End Region
End Class

1
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
View File

@@ -119,6 +119,7 @@
<PlatformTarget>AnyCPU</PlatformTarget>
<CodeAnalysisRuleSet>BasicDesignGuidelineRules.ruleset</CodeAnalysisRuleSet>
<DefineConstants>BETA</DefineConstants>
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<PropertyGroup>
<SignAssembly>false</SignAssembly>

BIN
Plain Craft Launcher 2/Resources/java-wrapper.jar
View File

Binary file not shown.