Merge branch 'main' into main

This commit is contained in:
龙腾猫跃
2024-04-05 22:14:18 +08:00
committed by GitHub
49 changed files with 1273 additions and 860 deletions
+5 -5
View File
@@ -28,11 +28,11 @@ Public Class Application
'自动更新
UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
Environment.Exit(Result.Cancel)
'ElseIf e.Args(0).StartsWith("--link") Then
'ElseIf e.Args(0).StartsWithF("--link") Then
' '稍作等待后切换到联机页面
' Thread.Sleep(1000)
' FormMain.IsLinkRestart = True
ElseIf e.Args(0).StartsWith("--memory") Then
ElseIf e.Args(0).StartsWithF("--memory") Then
'内存优化
Dim Ram = My.Computer.Info.AvailablePhysicalMemory
Try
@@ -173,7 +173,7 @@ Public Class Application
Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
If args.Name.StartsWith("NAudio") Then
If args.Name.StartsWithF("NAudio") Then
SyncLock AssemblyNAudioLock
If AssemblyNAudio Is Nothing Then
Log("[Start] 加载 DLL:NAudio")
@@ -181,7 +181,7 @@ Public Class Application
End If
Return AssemblyNAudio
End SyncLock
ElseIf args.Name.StartsWith("Newtonsoft.Json") Then
ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then
SyncLock AssemblyJsonLock
If AssemblyJson Is Nothing Then
Log("[Start] 加载 DLL:Json")
@@ -189,7 +189,7 @@ Public Class Application
End If
Return AssemblyJson
End SyncLock
ElseIf args.Name.StartsWith("Ookii.Dialogs.Wpf") Then
ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then
SyncLock AssemblyDialogLock
If AssemblyDialog Is Nothing Then
Log("[Start] 加载 DLL:Dialogs")
@@ -138,7 +138,7 @@
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then
If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
End If
@@ -1,7 +1,7 @@
Public Class MyIconButton
'声明
Public Event Click(sender As Object, e As EventArgs) '自定义事件
'自定义事件
Public Event Click(sender As Object, e As EventArgs)
'自定义属性
@@ -210,7 +210,7 @@
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
'添加新 Logo
If Not _Logo = "" Then
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
PathLogo = New Image With {
.Tag = Me,
@@ -220,7 +220,7 @@
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
ElseIf _Logo.ToLower.EndsWith(".png") OrElse _Logo.ToLower.EndsWith(".jpg") Then
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then
'位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With {
@@ -328,7 +328,7 @@
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then
If _Logo.EndsWith(".png") Then
If _Logo.EndsWithF(".png", True) Then
PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
@@ -58,11 +58,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -63,11 +63,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -56,11 +56,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -89,7 +89,7 @@
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器
If PageLoaderAutoRun Then
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
Else
Dim Input = Nothing
@@ -107,7 +107,7 @@
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
+34 -26
View File
@@ -140,6 +140,14 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 318 Then 'Snapshot 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
FeatureCount += 2
BugCount += 2
End If
If LastVersion < 316 Then 'Snapshot 2.6.15
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
FeatureCount += 2
@@ -341,7 +349,7 @@ Public Class FormMain
Dim SortedFeatures = Sort(FeatureList, Function(Left As KeyValuePair(Of Integer, String), Right As KeyValuePair(Of Integer, String)) As Boolean
Return Left.Key > Right.Key
End Function)
If SortedFeatures.Count = 0 AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then
If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then
ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
End If
For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
@@ -810,7 +818,7 @@ Public Class FormMain
Try
Dim Str As String = e.Data.GetData(DataFormats.Text)
Log("[System] 接受文本拖拽:" & Str)
If Str.StartsWith("authlib-injector:yggdrasil-server:") Then
If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
'Authlib 拖拽
e.Handled = True
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
@@ -853,7 +861,7 @@ Public Class FormMain
'正在主页,需要刷新左边栏
FrmLaunchLeft.RefreshPage(True, False)
End If
ElseIf Str.StartsWith("file:///") Then
ElseIf Str.StartsWithF("file:///") Then
'文件拖拽(例如从浏览器下载窗口拖入)
Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
e.Handled = True
@@ -1296,7 +1304,7 @@ Install:
''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary>
Public Sub PageBack() Handles BtnTitleInner.Click
If PageStack.Count = 0 Then Exit Sub
If Not PageStack.Any() Then Exit Sub
PageChangeActual(PageStack(0))
End Sub
@@ -1316,27 +1324,13 @@ Install:
PageChangeExit()
Else
'即将切换到一个子页面
If PageStack.Count = 0 Then
'主页面 → 子页面,进入
PanTitleInner.Visibility = Visibility.Visible
PanTitleMain.IsHitTestVisible = False
PanTitleInner.IsHitTestVisible = True
PageNameRefresh(Stack)
AniStart({
AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
PageStack.Insert(0, PageCurrent)
Else
If PageStack.Any Then
'子页面 → 另一个子页面,更新
AniStart({
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
AaCode(Sub() LabTitleInner.Text = PageName,, True),
AaOpacity(LabTitleInner, 1, 150, 30)
}, "FrmMain Titlebar SubLayer")
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
AaCode(Sub() LabTitleInner.Text = PageName,, True),
AaOpacity(LabTitleInner, 1, 150, 30)
}, "FrmMain Titlebar SubLayer")
If PageStack.Contains(Stack) Then
'返回到更上层的子页面
Do While PageStack.Contains(Stack)
@@ -1346,6 +1340,20 @@ Install:
'进入更深层的子页面
PageStack.Insert(0, PageCurrent)
End If
Else
'主页面 → 子页面,进入
PanTitleInner.Visibility = Visibility.Visible
PanTitleMain.IsHitTestVisible = False
PanTitleInner.IsHitTestVisible = True
PageNameRefresh(Stack)
AniStart({
AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
PageStack.Insert(0, PageCurrent)
End If
End If
#End Region
@@ -1452,9 +1460,7 @@ Install:
''' 退出子界面。
''' </summary>
Private Sub PageChangeExit()
If PageStack.Count = 0 Then
'主页面 → 主页面,无事发生
Else
If PageStack.Any Then
'子页面 → 主页面,退出
PanTitleMain.Visibility = Visibility.Visible
PanTitleMain.IsHitTestVisible = True
@@ -1467,6 +1473,8 @@ Install:
AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
PageStack.Clear()
Else
'主页面 → 主页面,无事发生
End If
End Sub
@@ -869,7 +869,7 @@ NextAni:
Loop
'如果当前动画组都执行完毕则删除
If Entry.Data.Count = 0 Then
If Not Entry.Data.Any() Then
'为了避免新添加的动画影响顺序,不能 RemoveAt(i)
'为了允许动画在执行中添加同名动画组,不能按名字移除
For Current = 0 To AniGroups.Count - 1
+132 -120
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.15" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.15." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.7.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.0." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 317 'Release
Public Const VersionCode As Integer = 319 'Release
#Else
Public Const VersionCode As Integer = 316 'Snapshot
Public Const VersionCode As Integer = 318 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -110,6 +110,14 @@ Public Module ModBase
''' </summary>
Public Const IconButtonDelete As String = "M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z"
''' <summary>
''' 图标按钮,禁止,1x
''' </summary>
Public Const IconButtonStop As String = "M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z"
''' <summary>
''' 图标按钮,勾选,1x
''' </summary>
Public Const IconButtonCheck As String = "M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"
''' <summary>
''' 图标按钮,笔,1x
''' </summary>
Public Const IconButtonEdit As String = "M732.64 64.32C688.576 21.216 613.696 21.216 569.6 64.32L120.128 499.52c-17.6 12.896-26.432 30.144-30.848 51.68L32 870.048c0 25.856 8.8 56 26.432 73.248 17.632 17.216 17.632 48.704 88.64 48.704h13.248l326.08-56c22.016-4.32 39.68-12.928 52.864-30.176l449.472-435.2c22.048-21.536 35.264-47.36 35.264-77.536 0-30.176-13.216-56-35.264-77.568l-256.096-251.2zM139.712 903.776l56-326.912 311.04-295.136 267.104 269.44-310.976 295.168-323.168 57.44zM844.576 467.84l-273.984-260.672 61.856-59.84c8.832-8.512 26.528-8.512 39.776 0l234.24 226.496c4.384 4.288 8.832 12.8 8.832 17.088s-4.416 8.544-8.864 12.8l-61.856 64.128z"
@@ -471,11 +479,11 @@ Public Module ModBase
Const Digits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/+="
'零与负数的处理
If String.IsNullOrEmpty(Input) Then Return "0"
Dim IsNegative As Boolean = Input.StartsWith("-")
Dim IsNegative As Boolean = Input.StartsWithF("-")
If IsNegative Then Input = Input.TrimStart("-")
'转换为十进制
Dim RealNum As Long = 0, Scale As Long = 1
For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOf(l))
For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOfF(l))
RealNum += Digit * Scale
Scale *= FromRadix
Next
@@ -614,82 +622,53 @@ Public Module ModBase
End Sub
'Ini 文件
Private Class IniCache
Public FileContent As String = ""
Public KVCache As New Dictionary(Of String, String)
End Class
Private ReadOnly IniCacheList As New Dictionary(Of String, IniCache)
Private ReadOnly IniCache As New Dictionary(Of String, Dictionary(Of String, String))
''' <summary>
''' 清除某 Ini 文件的运行时缓存。
''' 清除某 ini 文件的运行时缓存。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
Public Sub IniClearCache(FileName As String)
'还原文件路径
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
'检索缓存
If IniCacheList.ContainsKey(FileName) Then IniCacheList.Remove(FileName)
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
If IniCache.ContainsKey(FileName) Then IniCache.Remove(FileName)
End Sub
''' <summary>
''' 获取 Ini 文件内容,这可能会使用到缓存。
''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
''' 在文件不存在或读取失败时返回 Nothing。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
Private Function IniGetContent(FileName As String) As IniCache
Private Function IniGetContent(FileName As String) As Dictionary(Of String, String)
Try
'还原文件路径
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
'检索缓存
If IniCacheList.ContainsKey(FileName) Then
'返回缓存中的信息
Dim Cache As New IniCache
IniCacheList.TryGetValue(FileName, Cache)
Return Cache '防止ByRef导致缓存变更
Else
Dim Ini As IniCache
If File.Exists(FileName) Then
'返回文件信息并且记入缓存
Dim Cache As String = (vbCrLf & ReadFile(FileName) & vbCrLf).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf).Replace(vbNullChar, "")
Ini = New IniCache With {.FileContent = Cache}
Else
'返回空文件信息
Ini = New IniCache With {.FileContent = ""}
End If
If Not IniCacheList.ContainsKey(FileName) Then IniCacheList.Add(FileName, Ini) '避免多线程异步执行此方法时造成多次添加项
Return Ini
End If
If IniCache.ContainsKey(FileName) Then Return IniCache(FileName)
'读取文件
If Not File.Exists(FileName) Then Return Nothing
Dim Ini As New Dictionary(Of String, String)
For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
Dim Index As Integer = Line.IndexOfF(":")
If Index > 0 Then Ini.Add(Line.Substring(0, Index), Line.Substring(Index + 1))
Next
IniCache(FileName) = Ini
Return Ini
Catch ex As Exception
Log(ex, "读取文件失败:" & FileName, LogLevel.Hint)
Return New IniCache With {.FileContent = ""}
Log(ex, $"生成 ini 文件缓存失败({FileName})", LogLevel.Hint)
Return Nothing
End Try
End Function
''' <summary>
''' 读取Ini文件,这可能会使用到缓存。
''' 读取 ini 文件。这可能会使用到缓存。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
''' <param name="Key">键。</param>
''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
Try
'获取目前文件
Dim NowIni As IniCache = IniGetContent(FileName)
If IsNothing(NowIni) Then Return DefaultValue
'使用缓存
If NowIni.KVCache.ContainsKey(Key) Then Return If(NowIni.KVCache(Key), DefaultValue)
'没有缓存,读取文件
If NowIni.FileContent.Contains(vbCrLf & Key & ":") Then
Dim Ret As String = Mid(NowIni.FileContent, NowIni.FileContent.IndexOf(vbCrLf & Key & ":") + 3)
Ret = If(Ret.Contains(vbCrLf), Mid(Ret, 1, Ret.IndexOf(vbCrLf)), Ret).Replace(Key & ":", "")
NowIni.KVCache.Add(Key, If(Ret = vbLf, "", Ret))
Return If(Ret = vbLf, "", Ret)
Else
Return DefaultValue
End If
Catch ex As Exception
'读取失败
Return DefaultValue
End Try
Dim Content = IniGetContent(FileName)
If Content Is Nothing OrElse Not Content.ContainsKey(Key) Then Return DefaultValue
Return Content(Key)
End Function
''' <summary>
''' 写入ini文件,这会更新缓存。
''' 写入 ini 文件,这会更新缓存。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
''' <param name="Key">键。</param>
@@ -697,47 +676,41 @@ Public Module ModBase
''' <remarks></remarks>
Public Sub WriteIni(FileName As String, Key As String, Value As String)
Try
'还原文件路径
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
If IsNothing(Value) Then Value = ""
Value = Value.Replace(vbCrLf, "")
'创建文件夹
If Not Directory.Exists(GetPathFromFullPath(FileName)) Then Directory.CreateDirectory(GetPathFromFullPath(FileName))
'预处理
Key = Key.Replace(vbCr, "").Replace(vbLf, "").Replace(":", "")
Value = Value.Replace(vbCr, "").Replace(vbLf, "") '允许 Value 中包含冒号
'获取目前文件
Dim NowFile As String = IniGetContent(FileName).FileContent
If Not NowFile.EndsWith(vbCrLf) Then NowFile += vbCrLf
'如果值一样就不处理
If NowFile.Contains(vbCrLf & Key & ":" & Value & vbCrLf) Then Exit Sub
'处理文件
Dim FindResult As String = ReadIni(FileName, Key)
If FindResult = "" AndAlso Not NowFile.Contains(vbCrLf & Key & ":") Then
'不存在这个键
NowFile = NowFile & vbCrLf & Key & ":" & Value & vbCrLf
Else
'存在这个键
NowFile = NowFile.Replace(vbCrLf & Key & ":" & FindResult & vbCrLf, vbCrLf & Key & ":" & Value & vbCrLf)
End If
WriteFile(FileName, NowFile)
'刷新目前缓存
IniCacheList(FileName).FileContent = NowFile
IniCacheList(FileName).KVCache.Remove(Key)
IniCacheList(FileName).KVCache.Add(Key, Value)
Dim Content As Dictionary(Of String, String) = IniGetContent(FileName)
If Content Is Nothing Then Content = New Dictionary(Of String, String)
If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Exit Sub '如果值一样就不处理
'更新缓存
Content(Key) = Value
'写入文件
Dim FileContent As New StringBuilder
For Each Pair In Content
FileContent.Append(Pair.Key)
FileContent.Append(":")
FileContent.Append(Pair.Value)
FileContent.Append(vbCrLf)
Next
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
WriteFile(FileName, FileContent.ToString)
Catch ex As Exception
Log(ex, "写入文件失败:" & FileName & "/" & Key & ": " & Value)
Log(ex, $"写入文件失败({FileName} -> {Key}:{Value})")
End Try
End Sub
'路径处理
''' <summary>
''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。不包含路径将会抛出异常。
''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
''' 取决于原路径格式,路径以 / 或 \ 结尾。
''' 不包含路径将会抛出异常。
''' </summary>
Public Function GetPathFromFullPath(FilePath As String) As String
If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Throw New Exception("不包含路径:" & FilePath)
If FilePath.EndsWith("\") OrElse FilePath.EndsWith("/") Then
If FilePath.EndsWithF("\") OrElse FilePath.EndsWithF("/") Then
'是文件夹路径
Dim IsRight As Boolean = FilePath.EndsWith("\")
Dim IsRight As Boolean = FilePath.EndsWithF("\")
FilePath = Left(FilePath, Len(FilePath) - 1)
GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath)
@@ -752,11 +725,13 @@ Public Module ModBase
''' </summary>
Public Function GetFileNameFromPath(FilePath As String) As String
FilePath = FilePath.Replace("/", "\")
If FilePath.EndsWith("\") Then Throw New Exception("不包含文件名:" & FilePath)
Dim FileName As String = FilePath.Split("\").Last.Split("?").First '去掉网络参数后的 ?
If FileName.Length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
If FileName.Length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
Return FileName
If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
Dim length As Integer = FilePath.Length
If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
If length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
Return FilePath
End Function
''' <summary>
''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
@@ -764,7 +739,7 @@ Public Module ModBase
Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String
Dim Name As String = GetFileNameFromPath(FilePath)
If Name.Contains(".") Then
Return Name.Substring(0, Name.LastIndexOf("."))
Return Name.Substring(0, Name.LastIndexOfF("."))
Else
Return Name
End If
@@ -773,8 +748,8 @@ Public Module ModBase
''' 从文件夹路径获取文件夹名。
''' </summary>
Public Function GetFolderNameFromPath(FolderPath As String) As String
If FolderPath.EndsWith(":\") OrElse FolderPath.EndsWith(":\\") Then Return FolderPath.Substring(0, 1)
If FolderPath.EndsWith("\") OrElse FolderPath.EndsWith("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") Then Return FolderPath.Substring(0, 1)
If FolderPath.EndsWithF("\") OrElse FolderPath.EndsWithF("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
Return GetFileNameFromPath(FolderPath)
End Function
@@ -1027,7 +1002,7 @@ Public Module ModBase
Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
folderDialog.ShowDialog()
SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWith("\"), "", "\"))
SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWithF("\"), "", "\"))
Log("[UI] 选择文件夹返回:" & SelectFolder)
End Function
@@ -1038,8 +1013,8 @@ Public Module ModBase
Public Function CheckPermission(Path As String) As Boolean
Try
If Path = "" Then Return False
If Not Path.EndsWith("\") Then Path += "\"
If Path.EndsWith(":\System Volume Information\") OrElse Path.EndsWith(":\$RECYCLE.BIN\") Then Return False
If Not Path.EndsWithF("\") Then Path += "\"
If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Not Directory.Exists(Path) Then Return False
Dim FileName As String = "CheckPermission" & GetUuid()
If File.Exists(Path & FileName) Then File.Delete(Path & FileName)
@@ -1056,7 +1031,7 @@ Public Module ModBase
''' </summary>
Public Sub CheckPermissionWithException(Path As String)
If String.IsNullOrWhiteSpace(Path) Then Throw New ArgumentNullException("文件夹名不能为空!")
If Not Path.EndsWith("\") Then Path += "\"
If Not Path.EndsWithF("\") Then Path += "\"
If Not Directory.Exists(Path) Then Throw New DirectoryNotFoundException("文件夹不存在!")
If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission")
File.Create(Path & "CheckPermission").Dispose()
@@ -1245,7 +1220,7 @@ Re:
Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
Try
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWith(".gz") Then
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)
@@ -1262,7 +1237,7 @@ Re:
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWith("\") OrElse DestinationPath.EndsWith("/") Then
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
@@ -1318,9 +1293,9 @@ Re:
''' </summary>
Public Sub CopyDirectory(FromPath As String, ToPath As String)
FromPath = FromPath.Replace("/", "\")
If Not FromPath.EndsWith("\") Then FromPath &= "\"
If Not FromPath.EndsWithF("\") Then FromPath &= "\"
ToPath = ToPath.Replace("/", "\")
If Not ToPath.EndsWith("\") Then ToPath &= "\"
If Not ToPath.EndsWithF("\") Then ToPath &= "\"
For Each File In EnumerateFiles(FromPath)
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
Next
@@ -1567,6 +1542,42 @@ Re:
Return tmp.ToString()
End Function
''' <summary>
''' 高速的 StartsWith。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 EndsWith。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 支持可变大小写判断的 Contains。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
End Function
''' <summary>
''' 高速的 IndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function IndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 LastIndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 输入 And 字符不会报错的 Val。
''' </summary>
@@ -1649,14 +1660,14 @@ Re:
Source = Source.ToLower.Replace(" ", "")
Query = Query.ToLower.Replace(" ", "")
Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
Do While qp < Query.Length
Do While qp < queryLength
'对 qp 作为开始位置计算
Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
'查找以 qp 为头的最大子串
Do While sp < Source.Length
'对每个 sp 作为开始位置计算最大子串
Dim len As Integer = 0
Do While (qp + len) < Query.Length AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
Do While (qp + len) < queryLength AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
len += 1
Loop
'存储 len
@@ -1671,7 +1682,7 @@ Re:
Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空
'存储 lenSum
Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
IncWeight *= (1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax))) '根据位置加成
IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
lenSum += IncWeight
End If
'根据结果增加 qp
@@ -1721,23 +1732,24 @@ Re:
Public Function Search(Of T)(Entries As List(Of SearchEntry(Of T)), Query As String, Optional MaxBlurCount As Integer = 5, Optional MinBlurSimilarity As Double = 0.1) As List(Of SearchEntry(Of T))
'初始化
Dim ResultList As New List(Of SearchEntry(Of T))
If Entries.Count = 0 Then Return ResultList
If Not Entries.Any() Then Return ResultList
'进行搜索,获取相似信息
For Each Entry In Entries
Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
Entry.AbsoluteRight = False
For Each Pair In Entry.SearchSource
If Pair.Key.ToLower.Replace(" ", "").Contains(Query.ToLower.Replace(" ", "")) Then Entry.AbsoluteRight = True
If Pair.Key.Replace(" ", "").ContainsF(Query.Replace(" ", ""), True) Then Entry.AbsoluteRight = True
Next
Next
'按照相似度进行排序
Entries = Sort(Entries, Function(Left As SearchEntry(Of T), Right As SearchEntry(Of T)) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight
Else
Return Left.Similarity > Right.Similarity
End If
End Function)
Entries = Sort(Entries,
Function(Left, Right) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight
Else
Return Left.Similarity > Right.Similarity
End If
End Function)
'返回结果
Dim BlurCount As Integer = 0
For Each Entry In Entries
@@ -2089,7 +2101,7 @@ NextElement:
Dim AllArguments() As String = Command.Split(" ")
For i = 0 To AllArguments.Length - 1
If AllArguments(i) = "-" & Name Then
If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWith("-") Then Return True
If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWithF("-") Then Return True
Return AllArguments(i + 1)
End If
Next
@@ -2116,7 +2128,7 @@ NextElement:
''' </summary>
Public Sub OpenWebsite(Url As String)
Try
If Not Url.ToLower.StartsWith("http") Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
If Not Url.StartsWithF("http", True) Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
Log("[System] 正在打开网页:" & Url)
Process.Start(Url)
Catch ex As Exception
@@ -490,7 +490,7 @@
Select Case Loader.State
Case LoadState.Finished
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart
@@ -500,7 +500,7 @@
End If
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart
@@ -517,9 +517,9 @@ Restart:
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
If LoaderType.StartsWith("LoaderTask") OrElse LoaderType.StartsWith("LoaderCombo") Then
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
ElseIf LoaderType.StartsWith("LoaderDownload") Then
ElseIf LoaderType.StartsWithF("LoaderDownload") Then
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
Else
Throw New Exception("未知的加载器类型(" & LoaderType & ")")
@@ -545,7 +545,7 @@ Restart:
Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
For Each SubLoader In Loader.Loaders
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
If SubLoader.GetType.Name.StartsWith("LoaderCombo") Then GetLoaderList(SubLoader, List)
If SubLoader.GetType.Name.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
Next
End Sub
''' <summary>
@@ -606,7 +606,7 @@ Restart:
End If
RunInUi(Sub() FrmMain.BtnExtraDownload.Progress = LoaderTaskbarProgress)
'更新任务栏信息
If LoaderTaskbar.Count = 0 OrElse LoaderTaskbarProgress = 1 Then
If Not LoaderTaskbar.Any() OrElse LoaderTaskbarProgress = 1 Then
NewState = Shell.TaskbarItemProgressState.None
ElseIf LoaderTaskbarProgress < 0.015 Then
NewState = Shell.TaskbarItemProgressState.Indeterminate
+14 -14
View File
@@ -189,7 +189,7 @@ RequestFinished:
Dim Request As HttpWebRequest = WebRequest.Create(Url)
Dim Result As New List(Of Byte)
Try
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11
If Url.StartsWithF("https", True) Then Request.ProtocolVersion = HttpVersion.Version11
Request.Timeout = Timeout
Request.Accept = Accept
SecretHeadersSign(Url, Request, UseBrowserUserAgent)
@@ -397,7 +397,7 @@ RequestFinished:
Req.ContentType = ContentType
Req.Timeout = Timeout
SecretHeadersSign(Url, Req, UseBrowserUserAgent)
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11
If Url.StartsWithF("https", True) Then Req.ProtocolVersion = HttpVersion.Version11
If Method = "POST" OrElse Method = "PUT" Then
Req.ContentLength = SendData.Length
DataStream = Req.GetRequestStream()
@@ -897,7 +897,7 @@ RequestFinished:
''' 新建一个需要下载的文件。
''' </summary>
''' <param name="LocalPath">包含文件名的本地地址。</param>
Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Dim Sources As New List(Of NetSource)
Dim Count As Integer = 0
Urls = Urls.Distinct.ToArray
@@ -987,7 +987,7 @@ StartThread:
'构建线程
Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks
If Tasks.Count = 0 Then Return False '由于中断,已没有可用任务
If Not Tasks.Any() Then Return False '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal}
End SyncLock
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
@@ -1035,7 +1035,7 @@ StartThread:
If SourcesOnce.Contains(Info.Source) AndAlso Not Info.Equals(Info.Source.Thread) Then GoTo SourceBreak
'请求头
HttpRequest = WebRequest.Create(Info.Source.Url)
If Info.Source.Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then HttpRequest.ProtocolVersion = HttpVersion.Version11
If Info.Source.Url.StartsWithF("https", True) Then HttpRequest.ProtocolVersion = HttpVersion.Version11
'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
HttpRequest.Timeout = Timeout
HttpRequest.AddRange(Info.DownloadStart)
@@ -1067,11 +1067,11 @@ StartThread:
If ThreadFileSize > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
Dim DriveName As String = Drive.Name.First.ToString
Dim RequiredSpace = If(PathTemp.StartsWith(DriveName), ThreadFileSize * 1.1, 0) +
If(LocalPath.StartsWith(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0)
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ThreadFileSize * 1.1, 0) +
If(LocalPath.StartsWithF(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0)
If Drive.TotalFreeSpace < RequiredSpace Then
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
If(PathTemp.StartsWith(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
End If
Next
End If
@@ -1465,7 +1465,7 @@ Retry:
Public Overrides Property Progress As Double
Get
If State >= LoadState.Finished Then Return 1
If Files.Count = 0 Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
Return _Progress
End Get
Set(value As Double)
@@ -1559,21 +1559,21 @@ NextElement:
RunInNewThread(Sub()
Try
'输入检测
If Files.Count = 0 Then
If Not Files.Any() Then
OnFinish()
Exit Sub
End If
For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
For Each Source As NetSource In File.Sources
If Not (Source.Url.ToLower.StartsWith("https://") OrElse Source.Url.ToLower.StartsWith("http://")) Then
If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then
Source.Ex = New ArgumentException("输入的下载链接不正确!")
Source.IsFailed = True
End If
Next
If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确!")
If File.LocalPath.EndsWith("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
'文件夹检测
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
@@ -1626,7 +1626,7 @@ NextElement:
For Each File As NetFile In Files
Dim ExistFilePath As String = Nothing
'判断是否有已存在的文件
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWith(PathMcFolder) Then
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
For Each Folder In FolderList
Dim Target = Folder & Relative
@@ -1699,7 +1699,7 @@ Retry:
Public Sub OnFail(ExList As List(Of Exception))
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("未知错误!")}
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
'寻找第一个不是 404 的下载源
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0))
@@ -76,7 +76,7 @@ Public Class ValidateHttp
Public Sub New()
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
If Str.EndsWith("/") Then Str = Str.Substring(0, Str.Length - 1)
If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效!"
Return ""
End Function
@@ -149,7 +149,7 @@ Public Class ValidateExcept
End Sub
Public Overrides Function Validate(Str As String) As String
For Each Ch As String In Excepts
If Str.IndexOf(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
If Str.IndexOfF(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
If IsNothing(ErrorMessage) Then ErrorMessage = ""
Return ErrorMessage.Replace("%", Ch)
End If
@@ -220,13 +220,13 @@ Public Class ValidateFolderName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
If Str.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 100).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
@@ -273,13 +273,13 @@ Public Class ValidateFileName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件名不能以空格结尾!"
If Str.StartsWithF(" ") Then Return "文件名不能以空格开头!"
If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件名不能以小数点结尾!"
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
@@ -319,7 +319,7 @@ Public Class ValidateFolderPath
Public Overrides Function Validate(Str As String) As String
'去除尾部斜线,统一为 \
Str = Str.Replace("/", "\")
If Not Str.TrimEnd("\").EndsWith(":") Then Str = Str.TrimEnd("\")
If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
@@ -327,15 +327,15 @@ Public Class ValidateFolderPath
LengthCheck = New ValidateLength(1, 254).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查开头
If Str.StartsWith("\\Mac\") Then GoTo Fin
If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.ToUpper = Drive.Name Then Return ""
If Str.ToUpper.StartsWith(Drive.Name) Then GoTo Fin
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
Next
Return "文件夹路径头存在错误!"
Fin:
'对首层以外的路径检查
For i = If(Str.StartsWith("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
For i = If(Str.StartsWithF("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
Dim SubStr As String = Str.Split("\")(i)
'检查是否为空
Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr)
@@ -344,10 +344,10 @@ Fin:
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
If Not CharactCheck = "" Then Return CharactCheck
'检查头部空格
If SubStr.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
If SubStr.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If SubStr.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查尾部小数点
If SubStr.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
If SubStr.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
@@ -55,7 +55,7 @@ Public Class MyBitmap
Public Sub New(FilePathOrResourceName As String)
Try
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWith(PathImage) Then
If FilePathOrResourceName.StartsWithF(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
Pic = BitmapCache(FilePathOrResourceName).Pic
@@ -18,6 +18,7 @@
'https://docs.curseforge.com/?http#tocS_ModLoaderType
Any = 0
Forge = 1
LiteLoader = 3
Fabric = 4
Quilt = 5
NeoForge = 6
@@ -43,10 +44,10 @@
For Each EntryData As String In Line.Split("¨")
Dim Entry = New CompDatabaseEntry
Dim SplitedLine = EntryData.Split("|")
If SplitedLine(0).StartsWith("@") Then
If SplitedLine(0).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
ElseIf SplitedLine(0).EndsWith("@") Then
ElseIf SplitedLine(0).EndsWithF("@") Then
Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf SplitedLine(0).Contains("@") Then
@@ -247,12 +248,26 @@
LastUpdate = Data("dateReleased") '#1194
DownloadCount = Data("downloadCount")
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
'FileIndexes / GameVersions
Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray).
Where(Function(i) i("gameVersion").ToString.Contains("1."))
CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).Distinct.ToList
GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'FileIndexes / GameVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
For Each File In If(Data("latestFiles"), New JArray)
Dim NewFile As New CompFile(File, Type)
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
If Not GameVersions.Any(Function(v) v.StartsWithF("1.")) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
Next
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599
If Not File("gameVersion").ToString.StartsWithF("1.") Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
Select(Function(v) CInt(Val(v.Split(".")(1).Split("-").First))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
@@ -309,15 +324,7 @@
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
For Each File In If(Data("latestFiles"), {})
Dim NewFile As New CompFile(File, Type)
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Next
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
If Not Tags.Any() Then Tags.Add("杂项")
#End Region
Else
#Region "Modrinth"
@@ -334,7 +341,7 @@
'GameVersions
'搜索结果的键为 versions,获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type
@@ -383,7 +390,7 @@
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
If Not Tags.Any() Then Tags.Add("杂项")
Tags.Sort()
ModLoaders.Sort()
#End Region
@@ -562,7 +569,7 @@
End If
Next
'根据分类后的结果处理
If NormalNameList.Count = 0 OrElse SubtitleList.Count = 0 Then GoTo NoSubtitle
If Not NormalNameList.Any() OrElse Not SubtitleList.Any() Then GoTo NoSubtitle
'同时包含 NormalName 和 Subtitle
Title = NormalNameList.Join(" - ")
Else
@@ -683,8 +690,8 @@ NoSubtitle:
''' </summary>
Public ReadOnly Property CanContinue As Boolean
Get
If Tag.StartsWith("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
If Tag.EndsWith("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
If Tag.StartsWithF("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
If Tag.EndsWithF("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
End Get
@@ -732,7 +739,7 @@ NoSubtitle:
''' </summary>
Public Function GetCurseForgeAddress() As String
If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing
If Tag.StartsWith("/") Then Storage.CurseForgeTotal = 0
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
'应用筛选参数
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}"
@@ -756,7 +763,7 @@ NoSubtitle:
''' </summary>
Public Function GetModrinthAddress() As String
If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing
If Tag.EndsWith("/") Then Storage.ModrinthTotal = 0
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
'应用筛选参数
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance"
@@ -828,7 +835,7 @@ NoSubtitle:
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
Exit Sub
ElseIf Not Task.Input.CanContinue Then
If Task.Input.Storage.Results.Count = 0 Then
If Not Task.Input.Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果")
Else
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
@@ -867,7 +874,7 @@ NoSubtitle:
Next
'获取搜索结果
Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3)
If SearchResults.Count = 0 Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
If Not SearchResults.Any() Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
Dim SearchResult As String = ""
For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
@@ -880,7 +887,7 @@ NoSubtitle:
'去除常见连接词
Dim RealFilter As String = ""
For Each Word In SearchResult.Split(" ")
If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLower) OrElse Val(Word) > 0 Then Continue For
If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLowerInvariant) OrElse Val(Word) > 0 Then Continue For
If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
Next
@@ -904,15 +911,15 @@ NoSubtitle:
End If
RightKeywords.Add(Keyword)
Next
If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then
If RawFilter.Length > 0 AndAlso Not RightKeywords.Any() Then
Task.Input.SearchText = RawFilter '全都被过滤掉了
Else
Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
End If
'例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchText = "optiforge"
If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchText = "optifabric"
If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Task.Input.SearchText = "optiforge"
If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Task.Input.SearchText = "optifabric"
Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Debug)
Task.Progress = 0.1
@@ -1003,15 +1010,15 @@ Retry:
'确保存在结果
Storage.ErrorMessage = Nothing
If RawResults.Count = 0 Then
If Not RawResults.Any() Then
If [Error] IsNot Nothing Then
Throw [Error]
Else
If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then
Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文")
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWith("/") Then
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWithF("/") Then
Throw New Exception("CurseForge 不兼容所选的类型")
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWith("/") Then
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型")
Else
Throw New Exception("没有符合条件的结果")
@@ -1171,7 +1178,7 @@ Retry:
''' </summary>
Public ReadOnly Property Available As Boolean
Get
Return FileName IsNot Nothing
Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
End Get
End Property
''' <summary>
@@ -1181,7 +1188,11 @@ Retry:
''' <summary>
''' 文件所有可能的下载源。
''' </summary>
Private ReadOnly DownloadAddress As String()
Public DownloadUrls As List(Of String)
''' <summary>
''' 文件的 SHA1 或 MD5。
''' </summary>
Public ReadOnly Hash As String = Nothing
''' <summary>
''' 该文件的所有依赖工程的原始 ID。
''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
@@ -1196,7 +1207,7 @@ Retry:
''' </summary>
''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalAddress As String) As NetFile
Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""), UseBrowserUserAgent:=True)
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
End Function
'实例化
@@ -1206,94 +1217,136 @@ Retry:
''' </summary>
Public Sub New(Data As JObject, Type As CompType)
Me.Type = Type
FromCurseForge = Data.ContainsKey("gameId")
If FromCurseForge Then
#Region "CurseForge"
'简单信息
Id = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("fileDate")
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount")
FileName = Data("fileName")
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url}.Distinct.ToArray
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
Select(Function(d) d("modId").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
If RawVersions.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
If Data.ContainsKey("FromCurseForge") Then
#Region "CompJson"
FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
Id = Data("Id").ToString
DisplayName = Data("DisplayName").ToString
ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
DownloadCount = Data("DownloadCount").ToObject(Of Integer)
Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus)
If Data.ContainsKey("FileName") Then FileName = Data("FileName").ToString
If Data.ContainsKey("DownloadUrls") Then DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of List(Of CompModLoaderType))
If Data.ContainsKey("Hash") Then Hash = Data("Hash").ToString
If Data.ContainsKey("GameVersions") Then GameVersions = Data("GameVersions").ToObject(Of List(Of String))
If Data.ContainsKey("RawDependencies") Then RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
If Data.ContainsKey("Dependencies") Then Dependencies = Data("Dependencies").ToObject(Of List(Of String))
#End Region
Else
#Region "Modrinth"
'简单信息
Id = Data("id")
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
'可能为空
If CType(Data("files"), JArray).Count > 0 Then
FileName = Data("files")(0)("filename")
DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, FileName)}
End If
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
d("project_id").ToString.Length > 0). '有时候真的会空……
Select(Function(d) d("project_id").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.") OrElse v.StartsWith("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWith("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
FromCurseForge = Data.ContainsKey("gameId")
If FromCurseForge Then
#Region "CurseForge"
'简单信息
Id = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("fileDate")
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount")
FileName = Data("fileName")
Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url}).Distinct().ToList()
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
Select(Function(d) d("modId").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
If RawVersions.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
#End Region
Else
#Region "Modrinth"
'简单信息
Id = Data("id")
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
'可能为空
If CType(Data("files"), JArray).Any() Then
Dim File As JToken = Data("files")(0)
FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url")}
Hash = File("hashes")("sha1")
End If
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
d("project_id").ToString.Length > 0). '有时候真的会空……
Select(Function(d) d("project_id").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region
End If
End If
End Sub
''' <summary>
''' 将当前实例转为可用于保存缓存的 Json。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
Json.Add("FromCurseForge", FromCurseForge)
Json.Add("Id", Id)
Json.Add("DisplayName", DisplayName)
Json.Add("ReleaseDate", ReleaseDate)
Json.Add("DownloadCount", DownloadCount)
Json.Add("ModLoaders", New JArray(ModLoaders.Select(Function(m) CInt(m))))
Json.Add("GameVersions", New JArray(GameVersions))
Json.Add("Status", CInt(Status))
If FileName IsNot Nothing Then Json.Add("FileName", FileName)
If DownloadUrls IsNot Nothing Then Json.Add("DownloadUrls", New JArray(DownloadUrls))
If Hash IsNot Nothing Then Json.Add("Hash", Hash)
Json.Add("RawDependencies", New JArray(RawDependencies))
Json.Add("Dependencies", New JArray(Dependencies))
Return Json
End Function
''' <summary>
''' 将当前文件信息实例化为控件。
''' </summary>
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
@@ -1434,7 +1487,7 @@ Retry:
'如果为整合包就不会有 Dependencies 信息,所以不用管
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
Deps.Sort()
If Deps.Count = 0 Then Exit Sub
If Not Deps.Any() Then Exit Sub
Deps = Deps.Where(Function(dep)
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
Return CompProjectCache.ContainsKey(dep)
@@ -80,7 +80,7 @@
Log(ex, "确认崩溃日志时间失败(" & LogFile & ")")
End Try
Next
If RightLogs.Count = 0 Then Log("[Crash] 未发现可能可用的日志文件")
If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件")
'将可能可用的日志文件导出
For Each FilePath In RightLogs
@@ -114,7 +114,7 @@
Try
Dim Info As New FileInfo(FilePath)
If Not Info.Exists OrElse Info.Length = 0 Then Exit Try
If Not FilePath.ToLower.EndsWith(".jar") AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then
If Not FilePath.EndsWithF(".jar", True) AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then
'解压成功
Log("[Crash] 已解压导入的日志文件:" & FilePath)
Else
@@ -132,7 +132,7 @@
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
If Ext = ".log" OrElse Ext = ".txt" Then
If TargetFile.Name.StartsWith("crash-") Then
If TargetFile.Name.StartsWithF("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
@@ -169,10 +169,10 @@
For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim TargetType As AnalyzeFileType
If MatchName.StartsWith("hs_err") Then
If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile
ElseIf MatchName.StartsWith("crash-") Then
ElseIf MatchName.StartsWithF("crash-") Then
TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
@@ -187,13 +187,13 @@
Else
TargetType = AnalyzeFileType.ExtraLog
End If
ElseIf MatchName.EndsWith(".log") OrElse MatchName.EndsWith(".txt") Then
ElseIf MatchName.EndsWithF(".log", True) OrElse MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraLog
Else
Log("[Crash] " & MatchName & " 分类为 Ignore")
Continue For
End If
If LogFile.Value.Count = 0 Then
If Not LogFile.Value.Any() Then
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
@@ -208,7 +208,7 @@
For Each File In TotalFiles
If SelectType = File.Key Then SelectedFiles.Add(File.Value)
Next
If SelectedFiles.Count = 0 Then Continue For
If Not SelectedFiles.Any() Then Continue For
Try
'根据文件类别判断
Select Case SelectType
@@ -437,7 +437,7 @@
'输出到日志
Done:
If CrashReasons.Count = 0 Then
If Not CrashReasons.Any() Then
Log("[Crash] 步骤 3:分析崩溃原因完成,未找到可能的原因")
Else
Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因")
@@ -645,14 +645,14 @@ Done:
"org.lwjgl", "com.sun", "net.minecraftforge", "paulscode.sound", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
"com.electronwill.nightconfig", "it.unimi.dsi",
"MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack
Next
PossibleStacks.Add(Stack.Trim) '.Split("$").First)
NextStack:
Next
PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
If PossibleStacks.Count = 0 Then Return New List(Of String)
If Not PossibleStacks.Any() Then Return New List(Of String)
For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack)
Next
@@ -663,7 +663,7 @@ NextStack:
Dim Splited = Stack.Split(".")
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
@@ -716,8 +716,8 @@ NextStack:
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ToLower.Contains(".jar") OrElse
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
If Line.ContainsF(".jar", True) OrElse
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -782,7 +782,7 @@ NextStack:
'输出
ModFileNames = ModFileNames.Distinct.ToList
If ModFileNames.Count = 0 Then
If Not ModFileNames.Any() Then
Return Nothing
Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
@@ -866,7 +866,7 @@ NextStack:
Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String
'没有结果的处理
If CrashReasons.Count = 0 Then
If Not CrashReasons.Any() Then
If IsHandAnalyze Then
Return "很抱歉,PCL 无法确定错误原因。"
Else
@@ -1034,7 +1034,7 @@ NextStack:
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Not Results.Any(Function(r) r.EndsWith("\h")) OrElse IsHandAnalyze, "",
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
@@ -57,9 +57,9 @@
#Region "下载支持库文件"
Dim LoadersLib As New List(Of LoaderBase) From {
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
}
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
}
'构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载支持库文件(主加载器)", LoadersLib) With {.Block = False, .Show = False, .ProgressWeight = 16})
#End Region
@@ -71,19 +71,19 @@
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
End Sub) With {.ProgressWeight = 0.5, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载资源文件索引
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
'要求独立更新索引
@@ -91,27 +91,29 @@
Dim LoadersAssetsUpdate As New List(Of LoaderBase)
Dim TempAddress As String = Nothing
Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
End Sub))
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
End Sub))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Log("[Download] 开始后台更新资源文件索引")
Updater.Start()
End If
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器
@@ -248,7 +250,7 @@
End Select
'确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
If Id <> "1.0" AndAlso Id.EndsWith(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
'查找版本并开始
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then
@@ -306,7 +308,7 @@
Return _inherit
End Get
Set(value As String)
If value.EndsWith(".0") Then value = Left(value, value.Length - 2)
If value.EndsWithF(".0") Then value = Left(value, value.Length - 2)
_inherit = value
End Set
End Property
@@ -366,9 +368,9 @@
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ToLower.Contains("pre"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ToLower.Contains("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
@@ -389,7 +391,7 @@
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ToLower.Contains("pre"),
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
@@ -601,7 +603,7 @@
Dim Versions As New List(Of DlForgeVersionEntry)
Try
'分割版本信息
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOf("</table>")).Split("<td class=""download-version")
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
'获取所有版本信息
For i = 1 To VersionCodes.Count - 1
Dim VersionCode = VersionCodes(i)
@@ -626,17 +628,17 @@
Dim MD5 As String, Category As String
If VersionCode.Contains("classifier-installer""") Then
'类型为 installer.jar,支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("installer.jar"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "installer"
ElseIf VersionCode.Contains("classifier-universal""") Then
'类型为 universal.zip,支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("universal.zip"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "universal"
ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip,支持范围 182~ (1.3.2 部分 ~)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("client.zip"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "client"
Else
@@ -652,7 +654,7 @@
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result & ")", ex)
End Try
If Versions.Count = 0 Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
End Sub
@@ -708,7 +710,7 @@
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
End Try
If Versions.Count = 0 Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
End Sub
@@ -799,7 +801,7 @@
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
@@ -827,7 +829,7 @@
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
@@ -62,7 +62,7 @@
Public ReadOnly Property HasEnvironment As Boolean
Get
If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False
Return PathEnv.Replace("\", "").Replace("/", "").ToLower.Contains(PathFolder.Replace("\", "").ToLower)
Return PathEnv.Replace("\", "").Replace("/", "").ContainsF(PathFolder.Replace("\", ""), True)
End Get
End Property
@@ -78,7 +78,7 @@
''' </summary>
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWith("1.") Then VersionString = Mid(VersionString, 3)
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")," & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
End Function
@@ -87,7 +87,7 @@
''' 输入 javaw.exe 文件所在文件夹的路径,不限制结尾。
''' </summary>
Public Sub New(Folder As String, IsUserImport As Boolean)
If Not Folder.EndsWith("\") Then Folder += "\"
If Not Folder.EndsWithF("\") Then Folder += "\"
PathFolder = Folder.Replace("/", "\")
Me.IsUserImport = IsUserImport
End Sub
@@ -116,8 +116,9 @@
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
'获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493,VersionString = "21.0.2.0.2"
Do While VersionString.Split(".").Count < 4
If VersionString.StartsWith("1.") Then
If VersionString.StartsWithF("1.") Then
VersionString = VersionString & ".0"
Else
VersionString = "1." & VersionString
@@ -184,7 +185,7 @@
JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next
End If
If JavaList.Count = 0 Then
If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
JavaSearchLoader.Start(0)
Else
@@ -232,7 +233,7 @@
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWith("{") Then
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
UserJava.Check()
@@ -291,7 +292,7 @@ RetryGet:
Next
'若未找到适合的 Java,尝试触发搜索
If AllowedJavaList.Count = 0 AndAlso JavaSearchLoader.State = LoadState.Waiting Then
If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
Log("[Java] 未找到满足条件的 Java,尝试进行搜索")
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
@@ -352,7 +353,7 @@ ExitUserJavaCheck:
#End Region
'若依然未找到适合的 Java,直接返回
If AllowedJavaList.Count = 0 Then Return Nothing
If Not AllowedJavaList.Any() Then Return Nothing
'优先使用特定目录下的 Java
For Each Java In AllowedJavaList
@@ -445,11 +446,11 @@ NoUserJava:
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName
If Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWith(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Right.PathFolder.StartsWith(ProgramPathParent) Then Return False
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then
If Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWith(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Right.PathFolder.StartsWith(MinecraftPathParent) Then Return False
If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If
'2. 尽量使用 64 位
If Left.Is64Bit AndAlso Not Right.Is64Bit Then Return True
@@ -459,7 +460,7 @@ NoUserJava:
If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20...
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If
@@ -500,7 +501,7 @@ NoUserJava:
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If PathInEnv = "" Then Continue For
If Not PathInEnv.EndsWith("\") Then PathInEnv += "\"
If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\"
'粗略检查有效性
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
Next
@@ -652,7 +653,7 @@ Wait:
'确认目录存在
If Not OriginalPath.Exists Then Exit Sub
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWith("\") Then Path += "\"
If Not Path.EndsWithF("\") Then Path += "\"
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
@@ -715,7 +716,7 @@ Wait:
End Function
''' <summary>
''' 获取下载 Java 8/14/17 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
Return New LoaderCombo(Of Integer)($"下载 Java {Version}", {
@@ -734,7 +735,7 @@ Wait:
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新)
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v)))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWith(Loader.Input))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input))
Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
'获取文件列表
@@ -143,7 +143,7 @@ Public Module ModLaunch
Catch ex As Exception
Dim CurrentEx = ex
NextInner:
If CurrentEx.Message.StartsWith("$") Then
If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息,则以此为准显示提示
'若错误信息为 $$,则不提示
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
@@ -752,7 +752,7 @@ LoginFinish:
End Select
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
ElseIf ex.Message.StartsWith("$") Then
ElseIf ex.Message.StartsWithF("$") Then
Throw
Else
Throw New Exception("登录失败:" & ex.Message, ex)
@@ -990,13 +990,13 @@ SystemBrowser:
Case 1
'Steve
Do Until McSkinSex(Uuid) = "Steve"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 2
'Alex
Do Until McSkinSex(Uuid) = "Alex"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 3
@@ -1013,7 +1013,7 @@ SystemBrowser:
Case 4
'自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
End Select
@@ -1057,7 +1057,12 @@ SystemBrowser:
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'MC 大版本检测
If (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
If (McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
(McVersionCurrent.Version.McCodeMain > 20 AndAlso McVersionCurrent.Version.McCodeMain <> 99) OrElse
(McVersionCurrent.Version.McCodeMain = 20 AndAlso McVersionCurrent.Version.McCodeSub >= 5) Then
'1.20.5+(24w14a+):至少 Java 21
MinVer = New Version(1, 21, 0, 0)
ElseIf (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
(McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
'1.18 pre2+:至少 Java 17
MinVer = New Version(1, 17, 0, 0)
@@ -1140,7 +1145,10 @@ SystemBrowser:
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
McLaunchLog("无合适的 Java,需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 9, 0, 0) Then
If MinVer >= New Version(1, 21, 0, 0) Then
JavaCode = 21
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 9, 0, 0) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
@@ -1394,9 +1402,9 @@ NextVersion:
Dim DeDuplicateDataList As New List(Of String)
For i = 0 To DataList.Count - 1
Dim CurrentEntry As String = DataList(i)
If DataList(i).StartsWith("-") Then
If DataList(i).StartsWithF("-") Then
Do While i < DataList.Count - 1
If DataList(i + 1).StartsWith("-") Then
If DataList(i + 1).StartsWithF("-") Then
Exit Do
Else
i += 1
@@ -1487,9 +1495,9 @@ NextVersion:
Dim DeDuplicateDataList As New List(Of String)
For i = 0 To DataList.Count - 1
Dim CurrentEntry As String = DataList(i)
If DataList(i).StartsWith("-") Then
If DataList(i).StartsWithF("-") Then
Do While i < DataList.Count - 1
If DataList(i + 1).StartsWith("-") Then
If DataList(i + 1).StartsWithF("-") Then
Exit Do
Else
i += 1
@@ -1595,7 +1603,7 @@ NextVersion:
End Try
For Each Entry In Zip.Entries
Dim FileName As String = Entry.FullName
If FileName.EndsWith(".dll") Then
If FileName.EndsWithF(".dll", True) Then
'实际解压文件的步骤
Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName
ExistFiles.Add(FilePath)
@@ -65,7 +65,7 @@
'格式:TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径
For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
If Folder = "" Then Continue For
If Not Folder.Contains(">") OrElse Not Folder.EndsWith("\") Then
If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Critical)
Continue For
End If
@@ -92,13 +92,13 @@
For Each Folder As McFolder In CacheMcFolderList
If Not Folder.Type = McFolderType.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Path)
Next
If NewSetup.Count = 0 Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
If Not NewSetup.Any() Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
Setup.Set("LaunchFolders", Join(NewSetup, "|"))
#End Region
'若没有可用文件夹,则创建 .minecraft
If CacheMcFolderList.Count = 0 Then
If Not CacheMcFolderList.Any() Then
Directory.CreateDirectory(Path & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path & ".minecraft\", .Type = McFolderType.Original})
End If
@@ -149,7 +149,7 @@
#Region "版本处理"
Public Const McVersionCacheVersion As Integer = 26
Public Const McVersionCacheVersion As Integer = 27
Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -418,7 +418,7 @@
End Try
VersionSearchFinish:
'获取版本号
If _Version.McName.StartsWith("1.") Then
If _Version.McName.StartsWithF("1.") Then
Dim SplitVersion = _Version.McName.Split(" "c, "_"c, "-"c, "."c)
Dim SplitResult As String
'分割获取信息
@@ -546,8 +546,8 @@ Recheck:
'处理 JumpLoader
If Text.Contains("minecraftforge") AndAlso File.Exists(PathIndie & "config\jumploader.json") Then
For Each ModFile In Directory.EnumerateFiles(PathIndie & "mods")
Dim FileName As String = GetFileNameFromPath(ModFile).ToLower
If FileName.EndsWith(".jar") AndAlso FileName.Contains("jumploader") Then
Dim FileName As String = GetFileNameFromPath(ModFile)
If FileName.EndsWithF(".jar", True) AndAlso FileName.ContainsF("jumploader", True) Then
Log("[Minecraft] 发现 JumpLoader 分支项:" & FileName)
HasJumpLoader = True
Exit For
@@ -612,7 +612,7 @@ Recheck:
Public Sub New(Path As String)
Me.Path = If(Path.Contains(":"), "", PathMcFolder & "versions\") & '补全完整路径
Path &
If(Path.EndsWith("\"), "", "\") '补全右划线
If(Path.EndsWithF("\"), "", "\") '补全右划线
End Sub
''' <summary>
@@ -684,7 +684,7 @@ Recheck:
'愚人节与快照版本
If If(JsonObject("type"), "").ToString = "fool" OrElse GetMcFoolName(Version.McName) <> "" Then
State = McVersionState.Fool
ElseIf Version.McName.ToLower.Contains("w") OrElse Name.ToLower.Contains("combat") OrElse Version.McName.ToLower.Contains("rc") OrElse Version.McName.ToLower.Contains("pre") OrElse Version.McName.Contains("experimental") OrElse If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending" Then
ElseIf Version.McName.ContainsF("w", True) OrElse Name.ContainsF("combat", True) OrElse Version.McName.ContainsF("rc", True) OrElse Version.McName.ContainsF("pre", True) OrElse Version.McName.ContainsF("experimental", True) OrElse If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending" Then
State = McVersionState.Snapshot
End If
'OptiFine
@@ -744,9 +744,9 @@ ExitDataLoad:
If CustomInfo = "" Then
Select Case State
Case McVersionState.Snapshot
If Version.McName.ToLower.Contains("pre") Then
If Version.McName.ContainsF("pre", True) Then
Info = "预发布版 " & Version.McName
ElseIf Version.McName.ToLower.Contains("rc") Then
ElseIf Version.McName.ContainsF("rc", True) Then
Info = "发布候选 " & Version.McName
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
Info = "实验性快照"
@@ -948,8 +948,8 @@ ExitDataLoad:
(Asc(CType(Left(OptiFineVersion.ToUpper, 1), Char)) - Asc("A"c) + 1) * 10000 + '第二段:字母编号(2 位),如 G2 中的 G(7)
Val(RegexSeek(Right(OptiFineVersion, OptiFineVersion.Length - 1), "[0-9]+")) * 100 '第三段:末尾数字(2 位),如 C5 beta4 中的 5
'第三段:测试标记
If OptiFineVersion.ToLower.Contains("pre") Then _SortCode += 50
If OptiFineVersion.ToLower.Contains("pre") OrElse OptiFineVersion.ToLower.Contains("beta") Then
If OptiFineVersion.ContainsF("pre", True) Then _SortCode += 50
If OptiFineVersion.ContainsF("pre", True) OrElse OptiFineVersion.ContainsF("beta", True) Then
If Val(Right(OptiFineVersion, 1)) = 0 AndAlso Right(OptiFineVersion, 1) <> "0" Then
_SortCode += 1 '为 pre 或 beta 结尾,视作 1
Else
@@ -981,9 +981,9 @@ ExitDataLoad:
''' </summary>
Public Function GetMcFoolName(Name As String) As String
Name = Name.ToLower
If Name.StartsWith("2.0") Then
If Name.StartsWithF("2.0") Then
Return "这个秘密计划了两年的更新将游戏推向了一个新高度!"
ElseIf Name.StartsWith("20w14inf") OrElse Name = "20w14∞" Then
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
ElseIf Name = "15w14a" Then
Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
@@ -994,7 +994,9 @@ ExitDataLoad:
ElseIf Name = "22w13oneblockatatime" Then
Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
ElseIf Name = "23w13a_or_b" Then
Return "研究表明玩家喜欢作出选择——越多越好!"
Return "研究表明:玩家喜欢作出选择——越多越好!"
ElseIf Name = "24w14potato" Then
Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
Else
Return ""
End If
@@ -1018,6 +1020,12 @@ ExitDataLoad:
''' </summary>
Public McVersionListLoader As New LoaderTask(Of String, Integer)("Minecraft Version List", AddressOf McVersionListLoad) With {.ReloadTimeout = 1}
''' <summary>
''' 是否为本次打开 PCL 后第一次加载版本列表。
''' 这会清理所有 .pclignore 文件,而非跳过这些对应版本。
''' </summary>
Private IsFirstMcVersionListLoad As Boolean = True
''' <summary>
''' 开始加载当前 Minecraft 文件夹的版本列表。
''' </summary>
@@ -1040,7 +1048,7 @@ ExitDataLoad:
End Try
End If
'没有可用版本
If FolderList.Count = 0 Then
If Not FolderList.Any() Then
WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存
GoTo OnLoaded
End If
@@ -1062,6 +1070,7 @@ Reload:
WriteIni(Path & "PCL.ini", "VersionCache", FolderListCheck)
McVersionList = McVersionListLoadNoCache(Path)
End If
IsFirstMcVersionListLoad = False
If Loader.IsAborted Then Exit Sub
'改变当前选择的版本
@@ -1114,14 +1123,20 @@ OnLoaded:
'循环读取版本
For Each Folder As String In ReadIni(Path & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
If Folder = "" Then Continue For
If File.Exists(Path & "versions\" & Folder & "\.pclignore") Then
Log("[Minecraft] 跳过要求忽略的项目:" & Path & "versions\" & Folder)
Continue For
Dim VersionFolder As String = $"{Path}versions\{Folder}\"
If File.Exists(VersionFolder & ".pclignore") Then
If IsFirstMcVersionListLoad Then
Log("[Minecraft] 清理残留的忽略项目:" & VersionFolder) '#2781
File.Delete(VersionFolder & ".pclignore")
Else
Log("[Minecraft] 跳过要求忽略的项目:" & VersionFolder)
Continue For
End If
End If
Try
'读取单个版本
Dim Version As New McVersion(Path & "versions\" & Folder & "\")
Dim Version As New McVersion(VersionFolder)
VersionList.Add(Version)
Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "CustomInfo", "")
If Version.Info = "" Then Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "Info", Version.Info)
@@ -1193,11 +1208,17 @@ OnLoaded:
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName)
Continue For
End If
If File.Exists(Folder.FullName & "\.pclignore") Then
Log("[Minecraft] 跳过要求忽略的项目:" & Folder.FullName)
Continue For
Dim VersionFolder As String = Folder.FullName & "\"
If File.Exists(VersionFolder & ".pclignore") Then
If IsFirstMcVersionListLoad Then
Log("[Minecraft] 清理残留的忽略项目:" & VersionFolder) '#2781
File.Delete(VersionFolder & ".pclignore")
Else
Log("[Minecraft] 跳过要求忽略的项目:" & VersionFolder)
Continue For
End If
End If
Dim Version As New McVersion(Folder.FullName & "\")
Dim Version As New McVersion(VersionFolder)
VersionList.Add(Version)
Version.Load()
Next
@@ -1494,7 +1515,7 @@ NextVersion:
''' </summary>
Public Function McSkinGetAddress(Uuid As String, Type As String) As String
If Uuid = "" Then Throw New Exception("Uuid 为空。")
If Uuid.StartsWith("000000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
If Uuid.StartsWithF("000000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
'尝试读取缓存
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
If Not CacheSkinAddress = "" Then Return CacheSkinAddress
@@ -1960,7 +1981,7 @@ NextVersion:
'获取 Url 的真实地址
Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOf("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放
@@ -1990,10 +2011,6 @@ NextVersion:
Public Function McLibGet(Original As String, Optional WithHead As Boolean = True, Optional IgnoreLiteLoader As Boolean = False, Optional CustomMcFolder As String = Nothing) As String
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
Dim Splited = Original.Split(":")
'If Original.ToLower.Contains("xray") OrElse Original.ToLower.Contains("rift") OrElse Original.ToLower.Contains("mixin") OrElse Original.Contains("net.minecraftforge:forge") OrElse Splited(2).Contains("beta") OrElse (IgnoreLiteLoader AndAlso Original.Contains("liteloader")) Then
'ElseIf Splited(2).Contains("-") Then
' Log("[Launch] 可能存在分段问题的支持库:" & Original)
'End If
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
'判断 OptiFine 是否应该使用 installer
@@ -2250,8 +2267,10 @@ NextVersion:
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
End If
Dim Lefts = RegexSearch(Left.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Left = Left.ToLowerInvariant
Right = Right.ToLowerInvariant
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim i As Integer = 0
While True
'两边均缺失,感觉是一个东西
+279 -197
View File
@@ -48,7 +48,7 @@ Public Module ModMod
Load()
If Not IsFileAvailable Then
Return McModState.Unavaliable
ElseIf Path.EndsWith(".disabled") OrElse Path.EndsWith(".old") Then
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
Return McModState.Fine
@@ -76,7 +76,7 @@ Public Module ModMod
Return _Name
End Get
Set(value As String)
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value
End If
@@ -113,12 +113,12 @@ Public Module ModMod
Return _Version
End Get
Set(value As String)
If _Version IsNot Nothing AndAlso (_Version.Contains(".") OrElse _Version.Contains("-")) Then Exit Property
If value IsNot Nothing AndAlso value.ToLower.Contains("version") Then value = "version" '需要修改的标识
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value?.ContainsF("version", True) Then value = "version" '需要修改的标识
_Version = value
End Set
End Property
Private _Version As String = Nothing
Public _Version As String = Nothing
''' <summary>
''' 用于依赖检查的 ModID。
@@ -129,12 +129,12 @@ Public Module ModMod
Return _ModId
End Get
Set(value As String)
If value Is Nothing Then Exit Property
value = RegexSeek(value.ToLower, "[0-9a-z_-]+")
If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
If _ModId Is Nothing Then _ModId = value
End If
If value Is Nothing Then Return
value = RegexSeek(value, "[0-9a-zA-Z_-]+")
If value Is Nothing OrElse value.Count <= 1 OrElse Val(value).ToString = value Then Return
If value.ContainsF("name", True) OrElse value.ContainsF("modid", True) Then Return
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
If _ModId Is Nothing Then _ModId = value
End Set
End Property
Private _ModId As String = Nothing
@@ -152,7 +152,7 @@ Public Module ModMod
Return _Url
End Get
Set(value As String)
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWith("http") Then
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWithF("http") Then
_Url = value
End If
End Set
@@ -193,7 +193,7 @@ Public Module ModMod
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing
Else
If (Not VersionRequirement.StartsWith("[")) AndAlso (Not VersionRequirement.StartsWith("(")) AndAlso (Not VersionRequirement.EndsWith("]")) AndAlso (Not VersionRequirement.EndsWith(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
If (Not VersionRequirement.StartsWithF("[")) AndAlso (Not VersionRequirement.StartsWithF("(")) AndAlso (Not VersionRequirement.EndsWithF("]")) AndAlso (Not VersionRequirement.EndsWithF(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
End If
'向依赖项中添加
If _Dependencies.ContainsKey(ModID) Then
@@ -270,7 +270,6 @@ Public Module ModMod
_Dependencies = New Dictionary(Of String, String)
IsLoaded = False
_FileUnavailableReason = Nothing
IsInfoWithoutClassAvailable = False
IsInfoWithClassLoaded = False
IsInfoWithClassAvailable = False
End Sub
@@ -284,15 +283,12 @@ Public Module ModMod
Init()
Dim Jar As ZipArchive = Nothing
Try
'阶段 1:基础可用性检查、打开 Jar 文件
'基础可用性检查、打开 Jar 文件
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")")
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
If Jar.Entries.Count = 0 Then Throw New FileFormatException("文件内容为空")
'阶段 2:信息获取
LoadWithoutClass(Jar)
'阶段 3: Class 信息获取
If Not IsInfoWithoutClassAvailable Then LoadWithClass(Jar)
'信息获取
LookupMetadata(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
@@ -307,9 +303,9 @@ Public Module ModMod
End Sub
''' <summary>
''' 进行不使用 .class 文件的信息获取。
''' 从 jar 文件中获取 Mod 信息。
''' </summary>
Private Sub LoadWithoutClass(Jar As ZipArchive)
Private Sub LookupMetadata(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
@@ -347,7 +343,7 @@ Public Module ModMod
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOf(":") + 1)
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
@@ -360,7 +356,7 @@ Public Module ModMod
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOf(":") + 1)
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
@@ -407,8 +403,8 @@ GotFabric:
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOf(":") + 1)
' If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
@@ -436,10 +432,10 @@ GotFabric:
'文件标准化:统一换行符为 vbLf,去除注释、头尾的空格、空行
Dim Lines As New List(Of String)
For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符
If Line.StartsWith("#") Then '去除注释
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
Line = Line.Substring(0, Line.IndexOf("#"))
Line = Line.Substring(0, Line.IndexOfF("#"))
End If
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
If Line.Count > 0 Then Lines.Add(Line) '去除空行
@@ -448,28 +444,28 @@ GotFabric:
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
For i = 0 To Lines.Count - 1
Dim Line As String = Lines(i)
If Line.StartsWith("[") AndAlso Line.EndsWith("]") Then
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
'段落标记
Dim Header = Line.Trim("[]".ToCharArray)
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
ElseIf Line.Contains("=") Then
'字段标记
Dim Key As String = Line.Substring(0, Line.IndexOf("=")).TrimEnd(New Char() {" "c, " "c, " "c})
Dim RawValue As String = Line.Substring(Line.IndexOf("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, " "c})
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
Dim Value As Object
If RawValue.StartsWith("""") AndAlso RawValue.EndsWith("""") Then
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
'单行字符串
Value = RawValue.Trim("""")
ElseIf RawValue.StartsWith("'''") Then
ElseIf RawValue.StartsWithF("'''") Then
'多行字符串
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
If ValueLines(0).EndsWith("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
ValueLines(0) = ValueLines(0).TrimEnd("'")
Else
Do Until i >= Lines.Count - 1
i += 1
Dim ValueLine As String = Lines(i)
If ValueLine.EndsWith("'''") Then
If ValueLine.EndsWithF("'''") Then
ValueLines.Add(ValueLine.TrimEnd("'"))
Exit Do
Else
@@ -575,8 +571,8 @@ Got:
Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
If Deps <> "" Then
For Each Dep In Deps.Split(";")
If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOf(":") + 1)
If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
If Dep.Contains("@") Then
AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
Else
@@ -597,7 +593,7 @@ Finished:
If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOf("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
Version = MetaString
End If
@@ -610,97 +606,17 @@ Finished:
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
IsInfoWithoutClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing
End Sub
''' <summary>
''' 进行使用 .class 文件的信息获取。
''' </summary>
Private Sub LoadWithClass(Jar As ZipArchive)
Try
'查找入口点文件
Dim ModClass As String = Nothing
Dim ModClassNotBest As String = Nothing '非完美匹配
For Each Entry In Jar.Entries
If Entry.Name.EndsWith(".class") Then
Dim Temp As String = ReadFile(Entry.Open()).ToLower
If Temp.Contains("#lnet/minecraftforge/fml/common/mod;") Then
ModClass = Temp
Exit For
ElseIf Temp.Contains("modid") Then
ModClassNotBest = Temp
End If
End If
Next
If ModClass Is Nothing Then ModClass = ModClassNotBest
If ModClass Is Nothing Then Throw New FileNotFoundException("未找到 Mod 入口点")
ModClass = ModClass.Replace("ljava/lang/string;", "")
If ModClass.Count > 3000 Then ModClass = ModClass.Substring(0, 3000) '如果文件过大,截取前 3000 Byte
Dim IndexHead As Integer, IndexTail As Integer, IncreaseCount As Integer
'获取 ModID
If _ModId Is Nothing Then
IndexHead = ModClass.IndexOf("modid") + "modid".Length + 1
IncreaseCount = 0
Do While Convert.ToInt32(ModClass(IndexHead)) < 32
IndexHead += 1
IncreaseCount += 1
If IncreaseCount > 10 Then Throw New Exception("ModID 头匹配失败")
Loop
IndexTail = IndexHead + 1
IncreaseCount = 0
Do Until Convert.ToInt32(ModClass(IndexTail)) < 32
IndexTail += 1
IncreaseCount += 1
If IncreaseCount > 50 Then Throw New Exception("ModID 尾匹配失败")
Loop
ModId = ModClass.Substring(IndexHead, IndexTail - IndexHead)
End If
'获取 Version
If _Version Is Nothing AndAlso ModClass.Contains("version") Then
IndexHead = ModClass.IndexOf("version") + "version".Length + 1
IncreaseCount = 0
Do While Convert.ToInt32(ModClass(IndexHead)) < 32
IndexHead += 1
IncreaseCount += 1
If IncreaseCount > 10 Then GoTo VersionFindFail
Loop
IndexTail = IndexHead + 1
IncreaseCount = 0
Do While ModClass(IndexTail) = "."c OrElse ModClass(IndexTail) = "-"c OrElse
(ModClass(IndexTail) >= "0"c AndAlso ModClass(IndexTail) <= "9"c) OrElse
(ModClass(IndexTail) >= "a"c AndAlso ModClass(IndexTail) <= "z"c)
IndexTail += 1
IncreaseCount += 1
If IncreaseCount > 50 Then GoTo VersionFindFail
Loop
_Version = ModClass.Substring(IndexHead, IndexTail - IndexHead)
End If
VersionFindFail:
'获取 Dependencies
IndexHead = ModClass.IndexOf("dependencies")
If IndexHead > 0 Then
If ModClass.Count >= IndexHead + 300 Then ModClass = ModClass.Substring(IndexHead, 299)
Dim Deps As List(Of String) = RegexSearch(ModClass, "(?<=required-((before|after|before-client|after-client)?):)[0-9a-z]+(@[\(\[]{1}[0-9.,]+[\)\]]{1})?")
For Each Token As String In Deps
If Not String.IsNullOrEmpty(Token) Then
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
AddDependency(Token)
End If
End If
Next
End If
Catch ex As Exception
Log(ex, "Mod Class 信息不可用(" & If(Path, "null") & ")", LogLevel.Normal)
End Try
IsInfoWithClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing
End Sub
#End Region
#Region "网络信息"
''' <summary>
''' 当任何网络信息更新时触发。
''' </summary>
Public Event OnCompUpdate(sender As McMod)
''' <summary>
''' 该 Mod 关联的网络项目。
''' </summary>
@@ -710,12 +626,70 @@ VersionFindFail:
End Get
Set(value As CompProject)
_Comp = value
RaiseEvent OnGetCompProject(Me)
RaiseEvent OnCompUpdate(Me)
End Set
End Property
Private _Comp As CompProject
Public IsCompFromModrinth = False
Public Event OnGetCompProject(sender As McMod)
''' <summary>
''' 本地文件对应的联网文件信息。
''' </summary>
Public CompFile As CompFile
''' <summary>
''' 该 Mod 对应的联网最新版本。
''' </summary>
Public Property UpdateFile As CompFile
Get
Return _UpdateFile
End Get
Set(value As CompFile)
_UpdateFile = value
RaiseEvent OnCompUpdate(Me)
End Set
End Property
Private _UpdateFile As CompFile
''' <summary>
''' 该 Mod 的更新日志网址。
''' </summary>
Public ChangelogUrls As New List(Of String)
''' <summary>
''' 所有网络信息是否已成功加载。
''' </summary>
Public CompLoaded As Boolean = False
''' <summary>
''' 将网络信息保存为 Json。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
If Comp IsNot Nothing Then Json.Add("Comp", Comp.ToJson())
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
Json.Add("CompLoaded", CompLoaded)
If CompFile IsNot Nothing Then Json.Add("CompFile", CompFile.ToJson())
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToJson())
Return Json
End Function
''' <summary>
''' 从 Json 中读取网络信息。
''' </summary>
Public Sub FromJson(Json As JObject)
CompLoaded = Json("CompLoaded")
If Json.ContainsKey("Comp") Then Comp = New CompProject(Json("Comp"))
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
If Json.ContainsKey("CompFile") Then CompFile = New CompFile(Json("CompFile"), CompType.Mod)
If Json.ContainsKey("UpdateFile") Then UpdateFile = New CompFile(Json("UpdateFile"), CompType.Mod)
End Sub
''' <summary>
''' 该文件是否可以更新。
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return ChangelogUrls.Any()
End Get
End Property
''' <summary>
''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。
@@ -723,6 +697,14 @@ VersionFindFail:
Public ReadOnly Property CurseForgeHash As UInteger
Get
If _CurseForgeHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In File.ReadAllBytes(Path)
@@ -757,6 +739,8 @@ VersionFindFail:
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor (h >> 15)
_CurseForgeHash = h
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
End If
Return _CurseForgeHash
End Get
@@ -769,7 +753,18 @@ VersionFindFail:
Public ReadOnly Property ModrinthHash As String
Get
If _ModrinthHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-M")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
_ModrinthHash = Cached
Return _ModrinthHash
End If
'计算 SHA1
_ModrinthHash = GetFileSHA1(Path)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If
Return _ModrinthHash
End Get
@@ -794,7 +789,7 @@ VersionFindFail:
''' 是否可能为前置 Mod。
''' </summary>
Public Function IsPresetMod() As Boolean
Return Dependencies.Count = 0 AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
Return Not Dependencies.Any() AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
End Function
''' <summary>
@@ -803,9 +798,9 @@ VersionFindFail:
Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower
If Path.EndsWith(".jar") OrElse Path.EndsWith(".zip") OrElse Path.EndsWith(".litemod") OrElse
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") OrElse
Path.EndsWith(".jar.old") OrElse Path.EndsWith(".zip.old") OrElse Path.EndsWith(".litemod.old") Then Return True
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
Return False
End Function
@@ -817,6 +812,20 @@ VersionFindFail:
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False)
'等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
If Loader.IsAborted Then Exit Sub
Thread.Sleep(100)
Loop
Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
End Try
End If
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then
@@ -846,7 +855,7 @@ VersionFindFail:
If CacheContent <> "" Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息")
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
Cache = New JObject
End If
End If
@@ -859,7 +868,7 @@ VersionFindFail:
Dim ModList As New List(Of McMod)
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.95 / ModFileList.Count
Loader.Progress += 0.94 / ModFileList.Count
If Loader.IsAborted Then Exit Sub
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName)
@@ -880,10 +889,9 @@ VersionFindFail:
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
Dim Hash = ModEntry.ModrinthHash
If Cache.ContainsKey(Hash) Then
ModEntry.Comp = New CompProject(Cache(Hash))
ModEntry.IsCompFromModrinth = Not ModEntry.Comp.FromCurseForge
ModEntry.FromJson(Cache(Hash))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If Date.Now - Cache(Hash)("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
If ModEntry.CompLoaded AndAlso Date.Now - Cache(Hash)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
ModUpdateList.Add(ModEntry)
Next
@@ -906,10 +914,10 @@ VersionFindFail:
'开始联网加载
If ModUpdateList.Any() Then
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
End If
Loader.Progress = 1
Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug)
Throw
@@ -917,29 +925,31 @@ VersionFindFail:
End Sub
'联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 1
Private Const LocalModCacheVersion As Integer = 2
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders As New List(Of String)
If TargetMcVersion.HasForge Then ModLoaders.Add("forge")
If TargetMcVersion.HasFabric Then ModLoaders.Add("fabric")
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add("liteloader")
If Not ModLoaders.Any() Then ModLoaders.AddRange({"forge", "fabric", "liteloader"})
Dim ModLoaders As New List(Of CompModLoaderType)
If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Dim McVersions As New List(Of String) From {TargetMcVersion.McName}
If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
For i = 1 To TargetMcVersion.McCodeSub
McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
Next
End If
McVersions = McVersions.Distinct().ToList()
'暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
' For i = 1 To TargetMcVersion.McCodeSub
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
' Next
'End If
'McVersions = McVersions.Distinct().ToList()
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersions.Join("/")}")
Dim CompletedThread As Integer = 0
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
Dim MainThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
RunInNewThread(
@@ -947,25 +957,24 @@ VersionFindFail:
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""")}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthUpdate.Count} 个本地 Mod 的对应信息")
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthUpdate.Count = 0 Then Exit Sub
If ModrinthVersion.Count = 0 Then Exit Sub
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each ModEntity In Mods
If Not ModrinthUpdate.ContainsKey(ModEntity.ModrinthHash) Then Continue For
Dim ProjectId = ModrinthUpdate(ModEntity.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) Then
ModEntity.Comp = CompProjectCache(ProjectId)
Else
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(ModEntity)
End If
For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 类本地 Mod 的工程信息")
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
@@ -974,18 +983,37 @@ VersionFindFail:
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then
Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 加载不出来
End If
Entry.IsCompFromModrinth = True
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
Entry.Comp = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject)
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
If Not UpdateFile.Available Then Continue For
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
Finally
CompletedThread += 1
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader Modrinth")
'从 CurseForge 获取信息
@@ -994,57 +1022,110 @@ VersionFindFail:
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger)
For Each ModEntity In Mods
CurseForgeHashes.Add(ModEntity.CurseForgeHash)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If CurseForgeRaw.Count = 0 Then Exit Sub
If Not CurseForgeRaw.Any() Then Exit Sub
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint")
For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For
If CompProjectCache.ContainsKey(ProjectId) Then
Entry.Comp = CompProjectCache(ProjectId)
Else
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
End If
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(Project("file"), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Entry.IsCompFromModrinth Then
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
Entry.IsCompFromModrinth = False
Entry.Comp = Project
Next
'查找或许版本更新的文件列表
If ModLoaders.Count = 1 Then 'TODO: 结果有多个 ModLoader 时提示无法检测更新
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If Not McVersions.Contains(IndexVersion) Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion
NewestFileIds.Clear()
End If
NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer))
Next
For Each FileId In NewestFileIds
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of McMod)
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
End If
Next
Log($"[Mod] 从 CurseForge 获取本地 Mod 信息结束")
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles
Dim File As New CompFile(FileJson, CompType.Mod)
If Not File.Available Then Continue For
For Each Entry As McMod In UpdateFileIds(File.Id)
If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
UpdateFiles(Entry) = File
Next
Next
For Each Pair In UpdateFiles
Dim Entry As McMod = Pair.Key
Dim UpdateFile As CompFile = Pair.Value
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
Finally
CompletedThread += 1
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'等待线程结束
Do Until CompletedThread = 2
Do Until EndedThreadCount = 2
If Loader.IsAborted Then Exit Sub
Thread.Sleep(10)
Loop
@@ -1052,8 +1133,9 @@ VersionFindFail:
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub
For Each ModEntity In Mods
Cache(ModEntity.ModrinthHash) = ModEntity.Comp.ToJson()
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
End Sub
@@ -1083,12 +1165,12 @@ VersionFindFail:
If CurrentDependencies.ContainsKey(PossibleModId) Then
If CurrentDependencies(PossibleModId)(2) = 1 Then
Result.Add("重复添加了相同的 Mod,请尝试删除其中一个(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1))
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1))
Else
Log("[Minecraft] 由于可能有多个 ModID,跳过疑似的重复项(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
End If
Else
CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count})
@@ -1106,8 +1188,8 @@ VersionFindFail:
If Dependency.Value IsNot Nothing Then
'获取分段后的详细版本信息
Dim ReqVersion As String = Dependency.Value
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWith("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWith("]")
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
Dim ReqVersionHead As String
Dim ReqVersionTail As String
If ReqVersion.Contains(",") Then
@@ -1121,8 +1203,8 @@ VersionFindFail:
ReqVersionTailCanEqual = False
End If
End If
If ReqVersionHead.StartsWith("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOf("-") + 1)
If ReqVersionTail.StartsWith("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOf("-") + 1)
If ReqVersionHead.StartsWithF("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOfF("-") + 1)
If ReqVersionTail.StartsWithF("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOfF("-") + 1)
'获取报错描述文本
Dim VersionRequire As String
If ReqVersionHead = ReqVersionTail Then
@@ -1150,7 +1232,7 @@ VersionFindFail:
Continue For
End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
If CurrentVersion.StartsWith("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOf("-") + 1)
If CurrentVersion.StartsWithF("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOfF("-") + 1)
'对比前置 Mod 头部版本
If ReqVersionHead.Contains(".") Then
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
@@ -1179,7 +1261,7 @@ VersionFindFail:
Log(ex, "检查 Mod 时出错")
End Try
Next
If Result.Count = 0 Then
If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常")
Else
Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
@@ -40,7 +40,7 @@ Public Module ModModpack
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/"
If Entry.FullName.EndsWith("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
If Entry.FullName.EndsWithF("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
'确定为一级目录下
If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件
@@ -61,7 +61,7 @@ Public Module ModModpack
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
ElseIf File.ToLower.EndsWith(".rar") Then
ElseIf File.EndsWithF(".rar", True) Then
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Else
@@ -186,7 +186,7 @@ Retry:
Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower
If Id.StartsWith("forge-") Then
If Id.StartsWithF("forge-") Then
'Forge 指定
If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
@@ -199,7 +199,7 @@ Retry:
Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id)
End Try
ElseIf Id.StartsWith("fabric-") Then
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Try
Log("[ModPack] 整合包 Fabric 版本:" & Id)
@@ -277,7 +277,7 @@ Retry:
IsResourcePack =
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
(Not File.FileName.EndsWith(".jar")) '文件后缀不是 .jar
(Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar
Else
IsResourcePack = False
End If
@@ -143,7 +143,7 @@
'输出文本
Dim Copyed As New List(Of String)
SyncLock WaitingLogLock
If WaitingLog.Count = 0 Then Exit Sub
If Not WaitingLog.Any() Then Exit Sub
Copyed = WaitingLog
WaitingLog = New List(Of String)(1000)
End SyncLock
@@ -192,7 +192,7 @@
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+
LogProgress = 2
ElseIf LogProgress < 3 AndAlso Text.ToLower.Contains("lwjgl version") Then
ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
WatcherLog("日志 3/5:LWJGL 版本已确认")
LogProgress = 3
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
@@ -269,7 +269,7 @@
If MinecraftWindow Is Nothing Then Exit Sub
Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
'已找到窗口
If Not MinecraftWindowName.StartsWith("FML") Then
If Not MinecraftWindowName.StartsWithF("FML") Then
'已找到 Minecraft 窗口
WindowHandle = MinecraftWindowHandle
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
@@ -317,7 +317,7 @@
Dim WindowText As String = str.ToString
'有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确
'部分版本会搞个 GLFW message window 出来所以得反选
If Not (WindowText.StartsWith("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWith("GLFW")) Then Exit Sub
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Exit Sub
'获取窗口关联的进程
Dim ProcessId As Integer
GetWindowThreadProcessId(hwnd, ProcessId)
@@ -14,11 +14,11 @@
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
@@ -1,8 +1,9 @@
<Grid x:Class="MyLocalModItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL;assembly="
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="34" />
@@ -19,7 +20,7 @@
</Grid.RowDefinitions>
<!-- Logo -->
<Border Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True"
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
<Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip>
@@ -27,10 +28,26 @@
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 -->
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</StackPanel>
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<local:MyIconTextButton Grid.Column="2" Text="更新" />
</Grid>-->
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
@@ -16,11 +16,11 @@ Public Class MyLocalModItem
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
@@ -190,6 +190,39 @@ RetryStart:
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'滑动选中
Private Shared SwipeStart As Integer, SwipeEnd As Integer
Private Shared Swiping As Boolean = False
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown
'开始滑动
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Index
SwipeEnd = Index
Swiping = True
SwipToState = Not Checked
FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏
End Sub
Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp
'结束滑动
If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then
Swiping = False
FrmVersionMod.CardSelect.IsHitTestVisible = True
Exit Sub
End If
'计算滑动范围
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Math.Min(SwipeStart, Index)
SwipeEnd = Math.Max(SwipeEnd, Index)
'勾选所有范围中的项
If SwipeStart = SwipeEnd Then Exit Sub
For i = SwipeStart To SwipeEnd
Dim Item As MyLocalModItem = CType(Parent, StackPanel).Children(i)
Item.InitLate(Item, e)
Item.Checked = SwipToState
Next
End Sub
'勾选状态
Public Event Check(sender As Object, e As RouteEventArgs)
Public Event Changed(sender As Object, e As RouteEventArgs)
@@ -201,10 +234,10 @@ RetryStart:
Set(value As Boolean)
Try
'触发属性值修改
Dim ChangedEventArgs As New RouteEventArgs(False)
Dim RawValue = _Checked
If value = _Checked Then Exit Property
_Checked = value
Dim ChangedEventArgs As New RouteEventArgs(False)
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
@@ -310,7 +343,7 @@ RetryStart:
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
If value.Count = 0 Then Exit Property
If Not value.Any() Then Exit Property
'添加新 Stack
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
@@ -347,6 +380,30 @@ RetryStart:
Public Sub Refresh()
RunInUi(
Sub()
'更新
If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
BtnUpdate.ToolTip = $"当前版本:{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本:{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新,右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
@@ -390,9 +447,9 @@ RetryStart:
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
Children.Add(ImgState)
@@ -409,11 +466,7 @@ RetryStart:
End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
'按钮虚拟化检测
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
InitLate(sender, e)
'触发颜色动画
Dim Time As Integer = If(IsMouseOver, 120, 180)
Dim Ani As New List(Of AniData)
@@ -422,19 +475,19 @@ RetryStart:
If IsMouseOver Then
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
Else
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
End If
End If
'RectBack
If IsMouseOver OrElse Checked Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
@@ -442,12 +495,42 @@ RetryStart:
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "LocalModItem Color " & Uuid)
End Sub
'触发虚拟化内容
Private Sub InitLate(sender As Object, e As EventArgs)
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
End Sub
'显示更新日志
Private Sub ShowUpdateLog(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
e.Handled = True
Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com"))
Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com"))
If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then
OpenWebsite(Entry.ChangelogUrls.First)
Else
Select Case MyMsgBox("要在哪个网站上查看更新日志?", "查看更新日志", "Modrinth", "CurseForge", "取消")
Case 1
OpenWebsite(ModrinthUrl)
Case 2
OpenWebsite(CurseForgeUrl)
End Select
End If
End Sub
'触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
FrmVersionMod.UpdateMods({Entry})
End Sub
End Class
+4 -4
View File
@@ -13,7 +13,7 @@
Case "打开网页"
Data(0) = Data(0).Replace("\", "/")
If Not Data(0).Contains("://") OrElse Data(0).ToLower.StartsWith("file") Then '为了支持更多协议(#2200)
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Exit Sub
End If
@@ -78,7 +78,7 @@
Case "下载文件"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
End If
@@ -99,7 +99,7 @@
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
'网页确认
If RelativeUrl.ToLower.StartsWith("http") Then
If RelativeUrl.StartsWithF("http", True) Then
If RunInUi() Then
Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf &
"因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
@@ -108,7 +108,7 @@
Dim RawFileName As String
Try
RawFileName = GetFileNameFromPath(RelativeUrl)
If Not RawFileName.ToLower.EndsWith(".json") Then Throw New Exception("未指向 .json 后缀的文件")
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
Catch ex As Exception
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
"例如:" & vbCrLf &
+13 -7
View File
@@ -1,4 +1,6 @@
Public Module ModMusic
Imports System.Security.Cryptography
Public Module ModMusic
#Region "播放列表"
@@ -31,7 +33,7 @@
End If
'打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not MusicWaitingList.Count = 0 AndAlso MusicWaitingList(0) = IgnoreFirst Then
If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
@@ -45,11 +47,11 @@
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐
If MusicAllList Is Nothing OrElse MusicAllList.Count = 0 OrElse MusicWaitingList.Count = 0 Then MusicListInit(False)
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function
#End Region
@@ -63,7 +65,7 @@
RunInUi(Sub()
Try
If MusicAllList.Count = 0 Then
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
Else
@@ -160,7 +162,7 @@
Try
MusicListInit(True)
If MusicAllList.Count = 0 Then
If Not MusicAllList.Any() Then
If MusicNAudio Is Nothing Then
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical)
Else
@@ -267,9 +269,13 @@
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent)
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
Thread.Sleep(1000000000)
End If
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.6.15.0")>
<Assembly: AssemblyFileVersion("2.6.15.0")>
<Assembly: AssemblyVersion("2.7.0.0")>
<Assembly: AssemblyFileVersion("2.7.0.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -120,49 +120,49 @@ Public Module ModDownloadLib
'下载版本 Json 文件
If JsonUrl Is Nothing Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 json 文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim JsonAddress As String = DlClientListGet(Id)
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")}
End Sub) With {.ProgressWeight = 2, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim JsonAddress As String = DlClientListGet(Id)
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")}
End Sub) With {.ProgressWeight = 2, .Show = False})
End If
Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 3})
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 3})
'下载支持库文件
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
Loaders.Add(New LoaderCombo(Of String)(McDownloadClientLibName, LoadersLib) With {.Block = False, .ProgressWeight = 14})
'下载资源文件
Dim LoadersAssets As New List(Of LoaderBase)
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim Version As New McVersion(VersionFolder)
Task.Output = New List(Of NetFile) From {DlClientAssetIndexGet(Version)}
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
'顺手添加 Json 项目
Try
Dim VersionJson As JObject = GetJson(ReadFile(VersionFolder & VersionName & ".json"))
VersionJson.Add("clientVersion", Id)
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString)
Catch ex As Exception
Throw New Exception("添加客户端版本失败", ex)
End Try
End Sub) With {.ProgressWeight = 1, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim Version As New McVersion(VersionFolder)
Task.Output = New List(Of NetFile) From {DlClientAssetIndexGet(Version)}
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
'顺手添加 Json 项目
Try
Dim VersionJson As JObject = GetJson(ReadFile(VersionFolder & VersionName & ".json"))
VersionJson.Add("clientVersion", Id)
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString)
Catch ex As Exception
Throw New Exception("添加客户端版本失败", ex)
End Try
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task)
End Sub) With {.ProgressWeight = 3, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task)
End Sub) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False})
Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21})
@@ -283,7 +283,7 @@ Public Module ModDownloadLib
WikiName = "Java版Combat_Test_8c"
ElseIf Id = "1.0.0-rc2-2" Then
WikiName = "Java版RC2"
ElseIf Id.StartsWith("1.19_deep_dark_experimental_snapshot-") OrElse Id.StartsWith("1_19_deep_dark_experimental_snapshot-") Then
ElseIf Id.StartsWithF("1.19_deep_dark_experimental_snapshot-") OrElse Id.StartsWithF("1_19_deep_dark_experimental_snapshot-") Then
WikiName = Id.Replace("1_19", "1.19").Replace("1.19_deep_dark_experimental_snapshot-", "Java版Deep_Dark_Experimental_Snapshot_")
ElseIf Id = "b1.9-pre6" Then
WikiName = "Java版Beta_1.9_Prerelease_6"
@@ -291,19 +291,19 @@ Public Module ModDownloadLib
WikiName = "Java版Beta_1.9_Prerelease"
ElseIf VersionJson("type") = "release" OrElse VersionJson("type") = "snapshot" OrElse VersionJson("type") = "special" Then
WikiName = If(Id.Contains("w"), "", "Java版") & Id.Replace(" Pre-Release ", "-pre")
ElseIf Id.StartsWith("b") Then
ElseIf Id.StartsWithF("b") Then
WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("b", "Beta_")
ElseIf Id.StartsWith("a") Then
ElseIf Id.StartsWithF("a") Then
WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("a", "Alpha_v")
ElseIf Id = "inf-20100618" Then
WikiName = "Java版Infdev_20100618"
ElseIf Id = "c0.30_01c" OrElse Id = "c0.30_survival" OrElse Id.Contains("生存测试") Then
WikiName = "Java版Classic_0.30(生存模式)"
ElseIf Id.StartsWith("c0.31") Then
ElseIf Id.StartsWithF("c0.31") Then
WikiName = "Java版Indev_0.31_20100130"
ElseIf Id.StartsWith("c") Then
ElseIf Id.StartsWithF("c") Then
WikiName = "Java版" & Id.Replace("c", "Classic_")
ElseIf Id.StartsWith("rd-") Then
ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id
Else
Log("[Error] 未知的版本格式:" & Id & "。", LogLevel.Feedback)
@@ -428,52 +428,54 @@ Public Module ModDownloadLib
Dim LastResult As String = ""
Using outputWaitHandle As New AutoResetEvent(False)
Using errorWaitHandle As New AutoResetEvent(False)
AddHandler process.OutputDataReceived, Function(sender, e)
Try
If e.Data Is Nothing Then
outputWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
AddHandler process.ErrorDataReceived, Function(sender, e)
Try
If e.Data Is Nothing Then
errorWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
AddHandler process.OutputDataReceived,
Function(sender, e)
Try
If e.Data Is Nothing Then
outputWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
AddHandler process.ErrorDataReceived,
Function(sender, e)
Try
If e.Data Is Nothing Then
errorWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
process.Start()
process.BeginOutputReadLine()
process.BeginErrorReadLine()
@@ -1010,7 +1012,7 @@ Retry:
End If
Exit Sub
End If
If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWith("1.5") Then '对该版本自动安装的支持将在之后加入
If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWithF("1.5") Then '对该版本自动安装的支持将在之后加入
If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。",
"版本过老", "继续", "取消") = 1 Then
@@ -1214,9 +1216,9 @@ Retry:
End SyncLock
End Sub
Private Sub ForgeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
If Content.StartsWith(" Data") OrElse Content.StartsWith(" Slim") Then
If Content.StartsWithF(" Data") OrElse Content.StartsWithF(" Slim") Then
If ModeDebug Then Log("[Installer] " & Content)
ElseIf Content.StartsWith(" Reading patch ") Then
ElseIf Content.StartsWithF(" Reading patch ") Then
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress = 0.86
Else
@@ -1265,7 +1267,7 @@ Retry:
'参数初始化
McFolder = If(McFolder, PathMcFolder)
If Version.StartsWith("1.") AndAlso Version.Contains("-") Then
If Version.StartsWithF("1.") AndAlso Version.Contains("-") Then
'类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge)
Inherit = Version.Split("-").First
Version = Version.Split("-").Last
@@ -1345,8 +1347,8 @@ Retry:
Task.Progress = 0.8
'去除其中的原始 Forge 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then
If Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & "-client.jar") Then
Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i)
Exit For
@@ -1644,7 +1646,7 @@ Retry:
For Each Version As JObject In ResultJson
If Version("name") Is Nothing OrElse Version("build") Is Nothing Then Continue For
Dim Name As String = Version("name")
If Not Name.EndsWith("-recommended") Then Continue For
If Not Name.EndsWithF("-recommended") Then Continue For
'内容为:"1.15.2":"31.2.0"
RecommendedList.Add("""" & Name.Replace("-recommended", """:""" & Version("build")("version").ToString & """"))
Next
@@ -1974,9 +1976,9 @@ Retry:
Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName,
.IsPreview = Request.OptiFineVersion.ToLower.Contains("pre"),
.IsPreview = Request.OptiFineVersion.ContainsF("pre", True),
.NameVersion = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion,
.NameFile = If(Request.OptiFineVersion.ToLower.Contains("pre"), "preview_", "") &
.NameFile = If(Request.OptiFineVersion.ContainsF("pre", True), "preview_", "") &
"OptiFine_" & Request.MinecraftName & "_" & Request.OptiFineVersion & ".jar"
}
End If
@@ -2012,7 +2014,7 @@ Retry:
Dim LoaderList As New List(Of LoaderBase)
'添加忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "该文件会使得该文件夹不在 PCL 的版本列表中显示")) With {.Show = False, .Block = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
@@ -2083,36 +2085,36 @@ Retry:
Dim OutputJsonPath As String, MinecraftJsonPath As String, OptiFineJsonPath As String = Nothing, ForgeJsonPath As String = Nothing, LiteLoaderJsonPath As String = Nothing, FabricJsonPath As String = Nothing
Dim OutputJar As String, MinecraftJar As String
#Region "初始化路径信息"
If Not OutputFolder.EndsWith("\") Then OutputFolder += "\"
If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\"
OutputName = GetFolderNameFromPath(OutputFolder)
OutputJsonPath = OutputFolder & OutputName & ".json"
OutputJar = OutputFolder & OutputName & ".jar"
If Not MinecraftFolder.EndsWith("\") Then MinecraftFolder += "\"
If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\"
MinecraftName = GetFolderNameFromPath(MinecraftFolder)
MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json"
MinecraftJar = MinecraftFolder & MinecraftName & ".jar"
If HasOptiFine Then
If Not OptiFineFolder.EndsWith("\") Then OptiFineFolder += "\"
If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\"
OptiFineName = GetFolderNameFromPath(OptiFineFolder)
OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json"
End If
If HasForge Then
If Not ForgeFolder.EndsWith("\") Then ForgeFolder += "\"
If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\"
ForgeName = GetFolderNameFromPath(ForgeFolder)
ForgeJsonPath = ForgeFolder & ForgeName & ".json"
End If
If HasLiteLoader Then
If Not LiteLoaderFolder.EndsWith("\") Then LiteLoaderFolder += "\"
If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\"
LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder)
LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json"
End If
If HasFabric Then
If Not FabricFolder.EndsWith("\") Then FabricFolder += "\"
If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\"
FabricName = GetFolderNameFromPath(FabricFolder)
FabricJsonPath = FabricFolder & FabricName & ".json"
End If
@@ -2121,30 +2123,30 @@ Retry:
Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath)
If Not MinecraftJsonText.StartsWith("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath)
If Not OptiFineJsonText.StartsWith("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
OptiFineJson = GetJson(OptiFineJsonText)
End If
If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath)
If Not ForgeJsonText.StartsWith("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
ForgeJson = GetJson(ForgeJsonText)
End If
If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath)
If Not LiteLoaderJsonText.StartsWith("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If
If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath)
If Not FabricJsonText.StartsWith("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
FabricJson = GetJson(FabricJsonText)
End If
#End Region
@@ -2160,9 +2162,9 @@ Retry:
Dim RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String)
For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWith("-") Then
If RawArguments(i).StartsWithF("-") Then
SplitArguments.Add(RawArguments(i))
ElseIf SplitArguments.Count > 0 AndAlso SplitArguments.Last.StartsWith("-") AndAlso Not SplitArguments.Last.Contains(" ") Then
ElseIf SplitArguments.Count > 0 AndAlso SplitArguments.Last.StartsWithF("-") AndAlso Not SplitArguments.Last.Contains(" ") Then
SplitArguments(SplitArguments.Count - 1) = SplitArguments.Last & " " & RawArguments(i)
Else
SplitArguments.Add(RawArguments(i))
@@ -39,7 +39,7 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
@@ -77,7 +77,7 @@
PanMain.Children.Add(CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -88,7 +88,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.Type = CompType.ModPack, 9, 8)} 'FUTURE: Res
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -252,7 +252,7 @@
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
Next
If SuitableVersions.Count = 0 Then
If Not SuitableVersions.Any() Then
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!")
@@ -523,7 +523,7 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
@@ -562,7 +562,7 @@
PanMinecraft.Children.Insert(0, CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 7}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -656,7 +656,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
@@ -724,7 +724,7 @@
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'可视化
PanLiteLoader.Children.Clear()
For Each Version In Versions
@@ -804,7 +804,7 @@
'获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry)
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
If Loader.Output.Count = 0 Then Exit Sub
If Not Loader.Output.Any() Then Exit Sub
PanForge.Children.Clear()
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
Where(Function(v)
@@ -870,7 +870,7 @@
If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub
'获取版本列表
Dim Versions As JArray = DlFabricListLoader.Output.Value("loader")
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'可视化
PanFabric.Children.Clear()
PanFabric.Tag = Versions
@@ -983,7 +983,7 @@
Versions.Add(Version)
End If
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化
PanFabricApi.Children.Clear()
@@ -1073,7 +1073,7 @@
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'排序
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化
@@ -28,7 +28,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 10}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -32,7 +32,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 3}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -46,7 +46,7 @@
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If McVersionList.Count = 0 OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
@@ -258,7 +258,7 @@ Public Class PageLinkIoi
Public Function GetDescription() As String
Return If(Progress < 1,
"正在连接," & Math.Round(Progress * 100) & "%",
"已连接," & If(PingRecord.Count = 0, "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
"已连接," & If(Not PingRecord.Any(), "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
End Function
Public Function ToListItem() As MyListItem
Dim Item As New MyListItem With {
@@ -149,7 +149,7 @@
'进行搜索,构造列表
Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.08)
PanSearchList.Children.Clear()
If SearchResult.Count = 0 Then
If Not SearchResult.Any() Then
PanSearch.Title = "无搜索结果"
PanSearchList.Visibility = Visibility.Collapsed
Else
@@ -129,7 +129,7 @@
Exit Sub
End If
Next
If McFolderList.Count = 0 Then
If Not McFolderList.Any() Then
Throw New ArgumentNullException("没有可用的 Minecraft 文件夹")
Else
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
@@ -301,7 +301,7 @@
End If
Next
'保存
Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|")))
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Finish)
McFolderListLoader.Start(IsForceRestart:=True)
@@ -325,7 +325,7 @@
Exit For
End If
Next
Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|")))
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
End If
RunInNewThread(Sub()
'删除文件夹
@@ -229,7 +229,7 @@
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true -XX:MaxDirectMemorySize=256M"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" MaxLength="4000" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true -XX:MaxDirectMemorySize=256M"
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。" />
@@ -518,7 +518,7 @@ PreFin:
RunInThread(Sub()
Hint("正在搜索 Java!")
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
If JavaList.Count = 0 Then
If Not JavaList.Any() Then
Hint("未找到可用的 Java!", HintType.Critical)
Else
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish)
@@ -36,7 +36,7 @@
Try
#Region "更新左边栏"
If LoaderTaskbar.Count = 0 Then
If Not LoaderTaskbar.Any() Then
'无任务
LabProgress.Text = "100 %"
LabSpeed.Text = "0 B/s"
@@ -214,13 +214,14 @@
End Sub
Public Sub TaskRemove(Loader As Object)
If RightCards.ContainsKey(Loader.Name) Then
RunInUiWait(Sub()
'移除已有的卡片
Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card)
RightCards.Remove(Loader.Name)
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
End Sub)
RunInUiWait(
Sub()
'移除已有的卡片
Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card)
RightCards.Remove(Loader.Name)
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
End Sub)
End If
End Sub
@@ -47,6 +47,8 @@
</local:MyCard.RenderTransform>
<TextBlock x:Name="LabSelect" Text="已选择 8 个文件" HorizontalAlignment="Center" VerticalAlignment="Top" Margin="9" Foreground="{DynamicResource ColorBrush2}" />
<StackPanel Orientation="Horizontal" Margin="5,28,5,5">
<local:MyIconTextButton x:Name="BtnSelectUpdate" Text="更新"
LogoScale="1" Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
<local:MyIconTextButton x:Name="BtnSelectEnable" Text="启用"
LogoScale="1.05" Logo="M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z" />
<local:MyIconTextButton x:Name="BtnSelectDisable" Text="禁用"
@@ -1,6 +1,4 @@
Imports System.Security.Principal
Public Class PageVersionMod
Public Class PageVersionMod
#Region "初始化"
@@ -27,7 +25,6 @@ Public Class PageVersionMod
''' 刷新 Mod 列表。
''' </summary>
Public Sub RefreshList(Optional ForceReload As Boolean = False)
If McModLoader.State = LoadState.Loading Then Exit Sub
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表")
PanBack.ScrollToHome()
@@ -82,7 +79,7 @@ Public Class PageVersionMod
AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)}
AddHandler Entry.OnGetCompProject, AddressOf NewItem.Refresh
AddHandler Entry.OnCompUpdate, AddressOf NewItem.Refresh
NewItem.Refresh()
AniControlEnabled -= 1
Return NewItem
@@ -104,17 +101,14 @@ Public Class PageVersionMod
ToolTipService.SetVerticalOffset(BtnCont, 30)
ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click, AddressOf Info_Click
AddHandler sender.MouseRightButtonDown, AddressOf Info_Click
AddHandler sender.MouseRightButtonUp, AddressOf Info_Click
Dim BtnDelete As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonDelete, .Tag = sender}
BtnDelete.ToolTip = "删除"
ToolTipService.SetPlacement(BtnDelete, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnDelete, 30)
ToolTipService.SetHorizontalOffset(BtnDelete, 2)
AddHandler BtnDelete.Click, AddressOf Delete_Click
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine,
"M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z",
"M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"),
.Tag = sender}
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine, Logo.IconButtonStop, Logo.IconButtonCheck), .Tag = sender}
BtnED.ToolTip = If(sender.Entry.State = McMod.McModState.Fine, "禁用", "启用")
ToolTipService.SetPlacement(BtnED, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnED, 30)
@@ -242,10 +236,12 @@ Public Class PageVersionMod
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性
If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
@@ -255,9 +251,9 @@ Public Class PageVersionMod
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
CardSelect.IsHitTestVisible = Selected
If AniControlEnabled = 0 Then
If Selected Then
'仅在数量增加时播放出现/跳跃动画
@@ -374,7 +370,7 @@ Public Class PageVersionMod
End Try
'更改 Loader 中的列表
Dim NewModEntity As New McMod(NewPath)
NewModEntity.Comp = ModEntity.Comp
NewModEntity.FromJson(ModEntity.ToJson)
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
@@ -395,10 +391,128 @@ Public Class PageVersionMod
End If
End Sub
'更新
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
UpdateMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate))
End Sub
''' <summary>
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </summary>
Public Shared UpdatingVersions As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of McMod))
'更新前警告
If Not Setup.Get("HintUpdateMod") Then
If MyMsgBox($"新版本 Mod 可能不兼容老版本的存档或者其他 Mod,这可能导致游戏崩溃,甚至存档损坏!{vbCrLf}除非整合包作者要求你更新,否则不要私自更新整合包里的 Mod!{vbCrLf}在更新 Mod 前,请先备份存档,并检查它的更新日志!{vbCrLf}更新时,老版本的 Mod 会被移动到回收站,以防万一。{vbCrLf}{vbCrLf}请在认真阅读上述警告后再继续!", "Mod 更新警告", "我已了解上述风险,继续更新", "取消", IsWarn:=True) = 1 Then
Setup.Set("HintUpdateMod", True)
Else
Exit Sub
End If
End If
Try
'构造下载信息
ModList = ModList.ToList() '防止刷新影响迭代器
Dim FileList As New List(Of NetFile)
Dim FileCopyList As New Dictionary(Of String, String)
For Each Entry As McMod In ModList
Dim File As CompFile = Entry.UpdateFile
If Not File.Available Then Continue For
'确认更新后的文件名
Dim CurrentReplaceName = Entry.CompFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
Dim NewestReplaceName = Entry.UpdateFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
Dim CurrentSegs = CurrentReplaceName.Split("-"c).ToList()
Dim NewestSegs = NewestReplaceName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentReplaceName = Join(CurrentSegs, "-")
NewestReplaceName = Join(NewestSegs, "-")
End If
'添加到下载列表
Dim TempAddress As String = PathTemp & "DownloadedMods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
Dim RealAddress As String = GetPathFromFullPath(Entry.Path) & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
FileList.Add(File.ToNetFile(TempAddress))
FileCopyList(TempAddress) = RealAddress
Next
'构造加载器
Dim InstallLoaders As New List(Of LoaderBase)
Dim FinishedFileNames As New List(Of String)
InstallLoaders.Add(New LoaderDownload("下载新版 Mod 文件", FileList) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件",
Sub()
Try
For Each Entry As KeyValuePair(Of String, String) In FileCopyList
If File.Exists(Entry.Value) Then
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Log($"[Mod] 更新后的 Mod 文件已存在,将会把它放入回收站:{Entry.Value}", LogLevel.Debug)
End If
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then
File.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(GetFileNameFromPath(Entry.Value))
Else
Log($"[Mod] 更新后的目标文件夹已被删除:{Entry.Value}", LogLevel.Debug)
End If
Next
For Each Entry As McMod In ModList
If File.Exists(Entry.Path) Then
My.Computer.FileSystem.DeleteFile(Entry.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Else
Log($"[Mod] 未找到更新前的 Mod 文件,跳过对它的删除:{Entry.Path}", LogLevel.Debug)
End If
Next
Catch ex As OperationCanceledException
Log(ex, "替换旧版 Mod 文件时被主动取消")
End Try
End Sub))
'结束处理
Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新:" & PageVersionLeft.Version.Name, InstallLoaders)
Dim PathMods As String = PageVersionLeft.Version.PathIndie & "mods\"
Loader.OnStateChanged =
Sub()
'结果提示
Select Case Loader.State
Case LoadState.Finished
Hint(If(FinishedFileNames.Count > 1, $"已成功更新 {FinishedFileNames.Count} 个 Mod!", $"已成功更新:{FinishedFileNames.Single}"), HintType.Finish)
Case LoadState.Failed
Hint("Mod 更新失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint("Mod 更新已中止!", HintType.Info)
Case Else
Exit Sub
End Select
UpdatingVersions.Remove(PathMods)
'清理缓存
RunInNewThread(
Sub()
Try
For Each TempFile In FileCopyList.Keys
If File.Exists(TempFile) Then File.Delete(TempFile)
Next
Catch ex As Exception
Log(ex, "清理 Mod 更新缓存失败")
End Try
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
End Sub
'启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod")
UpdatingVersions.Add(PathMods)
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
RefreshList(True)
Catch ex As Exception
Log(ex, "初始化 Mod 更新失败")
End Try
End Sub
'删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
Dim DeleteList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList()
DeleteMods(DeleteList)
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
Try
@@ -191,7 +191,7 @@
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" MaxLength="4000" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置"
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置" />
+8 -8
View File
@@ -104,27 +104,27 @@
<local:MyCard Title="事件 4:其他事件类型" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" Margin="0,4,0,6" FontWeight="Bold"
<TextBlock Margin="0,4,0,6" FontWeight="Bold"
Text="EventType 共有以下种类:" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 打开网页、启动游戏、打开文件:已在上方的卡片中介绍" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="查看 PCL 源代码" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2/blob/main/Plain%20Craft%20Launcher%202/FormMain.xaml.vb"/>
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 今日人品、清理垃圾、内存优化、安装整合包:触发对应功能" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 复制文本:将 EventData 中的内容复制到剪贴板" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 刷新主页:点击重新加载主页。如果主页文件为联网更新,这会重新下载主页内容" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4"
<TextBlock Margin="0,0,0,4"
Text="· 下载文件:在点击时要求选择文件保存位置,并且下载 EventData 的链接中的文件" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="下载百度的 Logo" EventType="下载文件" EventData="https://www.baidu.com/img/flexible/logo/pc/result.png" />
<TextBlock TextWrapping="Wrap" Margin="0,4,0,4"
<TextBlock Margin="0,4,0,4"
Text="· 打开帮助:跳转到 EventData 对应的帮助文件(输入相对 Help 文件夹的路径)"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="打开自定义帮助页面" EventType="打开帮助" EventData="帮助/自定义帮助.json"/>
<TextBlock TextWrapping="Wrap" Margin="0,4,0,4"
<TextBlock Margin="0,4,0,4"
Text="· 切换页面:强制切换到 PCL 的某一页面(尝试切换到不太对头的页面会出现不可预知的 Bug,使用时请谨慎)&#xa;      EventData 为 页面种类|次要页面种类(PageType|PageSubType,例如 1|1)&#xa;      点击上方的 查看 PCL 源代码 按钮,在 1000 行左右的位置即可查找到对应数值"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="切换到下载页面" EventType="切换页面" EventData="1|1"/>
+1 -1
View File
@@ -3648,7 +3648,7 @@ vpn-blocker|禁用VPN (VPN Blocker)
premium-wood@
tenshilib¨tenshilib-fabric
randomportals|随意传送门 (RandomPortals)
configured|配置界面* - Forge¨configured-fabric|配置界面 (Configured) - Fabric
configured|配置界面*¨configured-fabric|配置界面 (Configured) - Fabric
jellyfishing@|抓水母*
accurate-block-placement