Skip to content

Commit 2210da6

Browse files
committed
2.10.7
1 parent ee38591 commit 2210da6

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

62 files changed

+2604
-2106
lines changed

Plain Craft Launcher 2/Application.xaml.vb

Lines changed: 21 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -67,9 +67,9 @@ Public Class Application
6767
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
6868
Catch ex As Exception
6969
If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
70-
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
70+
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
7171
Else
72-
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
72+
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
7373
Setup.Set("SystemSystemCache", "")
7474
PathTemp = IO.Path.GetTempPath() & "PCL\"
7575
End If
@@ -104,6 +104,13 @@ WaitRetry:
104104
ToolTipService.PlacementProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(Primitives.PlacementMode.Bottom))
105105
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
106106
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
107+
'设置网络配置默认值
108+
ServicePointManager.Expect100Continue = False
109+
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
110+
ServicePointManager.DefaultConnectionLimit = 10000
111+
ServicePointManager.UseNagleAlgorithm = False
112+
ServicePointManager.EnableDnsRoundRobin = True
113+
ServicePointManager.ReusePort = True
107114
'设置初始窗口
108115
If Setup.Get("UiLauncherLogo") Then
109116
FrmStart = New SplashScreen("Images\icon.ico")
@@ -136,11 +143,6 @@ WaitRetry:
136143
Setup.Load("ToolDownloadThread")
137144
Setup.Load("ToolDownloadCert")
138145
Setup.Load("ToolDownloadSpeed")
139-
'网络配置初始化
140-
ServicePointManager.Expect100Continue = True
141-
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
142-
ServicePointManager.DefaultConnectionLimit = 1024
143-
ServicePointManager.UseNagleAlgorithm = False
144146
'计时
145147
Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
146148
ApplicationStartTick = GetTimeTick()
@@ -155,7 +157,7 @@ WaitRetry:
155157
FilePath = PathWithName
156158
Catch
157159
End Try
158-
MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
160+
MsgBox(ex.GetDetail(True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
159161
FormMain.EndProgramForce(ProcessReturnValues.Exception)
160162
End Try
161163
End Sub
@@ -168,10 +170,20 @@ WaitRetry:
168170
'异常
169171
Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException
170172
On Error Resume Next
173+
'触发页面的 Dispatcher
174+
If FrmMain?.PageLeft IsNot Nothing AndAlso TypeOf FrmMain.PageLeft Is IDispatcherUnhandledException Then
175+
CType(FrmMain.PageLeft, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
176+
If e.Handled Then Return
177+
End If
178+
If FrmMain?.PageRight IsNot Nothing AndAlso TypeOf FrmMain.PageRight Is IDispatcherUnhandledException Then
179+
CType(FrmMain.PageRight, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
180+
If e.Handled Then Return
181+
End If
182+
'正常处理
171183
e.Handled = True
172184
If IsProgramEnded Then Return
173185
FeedbackInfo()
174-
Dim Detail As String = GetExceptionDetail(e.Exception, True)
186+
Dim Detail As String = e.Exception.GetDetail(True)
175187
If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse
176188
Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
177189
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
Imports System.Windows.Threading
2+
3+
''' <summary>
4+
''' 指示页面可以通过按下 F5 或以其他方式刷新。
5+
''' </summary>
6+
Public Interface IRefreshable
7+
Sub Refresh()
8+
End Interface
9+
10+
''' <summary>
11+
''' 指示页面可以处理未捕获的异常。
12+
''' </summary>
13+
Public Interface IDispatcherUnhandledException
14+
Sub DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs)
15+
End Interface

Plain Craft Launcher 2/Controls/MyCard.vb

Lines changed: 2 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -123,14 +123,6 @@
123123
End Select
124124
'控件转换
125125
Select Case Type
126-
Case 5
127-
Dim LoadingPickaxe As New MyLoading With {.Text = "正在获取版本列表", .Margin = New Thickness(5)}
128-
Dim Loader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Main", AddressOf DlForgeVersionMain)
129-
LoadingPickaxe.State = Loader
130-
Loader.Start(Stack.Tag)
131-
AddHandler LoadingPickaxe.StateChanged, AddressOf FrmDownloadForge.Forge_StateChanged
132-
AddHandler LoadingPickaxe.Click, AddressOf FrmDownloadForge.Forge_Click
133-
Stack.Children.Add(LoadingPickaxe)
134126
Case 6
135127
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
136128
Case 8
@@ -145,9 +137,6 @@
145137
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
146138
Case 3
147139
Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True))
148-
Case 4
149-
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf FrmDownloadLiteLoader.DownloadStart, False))
150-
Case 5
151140
Case 6
152141
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
153142
Case 7
@@ -332,13 +321,8 @@
332321
SetValue(IsSwapedProperty, value)
333322
End Set
334323
End Property
335-
Public Shared ReadOnly IsSwapedProperty As DependencyProperty = DependencyProperty.Register("IsSwaped", GetType(Boolean), GetType(MyCard), New PropertyMetadata(False, AddressOf OnIsSwapedPropertyChanged))
336-
Private Shared Sub OnIsSwapedPropertyChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
337-
Dim self = TryCast(d, MyCard)
338-
If self IsNot Nothing Then
339-
self.IsSwapped = CType(e.NewValue, Boolean)
340-
End If
341-
End Sub
324+
Public Shared ReadOnly IsSwapedProperty As DependencyProperty = DependencyProperty.Register("IsSwaped", GetType(Boolean), GetType(MyCard), New PropertyMetadata(False,
325+
Sub(sender, e) If sender IsNot Nothing AndAlso TypeOf sender Is MyCard Then CType(sender, MyCard).IsSwapped = CType(e.NewValue, Boolean)))
342326

