Skip to content

Commit

Permalink
2.7.2
Browse files Browse the repository at this point in the history
  • Loading branch information
LTCatt committed May 13, 2024
1 parent a5a3800 commit a84601d
Show file tree
Hide file tree
Showing 33 changed files with 764 additions and 774 deletions.
18 changes: 9 additions & 9 deletions Plain Craft Launcher 2/Application.xaml.vb
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,6 @@ Public Class Application

'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
ApplicationStartTick = GetTimeTick()
SecretOnApplicationStart()
Try
'检查参数调用
Expand Down Expand Up @@ -104,9 +103,10 @@ Public Class Application
'日志初始化
LogStart()
'添加日志
Log("[Start] 程序版本:" & VersionDisplayName & "(" & VersionCode & ")")
Log("[Start] 识别码:" & UniqueAddress & If(ThemeCheckOne(9), ",已解锁反馈主题", ""))
Log("[Start] 程序路径:" & PathWithName)
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode})")
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), "已解锁反馈主题", "")}")
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
'检测压缩包运行
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
Expand Down Expand Up @@ -220,7 +220,7 @@ Public Class Application
Names.Remove(sender.Tag)
Setup.Set("LoginLegacyName", Join(Names, "¨"))
FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "")
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
Case Else
'第三方
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
Expand All @@ -238,12 +238,12 @@ Public Class Application
Select Case Token
Case "Nide"
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginNide.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
Case "Auth"
FrmLoginAuth.ComboName.ItemsSource = Dict.Keys
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
End Select
End Select
End Sub
Expand Down
10 changes: 6 additions & 4 deletions Plain Craft Launcher 2/Controls/MyScrollViewer.vb
Original file line number Diff line number Diff line change
Expand Up @@ -8,10 +8,12 @@
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
Dim SourceType = e.Source.GetType
If Content.TemplatedParent Is Nothing AndAlso
((GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType)) Then
If Content.TemplatedParent Is Nothing AndAlso (
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
TypeOf e.Source Is CheckBox
) Then
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
Exit Sub
End If
Expand Down
46 changes: 31 additions & 15 deletions Plain Craft Launcher 2/FormMain.xaml.vb
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,10 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 321 Then 'Release 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 319 Then 'Release 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
Expand Down Expand Up @@ -96,7 +100,15 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 318 Then 'Snapshot 2.7.1
If LastVersion < 322 Then 'Snapshot 2.7.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 18
BugCount += 18
End If
If LastVersion < 320 Then 'Snapshot 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
Expand Down Expand Up @@ -430,6 +442,8 @@ Public Class FormMain
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
End If
#End If
'被移除的窗口设置选项
If Setup.Get("LaunchArgumentWindowType") = 5 Then Setup.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称
If LowerVersionCode <= 207 Then
Dim UnlockedTheme As New List(Of String) From {"2"}
Expand Down Expand Up @@ -653,7 +667,7 @@ Public Class FormMain
If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
End Sub
Private Sub TriggerPageBack()
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall AndAlso FrmDownloadInstall.IsInSelectPage Then
FrmDownloadInstall.ExitSelectPage()
Else
PageBack()
Expand Down Expand Up @@ -761,7 +775,7 @@ Public Class FormMain
RunInNewThread(
Sub()
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Count > 0, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
Expand Down Expand Up @@ -1176,8 +1190,11 @@ Install:
''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary>
Public Sub PageBack() Handles BtnTitleInner.Click
If Not PageStack.Any() Then Exit Sub
PageChangeActual(PageStack(0))
If PageStack.Any() Then
PageChangeActual(PageStack(0))
Else
PageChange(PageType.Launch)
End If
End Sub

'实际处理页面切换
Expand Down Expand Up @@ -1357,23 +1374,22 @@ Install:
End Sub
Private Sub PanMainLeft_Resize(NewWidth As Double)
Dim Delta As Double = NewWidth - RectLeftBackground.Width
If Math.Abs(Delta) < 0.1 Then Exit Sub
If AniControlEnabled = 0 Then
If Math.Abs(Delta) > 0.1 AndAlso AniControlEnabled = 0 Then
If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏
If NewWidth > 0 Then
'宽度足够,显示
AniStart({
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True)
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True)
Else
'宽度不足,隐藏
AniStart({
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True)
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True)
End If
Else
RectLeftBackground.Width = NewWidth
Expand Down
92 changes: 47 additions & 45 deletions Plain Craft Launcher 2/Modules/Base/ModBase.vb
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"

'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.7.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.1." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.7.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.2." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 319 'Release
Public Const VersionCode As Integer = 321 'Release
#Else
Public Const VersionCode As Integer = 320 'Snapshot
Public Const VersionCode As Integer = 322 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
Expand Down Expand Up @@ -58,7 +58,7 @@ Public Module ModBase
''' <summary>
''' 程序的打开计时。
''' </summary>
Public ApplicationStartTick As Long
Public ApplicationStartTick As Long = GetTimeTick()
''' <summary>
''' 程序打开时的时间。
''' </summary>
Expand All @@ -76,6 +76,10 @@ Public Module ModBase
''' </summary>
Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
''' <summary>
''' 是否使用 GBK 编码。
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
Expand Down Expand Up @@ -726,8 +730,8 @@ Public Module ModBase
Public Function GetFileNameFromPath(FilePath As String) As String
FilePath = FilePath.Replace("/", "\")
If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
Dim length As Integer = FilePath.Length
If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
If length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
Expand Down Expand Up @@ -1215,43 +1219,35 @@ Re:
''' <summary>
''' 尝试根据后缀名判断文件种类并解压文件,支持 gz 与 zip,会尝试将 jar 以 zip 方式解压。
''' 会尝试创建,但不会清空目标文件夹。
''' 成功返回 True,并非压缩文件或失败返回 False。
''' </summary>
Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
Try
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte()
While data <> -1
decompressedFile.WriteByte(data)
data = stream.ReadByte()
End While
decompressedFile.Close()
stream.Close()
Return True
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
End If
Next
End Using
Return True
End If
Catch ex As Exception
Log(ex, "尝试解压文件失败")
Return False
End Try
End Function
Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing)
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte()
While data <> -1
decompressedFile.WriteByte(data)
data = stream.ReadByte()
End While
decompressedFile.Close()
stream.Close()
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
End If
Next
End Using
End If
End Sub

''' <summary>
''' 删除文件夹,返回删除的文件个数。通过参数选择是否抛出异常。
Expand Down Expand Up @@ -1342,7 +1338,7 @@ Re:
Loop
DescList = DescList.Distinct.ToList
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "")
Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "")

'常见错误(记得同时修改下面的)
Dim CommonReason As String = Nothing
Expand Down Expand Up @@ -1541,6 +1537,12 @@ Re:
Next
Return tmp.ToString()
End Function
''' <summary>
''' 检查字符串中的字符是否均为 ASCII 字符。
''' </summary>
<Extension> Public Function IsASCII(Input As String) As Boolean
Return Input.All(Function(c) AscW(c) < 128)
End Function

''' <summary>
''' 高速的 StartsWith。
Expand Down Expand Up @@ -2073,7 +2075,7 @@ NextElement:
''' <param name="SortRule">传入两个对象,若第一个对象应该排在前面,则返回 True。</param>
Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T)
Dim NewList As New List(Of T)
While List.Count > 0
While List.Any
Dim Highest = List(0)
For i = 1 To List.Count - 1
If SortRule(List(i), Highest) Then Highest = List(i)
Expand Down Expand Up @@ -2646,7 +2648,7 @@ Retry:
''' </summary>
Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T)
Shuffle = New List(Of T)
Do While array.Count > 0
Do While array.Any
Dim i As Integer = RandomInteger(0, array.Count - 1)
Shuffle.Add(array(i))
array.RemoveAt(i)
Expand Down
7 changes: 3 additions & 4 deletions Plain Craft Launcher 2/Modules/Base/ModLoader.vb
Original file line number Diff line number Diff line change
Expand Up @@ -571,7 +571,7 @@ Restart:
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None

Public Sub LoaderTaskbarAdd(Loader As LoaderBase)
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
Expand All @@ -587,11 +587,11 @@ Restart:
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If (IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting) AndAlso Task.Show Then
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
Expand Down Expand Up @@ -628,7 +628,6 @@ Restart:
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar.ToList
If Not Task.Show Then Continue For
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
Expand Down
Loading

0 comments on commit a84601d

Please sign in to comment.