343327
Public Property SwapLogoRight As Boolean = False
344328
Private IsMouseDown As Boolean = False

Plain Craft Launcher 2/Controls/MyImage.vb

Lines changed: 12 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@
2525

2626
''' <summary>
2727
''' 与 Image 的 Source 类似。
28-
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示,图片会保存为本地缓存
28+
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示;若 EnableCache 设为 True,图片还会保存为本地缓存
2929
''' 支持 WebP 格式的图片。
3030
''' </summary>
3131
Public Shadows Property Source As String '覆写 Image 的 Source 属性
@@ -46,7 +46,7 @@
4646
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
4747

4848
''' <summary>
49-
''' Source 首次下载失败时,会从该备用地址加载图片
49+
''' Source 是一个网络图片,该地址将作为第二下载源
5050
''' </summary>
5151
Public Property FallbackSource As String
5252
Get
@@ -111,74 +111,36 @@
111111
Return
112112
End If
113113
'从缓存加载网络图片
114-
Dim Url As String = Source
115-
Dim Retried As Boolean = False
116-
Dim TempPath As String = GetTempPath(Url)
117-
Dim TempFile As New FileInfo(TempPath)
118114
Dim EnableCache As Boolean = Me.EnableCache
115+
Dim TempPath As String = GetTempPath(Source) & If(EnableCache, "", GetUuid()) '不启用缓存时加上随机字符串,避免冲突
116+
Dim TempFile As New FileInfo(TempPath)
119117
If EnableCache AndAlso TempFile.Exists Then
120118
ActualSource = TempPath
121119
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
122120
End If
123121
RunInNewThread(
124122
Sub()
125-
Dim TempDownloadingPath As String = Nothing
126123
Try
127124
RetryStart:
128125
'下载
129-
ActualSource = LoadingSource '显示加载中图片
130-
TempDownloadingPath = TempPath & RandomInteger(0, 10000000)
131-
Directory.CreateDirectory(GetPathFromFullPath(TempPath)) '重新实现下载,以避免携带 Header(#5072)
132-
Using Client As New Net.WebClient
133-
Client.DownloadFile(Url, TempDownloadingPath)
134-
End Using
135-
If Url <> Source AndAlso Url <> FallbackSource Then
136-
'已经更换了地址
137-
File.Delete(TempDownloadingPath)
138-
ElseIf EnableCache Then
126+
ActualSource = LoadingSource '显示加载中的占位图片
127+
NetDownloadByLoader(
128+
If(String.IsNullOrEmpty(FallbackSource), {Source}, {Source, FallbackSource}),
129+
TempPath, SimulateBrowserHeaders:=True)
130+
If EnableCache Then
139131
'保存缓存并显示
140-
If File.Exists(TempPath) Then File.Delete(TempPath)
141-
FileSystem.Rename(TempDownloadingPath, TempPath)
142132
RunInUi(Sub() ActualSource = TempPath)
143133
Else
144134
'直接显示
145-
RunInUiWait(Sub() ActualSource = TempDownloadingPath)
146-
File.Delete(TempDownloadingPath)
135+
RunInUiWait(Sub() ActualSource = TempPath)
136+
File.Delete(TempPath)
147137
End If
148138
Catch ex As Exception
149139
Try
150140
If TempPath IsNot Nothing Then File.Delete(TempPath)
151-
If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
152141
Catch
153142
End Try
154-
If Not Retried Then
155-
'更换备用地址
156-
Log(ex, $"下载图片可重试地失败({Url})", LogLevel.Developer)
157-
Retried = True
158-
Url = If(FallbackSource, Source)
159-
'空
160-
If Url Is Nothing Then
161-
ActualSource = Nothing
162-
Return
163-
End If
164-
'本地图片
165-
If Not Url.StartsWithF("http") Then
166-
ActualSource = Url
167-
Return
168-
End If
169-
'从缓存加载网络图片
170-
TempPath = GetTempPath(Url)
171-
TempFile = New FileInfo(TempPath)
172-
If EnableCache AndAlso TempFile.Exists() Then
173-
ActualSource = TempPath
174-
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Return '无需刷新缓存
175-
End If
176-
'下载
177-
If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
178-
GoTo RetryStart
179-
Else
180-
Log(ex, $"下载图片失败({Url})", LogLevel.Hint)
181-
End If
143+
Log(ex, $"下载图片失败", LogLevel.Hint)
182144
End Try
183145
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
184146
End Sub

Plain Craft Launcher 2/Controls/MyLoading.xaml.vb

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -79,11 +79,7 @@ Public Class MyLoading
7979
Do While Ex.InnerException IsNot Nothing
8080
Ex = Ex.InnerException
8181
Loop
82-
LabText.Text = StrTrim(Ex.Message)
83-
If {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
84-
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then
85-
LabText.Text = "网络环境不佳,请稍后重试,或使用 VPN 以改善网络环境"
86-
End If
82+
LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", StrTrim(Ex.Message))
8783
End If
8884
Else
8985
LabText.Text = TextError

Plain Craft Launcher 2/Controls/MyPageLeft.vb

Lines changed: 10 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -3,28 +3,15 @@
33
Private Uuid As Integer = GetUuid()
44

55
'执行逐个进入动画的控件
6-
Public AnimatedControl As FrameworkElement
7-
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.RegisterAttached("AnimatedControl", GetType(String), GetType(MyPageLeft), New PropertyMetadata(Nothing, AddressOf OnAnimatedControlChanged))
8-
9-
Public Shared Sub SetAnimatedControl(obj As DependencyObject, value As String)
10-
obj.SetValue(AnimatedControlProperty, value)
11-
End Sub
12-
13-
Private Shared Sub OnAnimatedControlChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
14-
Dim control = TryCast(d, MyPageLeft)
15-
If control IsNot Nothing Then
16-
Dim handler As RoutedEventHandler
17-
handler = Sub(sender, args)
18-
Dim targetName = CStr(e.NewValue)
19-
Dim target = TryCast(control.FindName(targetName), FrameworkElement)
20-
If target IsNot Nothing Then
21-
control.AnimatedControl = target
22-
End If
23-
RemoveHandler control.Loaded, handler
24-
End Sub
25-
AddHandler control.Loaded, handler
26-
End If
27-
End Sub
6+
Public Property AnimatedControl As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
7+
Get
8+
Return GetValue(AnimatedControlProperty)
9+
End Get
10+
Set(value As String)
11+
SetValue(AnimatedControlProperty, value)
12+
End Set
13+
End Property
14+
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(String), GetType(MyPageLeft), New PropertyMetadata(Nothing))
2815

2916
Public Sub TriggerShowAnimation()
3017
If AnimatedControl Is Nothing Then
@@ -97,7 +84,7 @@
9784
'遍历获取所有需要生成动画的控件
9885
Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
9986
Dim AllControls As New List(Of FrameworkElement)
100-
GetAllAnimControls(AnimatedControl, AllControls, IgnoreInvisibility)
87+
GetAllAnimControls(FindName(AnimatedControl), AllControls, IgnoreInvisibility)
10188
Return AllControls
10289
End Function
10390
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
@@ -118,7 +105,3 @@
118105
End Sub
119106

120107
End Class
121-
122-
Public Interface IRefreshable
123-
Sub Refresh()
124-
End Interface

Plain Craft Launcher 2/Controls/MyPageRight.vb

Lines changed: 9 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -3,29 +3,16 @@
33
Public PageUuid As Integer = GetUuid()
44

55
'“返回顶部” 按钮检测的滚动区域
6-
Public PanScroll As MyScrollViewer
6+
Public Property PanScroll As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
7+
Get
8+
Return GetValue(PanScrollProperty)
9+
End Get
10+
Set(value As String)
11+
SetValue(PanScrollProperty, value)
12+
End Set
13+
End Property
714
Private Shared ReadOnly PanScrollProperty =
8-
DependencyProperty.RegisterAttached("PanScroll", GetType(String), GetType(MyPageRight), New PropertyMetadata(Nothing, AddressOf OnPanScrollChanged))
9-
10-
Public Shared Sub SetPanScroll(obj As DependencyObject, value As String)
11-
obj.SetValue(PanScrollProperty, value)
12-
End Sub
13-
14-
Private Shared Sub OnPanScrollChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
15-
Dim control = TryCast(d, MyPageRight)
16-
If control IsNot Nothing Then
17-
Dim handler As RoutedEventHandler
18-
handler = Sub(sender, args)
19-
Dim targetName = CStr(e.NewValue)
20-
Dim target = TryCast(control.FindName(targetName), FrameworkElement)
21-
If target IsNot Nothing Then
22-
control.PanScroll = target
23-
End If
24-
RemoveHandler control.Loaded, handler
25-
End Sub
26-
AddHandler control.Loaded, handler
27-
End If
28-
End Sub
15+
DependencyProperty.Register("PanScroll", GetType(String), GetType(MyPageRight), New PropertyMetadata(Nothing))
2916

3017
'当前状态
3118
Public Enum PageStates

0 commit comments

Comments
 (0)