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)) UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
Environment.Exit(Result.Cancel) Environment.Exit(Result.Cancel)
'ElseIf e.Args(0).StartsWith("--link") Then 'ElseIf e.Args(0).StartsWithF("--link") Then
' '稍作等待后切换到联机页面 ' '稍作等待后切换到联机页面
' Thread.Sleep(1000) ' Thread.Sleep(1000)
' FormMain.IsLinkRestart = True ' FormMain.IsLinkRestart = True
ElseIf e.Args(0).StartsWith("--memory") Then ElseIf e.Args(0).StartsWithF("--memory") Then
'内存优化 '内存优化
Dim Ram = My.Computer.Info.AvailablePhysicalMemory Dim Ram = My.Computer.Info.AvailablePhysicalMemory
Try Try
@@ -173,7 +173,7 @@ Public Class Application
Private Shared ReadOnly AssemblyJsonLock As New Object Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object Private Shared ReadOnly AssemblyDialogLock As New Object
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly 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 SyncLock AssemblyNAudioLock
If AssemblyNAudio Is Nothing Then If AssemblyNAudio Is Nothing Then
Log("[Start] 加载 DLL:NAudio") Log("[Start] 加载 DLL:NAudio")
@@ -181,7 +181,7 @@ Public Class Application
End If End If
Return AssemblyNAudio Return AssemblyNAudio
End SyncLock End SyncLock
ElseIf args.Name.StartsWith("Newtonsoft.Json") Then ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then
SyncLock AssemblyJsonLock SyncLock AssemblyJsonLock
If AssemblyJson Is Nothing Then If AssemblyJson Is Nothing Then
Log("[Start] 加载 DLL:Json") Log("[Start] 加载 DLL:Json")
@@ -189,7 +189,7 @@ Public Class Application
End If End If
Return AssemblyJson Return AssemblyJson
End SyncLock End SyncLock
ElseIf args.Name.StartsWith("Ookii.Dialogs.Wpf") Then ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then
SyncLock AssemblyDialogLock SyncLock AssemblyDialogLock
If AssemblyDialog Is Nothing Then If AssemblyDialog Is Nothing Then
Log("[Start] 加载 DLL:Dialogs") Log("[Start] 加载 DLL:Dialogs")
@@ -138,7 +138,7 @@
Log("[Control] 按下按钮:" & Text) Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then 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("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!") Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If End If
End If End If
@@ -1,7 +1,7 @@
Public Class MyIconButton 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) If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
'添加新 Logo '添加新 Logo
If Not _Logo = "" Then If Not _Logo = "" Then
If _Logo.ToLower.StartsWith("http") Then If _Logo.StartsWithF("http", True) Then
'网络图片 '网络图片
PathLogo = New Image With { PathLogo = New Image With {
.Tag = Me, .Tag = Me,
@@ -220,7 +220,7 @@
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False} .SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear) 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) Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With { 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)) 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)) ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then If Not IsNothing(PathLogo) Then
If _Logo.EndsWith(".png") Then If _Logo.EndsWithF(".png", True) Then
PathLogo.Margin = New Thickness(4, 5, 3, 5) PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8) PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
@@ -58,8 +58,9 @@
Interop.ComponentDispatcher.PopModal() Interop.ComponentDispatcher.PopModal()
'动画 '动画
AniStart({ AniStart({
AaCode(Sub() AaCode(
If WaitingMyMsgBox.Count = 0 Then 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))) AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If End If
End Sub, 30), End Sub, 30),
@@ -63,8 +63,9 @@
Interop.ComponentDispatcher.PopModal() Interop.ComponentDispatcher.PopModal()
'动画 '动画
AniStart({ AniStart({
AaCode(Sub() AaCode(
If WaitingMyMsgBox.Count = 0 Then 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))) AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If End If
End Sub, 30), End Sub, 30),
@@ -56,8 +56,9 @@
Interop.ComponentDispatcher.PopModal() Interop.ComponentDispatcher.PopModal()
'动画 '动画
AniStart({ AniStart({
AaCode(Sub() AaCode(
If WaitingMyMsgBox.Count = 0 Then 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))) AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If End If
End Sub, 30), End Sub, 30),
@@ -89,7 +89,7 @@
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器 '初次运行加载器
If PageLoaderAutoRun Then 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)) PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
Else Else
Dim Input = Nothing Dim Input = Nothing
@@ -107,7 +107,7 @@
'重试 '重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试 Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub 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) PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else Else
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke() If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
+30 -22
View File
@@ -140,6 +140,14 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '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 If LastVersion < 316 Then 'Snapshot 2.6.15
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
FeatureCount += 2 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 Dim SortedFeatures = Sort(FeatureList, Function(Left As KeyValuePair(Of Integer, String), Right As KeyValuePair(Of Integer, String)) As Boolean
Return Left.Key > Right.Key Return Left.Key > Right.Key
End Function) 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("龙猫忘记写更新日志啦!可以去提醒他一下……") ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
End If End If
For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项 For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
@@ -810,7 +818,7 @@ Public Class FormMain
Try Try
Dim Str As String = e.Data.GetData(DataFormats.Text) Dim Str As String = e.Data.GetData(DataFormats.Text)
Log("[System] 接受文本拖拽:" & Str) Log("[System] 接受文本拖拽:" & Str)
If Str.StartsWith("authlib-injector:yggdrasil-server:") Then If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
'Authlib 拖拽 'Authlib 拖拽
e.Handled = True e.Handled = True
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length)) 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) FrmLaunchLeft.RefreshPage(True, False)
End If End If
ElseIf Str.StartsWith("file:///") Then ElseIf Str.StartsWithF("file:///") Then
'文件拖拽(例如从浏览器下载窗口拖入) '文件拖拽(例如从浏览器下载窗口拖入)
Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\") Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
e.Handled = True e.Handled = True
@@ -1296,7 +1304,7 @@ Install:
''' 通过点击返回按钮或手动触发返回来改变页面。 ''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary> ''' </summary>
Public Sub PageBack() Handles BtnTitleInner.Click Public Sub PageBack() Handles BtnTitleInner.Click
If PageStack.Count = 0 Then Exit Sub If Not PageStack.Any() Then Exit Sub
PageChangeActual(PageStack(0)) PageChangeActual(PageStack(0))
End Sub End Sub
@@ -1316,21 +1324,7 @@ Install:
PageChangeExit() PageChangeExit()
Else Else
'即将切换到一个子页面 '即将切换到一个子页面
If PageStack.Count = 0 Then If PageStack.Any 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
'子页面 → 另一个子页面,更新 '子页面 → 另一个子页面,更新
AniStart({ AniStart({
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130), AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
@@ -1346,6 +1340,20 @@ Install:
'进入更深层的子页面 '进入更深层的子页面
PageStack.Insert(0, PageCurrent) PageStack.Insert(0, PageCurrent)
End If 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 If End If
#End Region #End Region
@@ -1452,9 +1460,7 @@ Install:
''' 退出子界面。 ''' 退出子界面。
''' </summary> ''' </summary>
Private Sub PageChangeExit() Private Sub PageChangeExit()
If PageStack.Count = 0 Then If PageStack.Any Then
'主页面 → 主页面,无事发生
Else
'子页面 → 主页面,退出 '子页面 → 主页面,退出
PanTitleMain.Visibility = Visibility.Visible PanTitleMain.Visibility = Visibility.Visible
PanTitleMain.IsHitTestVisible = True PanTitleMain.IsHitTestVisible = True
@@ -1467,6 +1473,8 @@ Install:
AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True) AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer") }, "FrmMain Titlebar FirstLayer")
PageStack.Clear() PageStack.Clear()
Else
'主页面 → 主页面,无事发生
End If End If
End Sub End Sub
@@ -869,7 +869,7 @@ NextAni:
Loop Loop
'如果当前动画组都执行完毕则删除 '如果当前动画组都执行完毕则删除
If Entry.Data.Count = 0 Then If Not Entry.Data.Any() Then
'为了避免新添加的动画影响顺序,不能 RemoveAt(i) '为了避免新添加的动画影响顺序,不能 RemoveAt(i)
'为了允许动画在执行中添加同名动画组,不能按名字移除 '为了允许动画在执行中添加同名动画组,不能按名字移除
For Current = 0 To AniGroups.Count - 1 For Current = 0 To AniGroups.Count - 1
+124 -112
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.15" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.7.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.15." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.7.0." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 317 'Release Public Const VersionCode As Integer = 319 'Release
#Else #Else
Public Const VersionCode As Integer = 316 'Snapshot Public Const VersionCode As Integer = 318 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -110,6 +110,14 @@ Public Module ModBase
''' </summary> ''' </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" 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> ''' <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 ''' 图标按钮,笔,1x
''' </summary> ''' </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" 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/+=" Const Digits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/+="
'零与负数的处理 '零与负数的处理
If String.IsNullOrEmpty(Input) Then Return "0" 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("-") If IsNegative Then Input = Input.TrimStart("-")
'转换为十进制 '转换为十进制
Dim RealNum As Long = 0, Scale As Long = 1 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 RealNum += Digit * Scale
Scale *= FromRadix Scale *= FromRadix
Next Next
@@ -614,79 +622,50 @@ Public Module ModBase
End Sub End Sub
'Ini 文件 'Ini 文件
Private Class IniCache Private ReadOnly IniCache As New Dictionary(Of String, Dictionary(Of String, String))
Public FileContent As String = ""
Public KVCache As New Dictionary(Of String, String)
End Class
Private ReadOnly IniCacheList As New Dictionary(Of String, IniCache)
''' <summary> ''' <summary>
''' 清除某 Ini 文件的运行时缓存。 ''' 清除某 ini 文件的运行时缓存。
''' </summary> ''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param> ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
Public Sub IniClearCache(FileName As String) Public Sub IniClearCache(FileName As String)
'还原文件路径 If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini" If IniCache.ContainsKey(FileName) Then IniCache.Remove(FileName)
'检索缓存
If IniCacheList.ContainsKey(FileName) Then IniCacheList.Remove(FileName)
End Sub End Sub
''' <summary> ''' <summary>
''' 获取 Ini 文件内容,这可能会使用到缓存。 ''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
''' 在文件不存在或读取失败时返回 Nothing。
''' </summary> ''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param> ''' <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 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 If IniCache.ContainsKey(FileName) Then Return IniCache(FileName)
'返回缓存中的信息 '读取文件
Dim Cache As New IniCache If Not File.Exists(FileName) Then Return Nothing
IniCacheList.TryGetValue(FileName, Cache) Dim Ini As New Dictionary(Of String, String)
Return Cache '防止ByRef导致缓存变更 For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
Else Dim Index As Integer = Line.IndexOfF(":")
Dim Ini As IniCache If Index > 0 Then Ini.Add(Line.Substring(0, Index), Line.Substring(Index + 1))
If File.Exists(FileName) Then Next
'返回文件信息并且记入缓存 IniCache(FileName) = Ini
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 Return Ini
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取文件失败:" & FileName, LogLevel.Hint) Log(ex, $"生成 ini 文件缓存失败({FileName})", LogLevel.Hint)
Return New IniCache With {.FileContent = ""} Return Nothing
End Try End Try
End Function End Function
''' <summary> ''' <summary>
''' 读取Ini文件,这可能会使用到缓存。 ''' 读取 ini 文件。这可能会使用到缓存。
''' </summary> ''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param> ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
''' <param name="Key">键。</param> ''' <param name="Key">键。</param>
''' <param name="DefaultValue">没有找到键时返回的默认值。</param> ''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
Try Dim Content = IniGetContent(FileName)
'获取目前文件 If Content Is Nothing OrElse Not Content.ContainsKey(Key) Then Return DefaultValue
Dim NowIni As IniCache = IniGetContent(FileName) Return Content(Key)
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
End Function End Function
''' <summary> ''' <summary>
''' 写入 ini 文件,这会更新缓存。 ''' 写入 ini 文件,这会更新缓存。
@@ -697,47 +676,41 @@ Public Module ModBase
''' <remarks></remarks> ''' <remarks></remarks>
Public Sub WriteIni(FileName As String, Key As String, Value As String) Public Sub WriteIni(FileName As String, Key As String, Value As String)
Try Try
'预处理
'还原文件路径 Key = Key.Replace(vbCr, "").Replace(vbLf, "").Replace(":", "")
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini" Value = Value.Replace(vbCr, "").Replace(vbLf, "") '允许 Value 中包含冒号
If IsNothing(Value) Then Value = ""
Value = Value.Replace(vbCrLf, "")
'创建文件夹
If Not Directory.Exists(GetPathFromFullPath(FileName)) Then Directory.CreateDirectory(GetPathFromFullPath(FileName))
'获取目前文件 '获取目前文件
Dim NowFile As String = IniGetContent(FileName).FileContent Dim Content As Dictionary(Of String, String) = IniGetContent(FileName)
If Not NowFile.EndsWith(vbCrLf) Then NowFile += vbCrLf If Content Is Nothing Then Content = New Dictionary(Of String, String)
'如果值一样就不处理 If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Exit Sub '如果值一样就不处理
If NowFile.Contains(vbCrLf & Key & ":" & Value & vbCrLf) Then Exit Sub '更新缓存
'处理文件 Content(Key) = Value
Dim FindResult As String = ReadIni(FileName, Key) '写入文件
If FindResult = "" AndAlso Not NowFile.Contains(vbCrLf & Key & ":") Then Dim FileContent As New StringBuilder
'不存在这个键 For Each Pair In Content
NowFile = NowFile & vbCrLf & Key & ":" & Value & vbCrLf FileContent.Append(Pair.Key)
Else FileContent.Append(":")
'存在这个键 FileContent.Append(Pair.Value)
NowFile = NowFile.Replace(vbCrLf & Key & ":" & FindResult & vbCrLf, vbCrLf & Key & ":" & Value & vbCrLf) FileContent.Append(vbCrLf)
End If Next
WriteFile(FileName, NowFile) If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
'刷新目前缓存 WriteFile(FileName, FileContent.ToString)
IniCacheList(FileName).FileContent = NowFile
IniCacheList(FileName).KVCache.Remove(Key)
IniCacheList(FileName).KVCache.Add(Key, Value)
Catch ex As Exception Catch ex As Exception
Log(ex, "写入文件失败:" & FileName & "/" & Key & ": " & Value) Log(ex, $"写入文件失败({FileName} -> {Key}:{Value})")
End Try End Try
End Sub End Sub
'路径处理 '路径处理
''' <summary> ''' <summary>
''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。不包含路径将会抛出异常。 ''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
''' 取决于原路径格式,路径以 / 或 \ 结尾。
''' 不包含路径将会抛出异常。
''' </summary> ''' </summary>
Public Function GetPathFromFullPath(FilePath As String) As String Public Function GetPathFromFullPath(FilePath As String) As String
If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Throw New Exception("不包含路径:" & FilePath) 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) FilePath = Left(FilePath, Len(FilePath) - 1)
GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/") GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath) If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath)
@@ -752,11 +725,13 @@ Public Module ModBase
''' </summary> ''' </summary>
Public Function GetFileNameFromPath(FilePath As String) As String Public Function GetFileNameFromPath(FilePath As String) As String
FilePath = FilePath.Replace("/", "\") FilePath = FilePath.Replace("/", "\")
If FilePath.EndsWith("\") Then Throw New Exception("不包含文件名:" & FilePath) If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
Dim FileName As String = FilePath.Split("\").Last.Split("?").First '去掉网络参数后的 ? If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
If FileName.Length = 0 Then Throw New Exception("不包含文件名:" & FilePath) If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
If FileName.Length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath) Dim length As Integer = FilePath.Length
Return FileName If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
If length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
Return FilePath
End Function End Function
''' <summary> ''' <summary>
''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。 ''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
@@ -764,7 +739,7 @@ Public Module ModBase
Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String
Dim Name As String = GetFileNameFromPath(FilePath) Dim Name As String = GetFileNameFromPath(FilePath)
If Name.Contains(".") Then If Name.Contains(".") Then
Return Name.Substring(0, Name.LastIndexOf(".")) Return Name.Substring(0, Name.LastIndexOfF("."))
Else Else
Return Name Return Name
End If End If
@@ -773,8 +748,8 @@ Public Module ModBase
''' 从文件夹路径获取文件夹名。 ''' 从文件夹路径获取文件夹名。
''' </summary> ''' </summary>
Public Function GetFolderNameFromPath(FolderPath As String) As String Public Function GetFolderNameFromPath(FolderPath As String) As String
If FolderPath.EndsWith(":\") OrElse FolderPath.EndsWith(":\\") Then Return FolderPath.Substring(0, 1) If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") 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 FolderPath = Left(FolderPath, FolderPath.Length - 1)
Return GetFileNameFromPath(FolderPath) Return GetFileNameFromPath(FolderPath)
End Function End Function
@@ -1027,7 +1002,7 @@ Public Module ModBase
Public Function SelectFolder(Optional Title As String = "选择文件夹") As String 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} Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
folderDialog.ShowDialog() 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) Log("[UI] 选择文件夹返回:" & SelectFolder)
End Function End Function
@@ -1038,8 +1013,8 @@ Public Module ModBase
Public Function CheckPermission(Path As String) As Boolean Public Function CheckPermission(Path As String) As Boolean
Try Try
If Path = "" Then Return False If Path = "" Then Return False
If Not Path.EndsWith("\") Then Path += "\" If Not Path.EndsWithF("\") Then Path += "\"
If Path.EndsWith(":\System Volume Information\") OrElse Path.EndsWith(":\$RECYCLE.BIN\") Then Return False If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Not Directory.Exists(Path) Then Return False If Not Directory.Exists(Path) Then Return False
Dim FileName As String = "CheckPermission" & GetUuid() Dim FileName As String = "CheckPermission" & GetUuid()
If File.Exists(Path & FileName) Then File.Delete(Path & FileName) If File.Exists(Path & FileName) Then File.Delete(Path & FileName)
@@ -1056,7 +1031,7 @@ Public Module ModBase
''' </summary> ''' </summary>
Public Sub CheckPermissionWithException(Path As String) Public Sub CheckPermissionWithException(Path As String)
If String.IsNullOrWhiteSpace(Path) Then Throw New ArgumentNullException("文件夹名不能为空!") 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 Not Directory.Exists(Path) Then Throw New DirectoryNotFoundException("文件夹不存在!")
If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission") If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission")
File.Create(Path & "CheckPermission").Dispose() 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 Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
Try Try
Directory.CreateDirectory(DestDirectory) Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWith(".gz") Then If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压 '以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress) Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write) Dim 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"))) Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName) 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 '不创建空文件夹 Continue For '不创建空文件夹
Else Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath)) Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
@@ -1318,9 +1293,9 @@ Re:
''' </summary> ''' </summary>
Public Sub CopyDirectory(FromPath As String, ToPath As String) Public Sub CopyDirectory(FromPath As String, ToPath As String)
FromPath = FromPath.Replace("/", "\") FromPath = FromPath.Replace("/", "\")
If Not FromPath.EndsWith("\") Then FromPath &= "\" If Not FromPath.EndsWithF("\") Then FromPath &= "\"
ToPath = ToPath.Replace("/", "\") ToPath = ToPath.Replace("/", "\")
If Not ToPath.EndsWith("\") Then ToPath &= "\" If Not ToPath.EndsWithF("\") Then ToPath &= "\"
For Each File In EnumerateFiles(FromPath) For Each File In EnumerateFiles(FromPath)
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath)) CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
Next Next
@@ -1567,6 +1542,42 @@ Re:
Return tmp.ToString() Return tmp.ToString()
End Function 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> ''' <summary>
''' 输入 And 字符不会报错的 Val。 ''' 输入 And 字符不会报错的 Val。
''' </summary> ''' </summary>
@@ -1649,14 +1660,14 @@ Re:
Source = Source.ToLower.Replace(" ", "") Source = Source.ToLower.Replace(" ", "")
Query = Query.ToLower.Replace(" ", "") Query = Query.ToLower.Replace(" ", "")
Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存 Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
Do While qp < Query.Length Do While qp < queryLength
'对 qp 作为开始位置计算 '对 qp 作为开始位置计算
Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0 Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
'查找以 qp 为头的最大子串 '查找以 qp 为头的最大子串
Do While sp < Source.Length Do While sp < Source.Length
'对每个 sp 作为开始位置计算最大子串 '对每个 sp 作为开始位置计算最大子串
Dim len As Integer = 0 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 len += 1
Loop Loop
'存储 len '存储 len
@@ -1671,7 +1682,7 @@ Re:
Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空 Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空
'存储 lenSum '存储 lenSum
Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成 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 lenSum += IncWeight
End If End If
'根据结果增加 qp '根据结果增加 qp
@@ -1721,17 +1732,18 @@ 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)) 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)) 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 For Each Entry In Entries
Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query) Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
Entry.AbsoluteRight = False Entry.AbsoluteRight = False
For Each Pair In Entry.SearchSource 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
Next Next
'按照相似度进行排序 '按照相似度进行排序
Entries = Sort(Entries, Function(Left As SearchEntry(Of T), Right As SearchEntry(Of T)) As Boolean Entries = Sort(Entries,
Function(Left, Right) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight Return Left.AbsoluteRight
Else Else
@@ -2089,7 +2101,7 @@ NextElement:
Dim AllArguments() As String = Command.Split(" ") Dim AllArguments() As String = Command.Split(" ")
For i = 0 To AllArguments.Length - 1 For i = 0 To AllArguments.Length - 1
If AllArguments(i) = "-" & Name Then 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) Return AllArguments(i + 1)
End If End If
Next Next
@@ -2116,7 +2128,7 @@ NextElement:
''' </summary> ''' </summary>
Public Sub OpenWebsite(Url As String) Public Sub OpenWebsite(Url As String)
Try 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) Log("[System] 正在打开网页:" & Url)
Process.Start(Url) Process.Start(Url)
Catch ex As Exception Catch ex As Exception
@@ -490,7 +490,7 @@
Select Case Loader.State Select Case Loader.State
Case LoadState.Finished 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 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) If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart GoTo Restart
@@ -500,7 +500,7 @@
End If End If
Case LoadState.Loading 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 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) If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart GoTo Restart
@@ -517,9 +517,9 @@ Restart:
If Input IsNot Nothing Then If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续 '若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name 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) 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) Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
Else Else
Throw New Exception("未知的加载器类型(" & LoaderType & ")") 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) Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
For Each SubLoader In Loader.Loaders For Each SubLoader In Loader.Loaders
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader) 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 Next
End Sub End Sub
''' <summary> ''' <summary>
@@ -606,7 +606,7 @@ Restart:
End If End If
RunInUi(Sub() FrmMain.BtnExtraDownload.Progress = LoaderTaskbarProgress) 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 NewState = Shell.TaskbarItemProgressState.None
ElseIf LoaderTaskbarProgress < 0.015 Then ElseIf LoaderTaskbarProgress < 0.015 Then
NewState = Shell.TaskbarItemProgressState.Indeterminate NewState = Shell.TaskbarItemProgressState.Indeterminate
+14 -14
View File
@@ -189,7 +189,7 @@ RequestFinished:
Dim Request As HttpWebRequest = WebRequest.Create(Url) Dim Request As HttpWebRequest = WebRequest.Create(Url)
Dim Result As New List(Of Byte) Dim Result As New List(Of Byte)
Try 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.Timeout = Timeout
Request.Accept = Accept Request.Accept = Accept
SecretHeadersSign(Url, Request, UseBrowserUserAgent) SecretHeadersSign(Url, Request, UseBrowserUserAgent)
@@ -397,7 +397,7 @@ RequestFinished:
Req.ContentType = ContentType Req.ContentType = ContentType
Req.Timeout = Timeout Req.Timeout = Timeout
SecretHeadersSign(Url, Req, UseBrowserUserAgent) 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 If Method = "POST" OrElse Method = "PUT" Then
Req.ContentLength = SendData.Length Req.ContentLength = SendData.Length
DataStream = Req.GetRequestStream() DataStream = Req.GetRequestStream()
@@ -897,7 +897,7 @@ RequestFinished:
''' 新建一个需要下载的文件。 ''' 新建一个需要下载的文件。
''' </summary> ''' </summary>
''' <param name="LocalPath">包含文件名的本地地址。</param> ''' <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 Sources As New List(Of NetSource)
Dim Count As Integer = 0 Dim Count As Integer = 0
Urls = Urls.Distinct.ToArray Urls = Urls.Distinct.ToArray
@@ -987,7 +987,7 @@ StartThread:
'构建线程 '构建线程
Dim ThreadUuid As Integer = GetUuid() Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks 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} Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal}
End SyncLock End SyncLock
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload} 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 If SourcesOnce.Contains(Info.Source) AndAlso Not Info.Equals(Info.Source.Thread) Then GoTo SourceBreak
'请求头 '请求头
HttpRequest = WebRequest.Create(Info.Source.Url) 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.Proxy = Nothing 'new WebProxy(Ip, Port)
HttpRequest.Timeout = Timeout HttpRequest.Timeout = Timeout
HttpRequest.AddRange(Info.DownloadStart) HttpRequest.AddRange(Info.DownloadStart)
@@ -1067,11 +1067,11 @@ StartThread:
If ThreadFileSize > 50 * 1024 * 1024 Then If ThreadFileSize > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives For Each Drive As DriveInfo In DriveInfo.GetDrives
Dim DriveName As String = Drive.Name.First.ToString Dim DriveName As String = Drive.Name.First.ToString
Dim RequiredSpace = If(PathTemp.StartsWith(DriveName), ThreadFileSize * 1.1, 0) + Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ThreadFileSize * 1.1, 0) +
If(LocalPath.StartsWith(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0) If(LocalPath.StartsWithF(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0)
If Drive.TotalFreeSpace < RequiredSpace Then If Drive.TotalFreeSpace < RequiredSpace Then
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" & Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
If(PathTemp.StartsWith(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", "")) If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
End If End If
Next Next
End If End If
@@ -1465,7 +1465,7 @@ Retry:
Public Overrides Property Progress As Double Public Overrides Property Progress As Double
Get Get
If State >= LoadState.Finished Then Return 1 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 Return _Progress
End Get End Get
Set(value As Double) Set(value As Double)
@@ -1559,21 +1559,21 @@ NextElement:
RunInNewThread(Sub() RunInNewThread(Sub()
Try Try
'输入检测 '输入检测
If Files.Count = 0 Then If Not Files.Any() Then
OnFinish() OnFinish()
Exit Sub Exit Sub
End If End If
For Each File As NetFile In Files For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求!") If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
For Each Source As NetSource In File.Sources 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.Ex = New ArgumentException("输入的下载链接不正确!")
Source.IsFailed = True Source.IsFailed = True
End If End If
Next Next
If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!") If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!")
If Not File.LocalPath.ToLower.Contains(":\") 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 Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath) If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
@@ -1626,7 +1626,7 @@ NextElement:
For Each File As NetFile In Files For Each File As NetFile In Files
Dim ExistFilePath As String = Nothing 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, "") Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
For Each Folder In FolderList For Each Folder In FolderList
Dim Target = Folder & Relative Dim Target = Folder & Relative
@@ -1699,7 +1699,7 @@ Retry:
Public Sub OnFail(ExList As List(Of Exception)) Public Sub OnFail(ExList As List(Of Exception))
SyncLock LockState SyncLock LockState
If State > LoadState.Loading Then Exit Sub 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 的下载源 '寻找第一个不是 404 的下载源
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0)) [Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0))
@@ -76,7 +76,7 @@ Public Class ValidateHttp
Public Sub New() Public Sub New()
End Sub '用于 XAML 初始化 End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String 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 "输入的网址无效!" If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效!"
Return "" Return ""
End Function End Function
@@ -149,7 +149,7 @@ Public Class ValidateExcept
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
For Each Ch As String In Excepts 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 = "" If IsNothing(ErrorMessage) Then ErrorMessage = ""
Return ErrorMessage.Replace("%", Ch) Return ErrorMessage.Replace("%", Ch)
End If End If
@@ -220,13 +220,13 @@ Public Class ValidateFolderName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str) Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck If Not LengthCheck = "" Then Return LengthCheck
'检查空格 '检查空格
If Str.StartsWith(" ") Then Return "文件夹名不能以空格开头!" If Str.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件夹名不能以空格结尾!" If Str.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查长度 '检查长度
LengthCheck = New ValidateLength(1, 100).Validate(Str) LengthCheck = New ValidateLength(1, 100).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck 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) Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck If Not CharactCheck = "" Then Return CharactCheck
@@ -273,13 +273,13 @@ Public Class ValidateFileName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str) Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck If Not LengthCheck = "" Then Return LengthCheck
'检查空格 '检查空格
If Str.StartsWith(" ") Then Return "文件名不能以空格开头!" If Str.StartsWithF(" ") Then Return "文件名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件名不能以空格结尾!" If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾!"
'检查长度 '检查长度
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, "")) LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
If Not LengthCheck = "" Then Return LengthCheck 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) Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck If Not CharactCheck = "" Then Return CharactCheck
@@ -319,7 +319,7 @@ Public Class ValidateFolderPath
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
'去除尾部斜线,统一为 \ '去除尾部斜线,统一为 \
Str = Str.Replace("/", "\") 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) Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck If Not LengthCheck = "" Then Return LengthCheck
@@ -327,15 +327,15 @@ Public Class ValidateFolderPath
LengthCheck = New ValidateLength(1, 254).Validate(Str) LengthCheck = New ValidateLength(1, 254).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck 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 For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.ToUpper = Drive.Name Then Return "" 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 Next
Return "文件夹路径头存在错误!" Return "文件夹路径头存在错误!"
Fin: 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 SubStr As String = Str.Split("\")(i)
'检查是否为空 '检查是否为空
Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr) 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) Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
If Not CharactCheck = "" Then Return CharactCheck If Not CharactCheck = "" Then Return CharactCheck
'检查头部空格 '检查头部空格
If SubStr.StartsWith(" ") Then Return "文件夹名不能以空格开头!" If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If SubStr.EndsWith(" ") 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) 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 If Not InvalidStrCheck = "" Then Return InvalidStrCheck
@@ -55,7 +55,7 @@ Public Class MyBitmap
Public Sub New(FilePathOrResourceName As String) Public Sub New(FilePathOrResourceName As String)
Try Try
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage) FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWith(PathImage) Then If FilePathOrResourceName.StartsWithF(PathImage) Then
'使用缓存 '使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then If BitmapCache.ContainsKey(FilePathOrResourceName) Then
Pic = BitmapCache(FilePathOrResourceName).Pic Pic = BitmapCache(FilePathOrResourceName).Pic
@@ -18,6 +18,7 @@
'https://docs.curseforge.com/?http#tocS_ModLoaderType 'https://docs.curseforge.com/?http#tocS_ModLoaderType
Any = 0 Any = 0
Forge = 1 Forge = 1
LiteLoader = 3
Fabric = 4 Fabric = 4
Quilt = 5 Quilt = 5
NeoForge = 6 NeoForge = 6
@@ -43,10 +44,10 @@
For Each EntryData As String In Line.Split("¨") For Each EntryData As String In Line.Split("¨")
Dim Entry = New CompDatabaseEntry Dim Entry = New CompDatabaseEntry
Dim SplitedLine = EntryData.Split("|") Dim SplitedLine = EntryData.Split("|")
If SplitedLine(0).StartsWith("@") Then If SplitedLine(0).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = SplitedLine(0).Replace("@", "") Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
ElseIf SplitedLine(0).EndsWith("@") Then ElseIf SplitedLine(0).EndsWithF("@") Then
Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@") Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf SplitedLine(0).Contains("@") Then ElseIf SplitedLine(0).Contains("@") Then
@@ -247,12 +248,26 @@
LastUpdate = Data("dateReleased") '#1194 LastUpdate = Data("dateReleased") '#1194
DownloadCount = Data("downloadCount") DownloadCount = Data("downloadCount")
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl") If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
'FileIndexes / GameVersions 'FileIndexes / GameVersions / ModLoaders
Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray). ModLoaders = New List(Of CompModLoaderType)
Where(Function(i) i("gameVersion").ToString.Contains("1.")) Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).Distinct.ToList For Each File In If(Data("latestFiles"), New JArray)
GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). 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 Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type 'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod Type = CompType.Mod
@@ -309,15 +324,7 @@
'FUTURE: Res 'FUTURE: Res
End Select End Select
Next Next
If Tags.Count = 0 Then Tags.Add("杂项") If Not Tags.Any() 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
#End Region #End Region
Else Else
#Region "Modrinth" #Region "Modrinth"
@@ -334,7 +341,7 @@
'GameVersions 'GameVersions
'搜索结果的键为 versions,获取特定工程的键为 game_versions '搜索结果的键为 versions,获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray). 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). Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList Distinct.OrderByDescending(Function(v) v).ToList
'Type 'Type
@@ -383,7 +390,7 @@
'FUTURE: Res 'FUTURE: Res
End Select End Select
Next Next
If Tags.Count = 0 Then Tags.Add("杂项") If Not Tags.Any() Then Tags.Add("杂项")
Tags.Sort() Tags.Sort()
ModLoaders.Sort() ModLoaders.Sort()
#End Region #End Region
@@ -562,7 +569,7 @@
End If End If
Next 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 '同时包含 NormalName 和 Subtitle
Title = NormalNameList.Join(" - ") Title = NormalNameList.Join(" - ")
Else Else
@@ -683,8 +690,8 @@ NoSubtitle:
''' </summary> ''' </summary>
Public ReadOnly Property CanContinue As Boolean Public ReadOnly Property CanContinue As Boolean
Get Get
If Tag.StartsWith("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0 If Tag.StartsWithF("/") 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.EndsWithF("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
End Get End Get
@@ -732,7 +739,7 @@ NoSubtitle:
''' </summary> ''' </summary>
Public Function GetCurseForgeAddress() As String Public Function GetCurseForgeAddress() As String
If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing 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 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}" 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> ''' </summary>
Public Function GetModrinthAddress() As String Public Function GetModrinthAddress() As String
If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing 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 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" 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} 个结果,结束处理") Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
Exit Sub Exit Sub
ElseIf Not Task.Input.CanContinue Then 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("没有符合条件的结果") Throw New Exception("没有符合条件的结果")
Else Else
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理") Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
@@ -867,7 +874,7 @@ NoSubtitle:
Next Next
'获取搜索结果 '获取搜索结果
Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3) 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 = "" Dim SearchResult As String = ""
For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个 For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度 If 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 = "" Dim RealFilter As String = ""
For Each Word In SearchResult.Split(" ") 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 If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " " RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
Next Next
@@ -904,15 +911,15 @@ NoSubtitle:
End If End If
RightKeywords.Add(Keyword) RightKeywords.Add(Keyword)
Next Next
If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then If RawFilter.Length > 0 AndAlso Not RightKeywords.Any() Then
Task.Input.SearchText = RawFilter '全都被过滤掉了 Task.Input.SearchText = RawFilter '全都被过滤掉了
Else Else
Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
End If End If
'例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod) '例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchText = "optiforge" If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Task.Input.SearchText = "optiforge"
If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchText = "optifabric" If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Task.Input.SearchText = "optifabric"
Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Debug) Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Debug)
Task.Progress = 0.1 Task.Progress = 0.1
@@ -1003,15 +1010,15 @@ Retry:
'确保存在结果 '确保存在结果
Storage.ErrorMessage = Nothing Storage.ErrorMessage = Nothing
If RawResults.Count = 0 Then If Not RawResults.Any() Then
If [Error] IsNot Nothing Then If [Error] IsNot Nothing Then
Throw [Error] Throw [Error]
Else Else
If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then
Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文") 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 不兼容所选的类型") 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 不兼容所选的类型") Throw New Exception("Modrinth 不兼容所选的类型")
Else Else
Throw New Exception("没有符合条件的结果") Throw New Exception("没有符合条件的结果")
@@ -1171,7 +1178,7 @@ Retry:
''' </summary> ''' </summary>
Public ReadOnly Property Available As Boolean Public ReadOnly Property Available As Boolean
Get Get
Return FileName IsNot Nothing Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -1181,7 +1188,11 @@ Retry:
''' <summary> ''' <summary>
''' 文件所有可能的下载源。 ''' 文件所有可能的下载源。
''' </summary> ''' </summary>
Private ReadOnly DownloadAddress As String() Public DownloadUrls As List(Of String)
''' <summary>
''' 文件的 SHA1 或 MD5。
''' </summary>
Public ReadOnly Hash As String = Nothing
''' <summary> ''' <summary>
''' 该文件的所有依赖工程的原始 ID。 ''' 该文件的所有依赖工程的原始 ID。
''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。 ''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
@@ -1196,7 +1207,7 @@ Retry:
''' </summary> ''' </summary>
''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param> ''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalAddress As String) As NetFile 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 End Function
'实例化 '实例化
@@ -1206,6 +1217,23 @@ Retry:
''' </summary> ''' </summary>
Public Sub New(Data As JObject, Type As CompType) Public Sub New(Data As JObject, Type As CompType)
Me.Type = Type Me.Type = Type
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
FromCurseForge = Data.ContainsKey("gameId") FromCurseForge = Data.ContainsKey("gameId")
If FromCurseForge Then If FromCurseForge Then
#Region "CurseForge" #Region "CurseForge"
@@ -1216,14 +1244,16 @@ Retry:
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus) Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount") DownloadCount = Data("downloadCount")
FileName = Data("fileName") 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 'DownloadAddress
Dim Url = Data("downloadUrl").ToString 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}" 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)) '对文件名进行编码 Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), 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("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"), Url.Replace("://edge", "://media"),
Url}.Distinct.ToArray Url}).Distinct().ToList()
'Dependencies 'Dependencies
If Type = CompType.Mod Then If Type = CompType.Mod Then
RawDependencies = Data("dependencies"). RawDependencies = Data("dependencies").
@@ -1233,7 +1263,7 @@ Retry:
End If End If
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList 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 GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
If GameVersions.Count > 1 Then If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
@@ -1258,9 +1288,11 @@ Retry:
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha)) Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads") DownloadCount = Data("downloads")
'可能为空 '可能为空
If CType(Data("files"), JArray).Count > 0 Then If CType(Data("files"), JArray).Any() Then
FileName = Data("files")(0)("filename") Dim File As JToken = Data("files")(0)
DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, FileName)} FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url")}
Hash = File("hashes")("sha1")
End If End If
'Dependencies 'Dependencies
If Type = CompType.Mod Then If Type = CompType.Mod Then
@@ -1272,8 +1304,8 @@ Retry:
End If End If
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList 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.")). GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWith("b1."), "远古版本", v))).ToList Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
@@ -1292,8 +1324,29 @@ Retry:
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region #End Region
End If End If
End If
End Sub End Sub
''' <summary> ''' <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> ''' </summary>
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing, Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
@@ -1434,7 +1487,7 @@ Retry:
'如果为整合包就不会有 Dependencies 信息,所以不用管 '如果为整合包就不会有 Dependencies 信息,所以不用管
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList() Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
Deps.Sort() Deps.Sort()
If Deps.Count = 0 Then Exit Sub If Not Deps.Any() Then Exit Sub
Deps = Deps.Where(Function(dep) Deps = Deps.Where(Function(dep)
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug) If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
Return CompProjectCache.ContainsKey(dep) Return CompProjectCache.ContainsKey(dep)
@@ -80,7 +80,7 @@
Log(ex, "确认崩溃日志时间失败(" & LogFile & ")") Log(ex, "确认崩溃日志时间失败(" & LogFile & ")")
End Try End Try
Next Next
If RightLogs.Count = 0 Then Log("[Crash] 未发现可能可用的日志文件") If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件")
'将可能可用的日志文件导出 '将可能可用的日志文件导出
For Each FilePath In RightLogs For Each FilePath In RightLogs
@@ -114,7 +114,7 @@
Try Try
Dim Info As New FileInfo(FilePath) Dim Info As New FileInfo(FilePath)
If Not Info.Exists OrElse Info.Length = 0 Then Exit Try 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) Log("[Crash] 已解压导入的日志文件:" & FilePath)
Else Else
@@ -132,7 +132,7 @@
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower Dim Ext As String = TargetFile.Extension.ToLower
If Ext = ".log" OrElse Ext = ".txt" Then 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))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray))) 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 For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim TargetType As AnalyzeFileType Dim TargetType As AnalyzeFileType
If MatchName.StartsWith("hs_err") Then If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile DirectFile = LogFile
ElseIf MatchName.StartsWith("crash-") Then ElseIf MatchName.StartsWithF("crash-") Then
TargetType = AnalyzeFileType.CrashReport TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile DirectFile = LogFile
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
@@ -187,13 +187,13 @@
Else Else
TargetType = AnalyzeFileType.ExtraLog TargetType = AnalyzeFileType.ExtraLog
End If 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 TargetType = AnalyzeFileType.ExtraLog
Else Else
Log("[Crash] " & MatchName & " 分类为 Ignore") Log("[Crash] " & MatchName & " 分类为 Ignore")
Continue For Continue For
End If End If
If LogFile.Value.Count = 0 Then If Not LogFile.Value.Any() Then
Log("[Crash] " & MatchName & " 由于内容为空跳过") Log("[Crash] " & MatchName & " 由于内容为空跳过")
Else Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile)) TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
@@ -208,7 +208,7 @@
For Each File In TotalFiles For Each File In TotalFiles
If SelectType = File.Key Then SelectedFiles.Add(File.Value) If SelectType = File.Key Then SelectedFiles.Add(File.Value)
Next Next
If SelectedFiles.Count = 0 Then Continue For If Not SelectedFiles.Any() Then Continue For
Try Try
'根据文件类别判断 '根据文件类别判断
Select Case SelectType Select Case SelectType
@@ -437,7 +437,7 @@
'输出到日志 '输出到日志
Done: Done:
If CrashReasons.Count = 0 Then If Not CrashReasons.Any() Then
Log("[Crash] 步骤 3:分析崩溃原因完成,未找到可能的原因") Log("[Crash] 步骤 3:分析崩溃原因完成,未找到可能的原因")
Else Else
Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因") 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", "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", "com.electronwill.nightconfig", "it.unimi.dsi",
"MojangTricksIntelDriversForPerformance_javaw"} "MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack
Next Next
PossibleStacks.Add(Stack.Trim) '.Split("$").First) PossibleStacks.Add(Stack.Trim) '.Split("$").First)
NextStack: NextStack:
Next Next
PossibleStacks = PossibleStacks.Distinct.ToList PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息") 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 For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack) Log("[Crash] - " & Stack)
Next Next
@@ -663,7 +663,7 @@ NextStack:
Dim Splited = Stack.Split(".") Dim Splited = Stack.Split(".")
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节 For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i) 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", 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", "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
@@ -716,8 +716,8 @@ NextStack:
'[Fabric] 获取所有包含 Mod 信息的行 '[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String) Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf) For Each Line In Details.Split(vbLf)
If Line.ToLower.Contains(".jar") OrElse If Line.ContainsF(".jar", True) OrElse
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line) (IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行") Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -782,7 +782,7 @@ NextStack:
'输出 '输出
ModFileNames = ModFileNames.Distinct.ToList ModFileNames = ModFileNames.Distinct.ToList
If ModFileNames.Count = 0 Then If Not ModFileNames.Any() Then
Return Nothing Return Nothing
Else Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名") Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
@@ -866,7 +866,7 @@ NextStack:
Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String
'没有结果的处理 '没有结果的处理
If CrashReasons.Count = 0 Then If Not CrashReasons.Any() Then
If IsHandAnalyze Then If IsHandAnalyze Then
Return "很抱歉,PCL 无法确定错误原因。" Return "很抱歉,PCL 无法确定错误原因。"
Else Else
@@ -1034,7 +1034,7 @@ NextStack:
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")). Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf). Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) & 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 & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" & vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "", If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。")) vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
@@ -91,7 +91,8 @@
Dim LoadersAssetsUpdate As New List(Of LoaderBase) Dim LoadersAssetsUpdate As New List(Of LoaderBase)
Dim TempAddress As String = Nothing Dim TempAddress As String = Nothing
Dim RealAddress 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))) LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version) Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
RealAddress = BackAssetsFile.LocalPath RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
@@ -99,7 +100,8 @@
Task.Output = New List(Of NetFile) From {BackAssetsFile} Task.Output = New List(Of NetFile) From {BackAssetsFile}
End Sub)) End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile))) 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)) LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress) CopyFile(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress) McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
End Sub)) End Sub))
@@ -248,7 +250,7 @@
End Select End Select
'确认版本格式标准 '确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4 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") For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then If Version("id") = Id Then
@@ -306,7 +308,7 @@
Return _inherit Return _inherit
End Get End Get
Set(value As String) 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 _inherit = value
End Set End Set
End Property End Property
@@ -366,9 +368,9 @@
Dim Entry As New DlOptiFineListEntry With { Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "), .NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(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), .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("#", "")} .RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "") Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
@@ -389,7 +391,7 @@
Dim Entry As New DlOptiFineListEntry With { Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "), .NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "", .ReleaseTime = "",
.IsPreview = Token("patch").ToString.ToLower.Contains("pre"), .IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString, .Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString, .NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "") .RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
@@ -601,7 +603,7 @@
Dim Versions As New List(Of DlForgeVersionEntry) Dim Versions As New List(Of DlForgeVersionEntry)
Try 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 For i = 1 To VersionCodes.Count - 1
Dim VersionCode = VersionCodes(i) Dim VersionCode = VersionCodes(i)
@@ -626,17 +628,17 @@
Dim MD5 As String, Category As String Dim MD5 As String, Category As String
If VersionCode.Contains("classifier-installer""") Then If VersionCode.Contains("classifier-installer""") Then
'类型为 installer.jar,支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部) '类型为 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> )[^<]+") MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "installer" Category = "installer"
ElseIf VersionCode.Contains("classifier-universal""") Then ElseIf VersionCode.Contains("classifier-universal""") Then
'类型为 universal.zip,支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分) '类型为 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> )[^<]+") MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "universal" Category = "universal"
ElseIf VersionCode.Contains("client.zip") Then ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip,支持范围 182~ (1.3.2 部分 ~) '类型为 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> )[^<]+") MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "client" Category = "client"
Else Else
@@ -652,7 +654,7 @@
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result & ")", ex) Throw New Exception("版本列表解析失败(" & Result & ")", ex)
End Try End Try
If Versions.Count = 0 Then Throw New Exception("没有可用版本") If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions Loader.Output = Versions
End Sub End Sub
@@ -708,7 +710,7 @@
Catch ex As Exception Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex) Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
End Try End Try
If Versions.Count = 0 Then Throw New Exception("没有可用版本") If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions Loader.Output = Versions
End Sub End Sub
@@ -799,7 +801,7 @@
Dim Json As JObject = Result("versions") Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry) Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json 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") Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With { Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key, .Inherit = Pair.Key,
@@ -827,7 +829,7 @@
Dim Json As JObject = Result("versions") Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry) Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json 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") Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With { Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key, .Inherit = Pair.Key,
@@ -62,7 +62,7 @@
Public ReadOnly Property HasEnvironment As Boolean Public ReadOnly Property HasEnvironment As Boolean
Get Get
If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False 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 Get
End Property End Property
@@ -78,7 +78,7 @@
''' </summary> ''' </summary>
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Dim VersionString = Version.ToString 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 Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")," & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
End Function End Function
@@ -87,7 +87,7 @@
''' 输入 javaw.exe 文件所在文件夹的路径,不限制结尾。 ''' 输入 javaw.exe 文件所在文件夹的路径,不限制结尾。
''' </summary> ''' </summary>
Public Sub New(Folder As String, IsUserImport As Boolean) Public Sub New(Folder As String, IsUserImport As Boolean)
If Not Folder.EndsWith("\") Then Folder += "\" If Not Folder.EndsWithF("\") Then Folder += "\"
PathFolder = Folder.Replace("/", "\") PathFolder = Folder.Replace("/", "\")
Me.IsUserImport = IsUserImport Me.IsUserImport = IsUserImport
End Sub End Sub
@@ -116,8 +116,9 @@
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试") 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 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 Do While VersionString.Split(".").Count < 4
If VersionString.StartsWith("1.") Then If VersionString.StartsWithF("1.") Then
VersionString = VersionString & ".0" VersionString = VersionString & ".0"
Else Else
VersionString = "1." & VersionString VersionString = "1." & VersionString
@@ -184,7 +185,7 @@
JavaList.Add(JavaEntry.FromJson(JsonEntry)) JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next Next
End If End If
If JavaList.Count = 0 Then If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer) Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
JavaSearchLoader.Start(0) JavaSearchLoader.Start(0)
Else Else
@@ -232,7 +233,7 @@
Dim UserJava As JavaEntry = Nothing Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java '获取版本独立设置中指定的 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 Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion))) UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
UserJava.Check() UserJava.Check()
@@ -291,7 +292,7 @@ RetryGet:
Next Next
'若未找到适合的 Java,尝试触发搜索 '若未找到适合的 Java,尝试触发搜索
If AllowedJavaList.Count = 0 AndAlso JavaSearchLoader.State = LoadState.Waiting Then If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
Log("[Java] 未找到满足条件的 Java,尝试进行搜索") Log("[Java] 未找到满足条件的 Java,尝试进行搜索")
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet GoTo RetryGet
@@ -352,7 +353,7 @@ ExitUserJavaCheck:
#End Region #End Region
'若依然未找到适合的 Java,直接返回 '若依然未找到适合的 Java,直接返回
If AllowedJavaList.Count = 0 Then Return Nothing If Not AllowedJavaList.Any() Then Return Nothing
'优先使用特定目录下的 Java '优先使用特定目录下的 Java
For Each Java In AllowedJavaList For Each Java In AllowedJavaList
@@ -445,11 +446,11 @@ NoUserJava:
Dim ProgramPathParent As String, MinecraftPathParent As String = "" Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).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 Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Right.PathFolder.StartsWith(ProgramPathParent) Then Return False If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then If PathMcFolder <> "" Then
If Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWith(MinecraftPathParent) Then Return True If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Right.PathFolder.StartsWith(MinecraftPathParent) Then Return False If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If End If
'2. 尽量使用 64 位 '2. 尽量使用 64 位
If Left.Is64Bit AndAlso Not Right.Is64Bit Then Return True 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 If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本 '4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then 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} 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) Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If End If
@@ -500,7 +501,7 @@ NoUserJava:
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";") For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
PathInEnv = PathInEnv.Trim(" """.ToCharArray()) PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If PathInEnv = "" Then Continue For 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 If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
Next Next
@@ -652,7 +653,7 @@ Wait:
'确认目录存在 '确认目录存在
If Not OriginalPath.Exists Then Exit Sub If Not OriginalPath.Exists Then Exit Sub
Dim Path As String = OriginalPath.FullName.Replace("\\", "\") Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWith("\") Then Path += "\" If Not Path.EndsWithF("\") Then Path += "\"
'若该目录有 Java,则加入结果 '若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹 '查找其下的所有文件夹
@@ -715,7 +716,7 @@ Wait:
End Function End Function
''' <summary> ''' <summary>
''' 获取下载 Java 8/14/17 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。 ''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary> ''' </summary>
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer) Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
Return New LoaderCombo(Of Integer)($"下载 Java {Version}", { 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 MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新) 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))) 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") Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}") Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
'获取文件列表 '获取文件列表
@@ -143,7 +143,7 @@ Public Module ModLaunch
Catch ex As Exception Catch ex As Exception
Dim CurrentEx = ex Dim CurrentEx = ex
NextInner: 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, "启动失败", "导出启动脚本失败")) If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
@@ -752,7 +752,7 @@ LoginFinish:
End Select End Select
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!") Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
ElseIf ex.Message.StartsWith("$") Then ElseIf ex.Message.StartsWithF("$") Then
Throw Throw
Else Else
Throw New Exception("登录失败:" & ex.Message, ex) Throw New Exception("登录失败:" & ex.Message, ex)
@@ -990,13 +990,13 @@ SystemBrowser:
Case 1 Case 1
'Steve 'Steve
Do Until McSkinSex(Uuid) = "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") Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop Loop
Case 2 Case 2
'Alex 'Alex
Do Until McSkinSex(Uuid) = "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") Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop Loop
Case 3 Case 3
@@ -1013,7 +1013,7 @@ SystemBrowser:
Case 4 Case 4
'自定义 '自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve") 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") Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop Loop
End Select End Select
@@ -1057,7 +1057,12 @@ SystemBrowser:
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999) Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'MC 大版本检测 '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 (McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
'1.18 pre2+:至少 Java 17 '1.18 pre2+:至少 Java 17
MinVer = New Version(1, 17, 0, 0) MinVer = New Version(1, 17, 0, 0)
@@ -1140,7 +1145,10 @@ SystemBrowser:
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
McLaunchLog("无合适的 Java,需要确认是否自动下载") McLaunchLog("无合适的 Java,需要确认是否自动下载")
Dim JavaCode As String 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 JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then ElseIf MaxVer < New Version(1, 8, 0, 0) Then
@@ -1394,9 +1402,9 @@ NextVersion:
Dim DeDuplicateDataList As New List(Of String) Dim DeDuplicateDataList As New List(Of String)
For i = 0 To DataList.Count - 1 For i = 0 To DataList.Count - 1
Dim CurrentEntry As String = DataList(i) Dim CurrentEntry As String = DataList(i)
If DataList(i).StartsWith("-") Then If DataList(i).StartsWithF("-") Then
Do While i < DataList.Count - 1 Do While i < DataList.Count - 1
If DataList(i + 1).StartsWith("-") Then If DataList(i + 1).StartsWithF("-") Then
Exit Do Exit Do
Else Else
i += 1 i += 1
@@ -1487,9 +1495,9 @@ NextVersion:
Dim DeDuplicateDataList As New List(Of String) Dim DeDuplicateDataList As New List(Of String)
For i = 0 To DataList.Count - 1 For i = 0 To DataList.Count - 1
Dim CurrentEntry As String = DataList(i) Dim CurrentEntry As String = DataList(i)
If DataList(i).StartsWith("-") Then If DataList(i).StartsWithF("-") Then
Do While i < DataList.Count - 1 Do While i < DataList.Count - 1
If DataList(i + 1).StartsWith("-") Then If DataList(i + 1).StartsWithF("-") Then
Exit Do Exit Do
Else Else
i += 1 i += 1
@@ -1595,7 +1603,7 @@ NextVersion:
End Try End Try
For Each Entry In Zip.Entries For Each Entry In Zip.Entries
Dim FileName As String = Entry.FullName Dim FileName As String = Entry.FullName
If FileName.EndsWith(".dll") Then If FileName.EndsWithF(".dll", True) Then
'实际解压文件的步骤 '实际解压文件的步骤
Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName
ExistFiles.Add(FilePath) ExistFiles.Add(FilePath)
@@ -65,7 +65,7 @@
'格式:TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径 '格式:TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径
For Each Folder As String In Setup.Get("LaunchFolders").Split("|") For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
If Folder = "" Then Continue For 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) Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Critical)
Continue For Continue For
End If End If
@@ -92,13 +92,13 @@
For Each Folder As McFolder In CacheMcFolderList For Each Folder As McFolder In CacheMcFolderList
If Not Folder.Type = McFolderType.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Path) If Not Folder.Type = McFolderType.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Path)
Next 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, "|")) Setup.Set("LaunchFolders", Join(NewSetup, "|"))
#End Region #End Region
'若没有可用文件夹,则创建 .minecraft '若没有可用文件夹,则创建 .minecraft
If CacheMcFolderList.Count = 0 Then If Not CacheMcFolderList.Any() Then
Directory.CreateDirectory(Path & ".minecraft\versions\") Directory.CreateDirectory(Path & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path & ".minecraft\", .Type = McFolderType.Original}) CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path & ".minecraft\", .Type = McFolderType.Original})
End If End If
@@ -149,7 +149,7 @@
#Region "版本处理" #Region "版本处理"
Public Const McVersionCacheVersion As Integer = 26 Public Const McVersionCacheVersion As Integer = 27
Private _McVersionCurrent As McVersion Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化 Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -418,7 +418,7 @@
End Try End Try
VersionSearchFinish: VersionSearchFinish:
'获取版本号 '获取版本号
If _Version.McName.StartsWith("1.") Then If _Version.McName.StartsWithF("1.") Then
Dim SplitVersion = _Version.McName.Split(" "c, "_"c, "-"c, "."c) Dim SplitVersion = _Version.McName.Split(" "c, "_"c, "-"c, "."c)
Dim SplitResult As String Dim SplitResult As String
'分割获取信息 '分割获取信息
@@ -546,8 +546,8 @@ Recheck:
'处理 JumpLoader '处理 JumpLoader
If Text.Contains("minecraftforge") AndAlso File.Exists(PathIndie & "config\jumploader.json") Then If Text.Contains("minecraftforge") AndAlso File.Exists(PathIndie & "config\jumploader.json") Then
For Each ModFile In Directory.EnumerateFiles(PathIndie & "mods") For Each ModFile In Directory.EnumerateFiles(PathIndie & "mods")
Dim FileName As String = GetFileNameFromPath(ModFile).ToLower Dim FileName As String = GetFileNameFromPath(ModFile)
If FileName.EndsWith(".jar") AndAlso FileName.Contains("jumploader") Then If FileName.EndsWithF(".jar", True) AndAlso FileName.ContainsF("jumploader", True) Then
Log("[Minecraft] 发现 JumpLoader 分支项:" & FileName) Log("[Minecraft] 发现 JumpLoader 分支项:" & FileName)
HasJumpLoader = True HasJumpLoader = True
Exit For Exit For
@@ -612,7 +612,7 @@ Recheck:
Public Sub New(Path As String) Public Sub New(Path As String)
Me.Path = If(Path.Contains(":"), "", PathMcFolder & "versions\") & '补全完整路径 Me.Path = If(Path.Contains(":"), "", PathMcFolder & "versions\") & '补全完整路径
Path & Path &
If(Path.EndsWith("\"), "", "\") '补全右划线 If(Path.EndsWithF("\"), "", "\") '补全右划线
End Sub End Sub
''' <summary> ''' <summary>
@@ -684,7 +684,7 @@ Recheck:
'愚人节与快照版本 '愚人节与快照版本
If If(JsonObject("type"), "").ToString = "fool" OrElse GetMcFoolName(Version.McName) <> "" Then If If(JsonObject("type"), "").ToString = "fool" OrElse GetMcFoolName(Version.McName) <> "" Then
State = McVersionState.Fool 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 State = McVersionState.Snapshot
End If End If
'OptiFine 'OptiFine
@@ -744,9 +744,9 @@ ExitDataLoad:
If CustomInfo = "" Then If CustomInfo = "" Then
Select Case State Select Case State
Case McVersionState.Snapshot Case McVersionState.Snapshot
If Version.McName.ToLower.Contains("pre") Then If Version.McName.ContainsF("pre", True) Then
Info = "预发布版 " & Version.McName Info = "预发布版 " & Version.McName
ElseIf Version.McName.ToLower.Contains("rc") Then ElseIf Version.McName.ContainsF("rc", True) Then
Info = "发布候选 " & Version.McName Info = "发布候选 " & Version.McName
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
Info = "实验性快照" Info = "实验性快照"
@@ -948,8 +948,8 @@ ExitDataLoad:
(Asc(CType(Left(OptiFineVersion.ToUpper, 1), Char)) - Asc("A"c) + 1) * 10000 + '第二段:字母编号(2 位),如 G2 中的 G(7) (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 Val(RegexSeek(Right(OptiFineVersion, OptiFineVersion.Length - 1), "[0-9]+")) * 100 '第三段:末尾数字(2 位),如 C5 beta4 中的 5
'第三段:测试标记 '第三段:测试标记
If OptiFineVersion.ToLower.Contains("pre") Then _SortCode += 50 If OptiFineVersion.ContainsF("pre", True) Then _SortCode += 50
If OptiFineVersion.ToLower.Contains("pre") OrElse OptiFineVersion.ToLower.Contains("beta") Then If OptiFineVersion.ContainsF("pre", True) OrElse OptiFineVersion.ContainsF("beta", True) Then
If Val(Right(OptiFineVersion, 1)) = 0 AndAlso Right(OptiFineVersion, 1) <> "0" Then If Val(Right(OptiFineVersion, 1)) = 0 AndAlso Right(OptiFineVersion, 1) <> "0" Then
_SortCode += 1 '为 pre 或 beta 结尾,视作 1 _SortCode += 1 '为 pre 或 beta 结尾,视作 1
Else Else
@@ -981,9 +981,9 @@ ExitDataLoad:
''' </summary> ''' </summary>
Public Function GetMcFoolName(Name As String) As String Public Function GetMcFoolName(Name As String) As String
Name = Name.ToLower Name = Name.ToLower
If Name.StartsWith("2.0") Then If Name.StartsWithF("2.0") Then
Return "这个秘密计划了两年的更新将游戏推向了一个新高度!" Return "这个秘密计划了两年的更新将游戏推向了一个新高度!"
ElseIf Name.StartsWith("20w14inf") OrElse Name = "20w14∞" Then ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!" Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
ElseIf Name = "15w14a" Then ElseIf Name = "15w14a" Then
Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。" Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
@@ -994,7 +994,9 @@ ExitDataLoad:
ElseIf Name = "22w13oneblockatatime" Then ElseIf Name = "22w13oneblockatatime" Then
Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!" Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
ElseIf Name = "23w13a_or_b" Then ElseIf Name = "23w13a_or_b" Then
Return "研究表明玩家喜欢作出选择——越多越好!" Return "研究表明:玩家喜欢作出选择——越多越好!"
ElseIf Name = "24w14potato" Then
Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
Else Else
Return "" Return ""
End If End If
@@ -1018,6 +1020,12 @@ ExitDataLoad:
''' </summary> ''' </summary>
Public McVersionListLoader As New LoaderTask(Of String, Integer)("Minecraft Version List", AddressOf McVersionListLoad) With {.ReloadTimeout = 1} 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> ''' <summary>
''' 开始加载当前 Minecraft 文件夹的版本列表。 ''' 开始加载当前 Minecraft 文件夹的版本列表。
''' </summary> ''' </summary>
@@ -1040,7 +1048,7 @@ ExitDataLoad:
End Try End Try
End If End If
'没有可用版本 '没有可用版本
If FolderList.Count = 0 Then If Not FolderList.Any() Then
WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存 WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存
GoTo OnLoaded GoTo OnLoaded
End If End If
@@ -1062,6 +1070,7 @@ Reload:
WriteIni(Path & "PCL.ini", "VersionCache", FolderListCheck) WriteIni(Path & "PCL.ini", "VersionCache", FolderListCheck)
McVersionList = McVersionListLoadNoCache(Path) McVersionList = McVersionListLoadNoCache(Path)
End If End If
IsFirstMcVersionListLoad = False
If Loader.IsAborted Then Exit Sub 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(":") For Each Folder As String In ReadIni(Path & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
If Folder = "" Then Continue For If Folder = "" Then Continue For
If File.Exists(Path & "versions\" & Folder & "\.pclignore") Then Dim VersionFolder As String = $"{Path}versions\{Folder}\"
Log("[Minecraft] 跳过要求忽略的项目:" & 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 Continue For
End If End If
End If
Try Try
'读取单个版本 '读取单个版本
Dim Version As New McVersion(Path & "versions\" & Folder & "\") Dim Version As New McVersion(VersionFolder)
VersionList.Add(Version) VersionList.Add(Version)
Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "CustomInfo", "") Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "CustomInfo", "")
If Version.Info = "" Then Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "Info", Version.Info) If Version.Info = "" Then Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "Info", Version.Info)
@@ -1193,11 +1208,17 @@ OnLoaded:
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName) Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName)
Continue For Continue For
End If End If
If File.Exists(Folder.FullName & "\.pclignore") Then Dim VersionFolder As String = Folder.FullName & "\"
Log("[Minecraft] 跳过要求忽略的项目:" & 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 Continue For
End If End If
Dim Version As New McVersion(Folder.FullName & "\") End If
Dim Version As New McVersion(VersionFolder)
VersionList.Add(Version) VersionList.Add(Version)
Version.Load() Version.Load()
Next Next
@@ -1494,7 +1515,7 @@ NextVersion:
''' </summary> ''' </summary>
Public Function McSkinGetAddress(Uuid As String, Type As String) As String Public Function McSkinGetAddress(Uuid As String, Type As String) As String
If Uuid = "" Then Throw New Exception("Uuid 为空。") 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) Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
If Not CacheSkinAddress = "" Then Return CacheSkinAddress If Not CacheSkinAddress = "" Then Return CacheSkinAddress
@@ -1960,7 +1981,7 @@ NextVersion:
'获取 Url 的真实地址 '获取 Url 的真实地址
Urls.Add(Token.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("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 End If
If Token.LocalPath.Contains("transformer-discovery-service") Then If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放 '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 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) CustomMcFolder = If(CustomMcFolder, PathMcFolder)
Dim Splited = Original.Split(":") 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\", "") & McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar" Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
'判断 OptiFine 是否应该使用 installer '判断 OptiFine 是否应该使用 installer
@@ -2250,8 +2267,10 @@ NextVersion:
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0 If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1 If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
End If End If
Dim Lefts = RegexSearch(Left.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+") Left = Left.ToLowerInvariant
Dim Rights = RegexSearch(Right.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+") 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 Dim i As Integer = 0
While True While True
'两边均缺失,感觉是一个东西 '两边均缺失,感觉是一个东西
+270 -188
View File
@@ -48,7 +48,7 @@ Public Module ModMod
Load() Load()
If Not IsFileAvailable Then If Not IsFileAvailable Then
Return McModState.Unavaliable 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 Return McModState.Disabled
Else Else
Return McModState.Fine Return McModState.Fine
@@ -76,7 +76,7 @@ Public Module ModMod
Return _Name Return _Name
End Get End Get
Set(value As String) 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 value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value _Name = value
End If End If
@@ -113,12 +113,12 @@ Public Module ModMod
Return _Version Return _Version
End Get End Get
Set(value As String) Set(value As String)
If _Version IsNot Nothing AndAlso (_Version.Contains(".") OrElse _Version.Contains("-")) Then Exit Property If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value IsNot Nothing AndAlso value.ToLower.Contains("version") Then value = "version" '需要修改的标识 If value?.ContainsF("version", True) Then value = "version" '需要修改的标识
_Version = value _Version = value
End Set End Set
End Property End Property
Private _Version As String = Nothing Public _Version As String = Nothing
''' <summary> ''' <summary>
''' 用于依赖检查的 ModID。 ''' 用于依赖检查的 ModID。
@@ -129,12 +129,12 @@ Public Module ModMod
Return _ModId Return _ModId
End Get End Get
Set(value As String) Set(value As String)
If value Is Nothing Then Exit Property If value Is Nothing Then Return
value = RegexSeek(value.ToLower, "[0-9a-z_-]+") value = RegexSeek(value, "[0-9a-zA-Z_-]+")
If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then 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 Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
If _ModId Is Nothing Then _ModId = value If _ModId Is Nothing Then _ModId = value
End If
End Set End Set
End Property End Property
Private _ModId As String = Nothing Private _ModId As String = Nothing
@@ -152,7 +152,7 @@ Public Module ModMod
Return _Url Return _Url
End Get End Get
Set(value As String) 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 _Url = value
End If End If
End Set 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 If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing VersionRequirement = Nothing
Else 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 End If
'向依赖项中添加 '向依赖项中添加
If _Dependencies.ContainsKey(ModID) Then If _Dependencies.ContainsKey(ModID) Then
@@ -270,7 +270,6 @@ Public Module ModMod
_Dependencies = New Dictionary(Of String, String) _Dependencies = New Dictionary(Of String, String)
IsLoaded = False IsLoaded = False
_FileUnavailableReason = Nothing _FileUnavailableReason = Nothing
IsInfoWithoutClassAvailable = False
IsInfoWithClassLoaded = False IsInfoWithClassLoaded = False
IsInfoWithClassAvailable = False IsInfoWithClassAvailable = False
End Sub End Sub
@@ -284,15 +283,12 @@ Public Module ModMod
Init() Init()
Dim Jar As ZipArchive = Nothing Dim Jar As ZipArchive = Nothing
Try Try
'阶段 1:基础可用性检查、打开 Jar 文件 '基础可用性检查、打开 Jar 文件
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")") If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")")
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")") If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open)) Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
If Jar.Entries.Count = 0 Then Throw New FileFormatException("文件内容为空") '信息获取
'阶段 2:信息获取 LookupMetadata(Jar)
LoadWithoutClass(Jar)
'阶段 3: Class 信息获取
If Not IsInfoWithoutClassAvailable Then LoadWithClass(Jar)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer) Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex) _FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
@@ -307,9 +303,9 @@ Public Module ModMod
End Sub End Sub
''' <summary> ''' <summary>
''' 进行不使用 .class 文件的信息获取。 ''' 从 jar 文件中获取 Mod 信息。
''' </summary> ''' </summary>
Private Sub LoadWithoutClass(Jar As ZipArchive) Private Sub LookupMetadata(Jar As ZipArchive)
#Region "尝试使用 mcmod.info" #Region "尝试使用 mcmod.info"
Try Try
@@ -347,7 +343,7 @@ Public Module ModMod
If Reqs IsNot Nothing Then If Reqs IsNot Nothing Then
For Each Token As String In Reqs For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOf(":") + 1) Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1)) AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else Else
@@ -360,7 +356,7 @@ Public Module ModMod
If Reqs IsNot Nothing Then If Reqs IsNot Nothing Then
For Each Token As String In Reqs For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOf(":") + 1) Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1)) AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else Else
@@ -407,8 +403,8 @@ GotFabric:
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "") ' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then ' If Deps <> "" Then
' For Each Dep In Deps.Split(";") ' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For ' If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOf(":") + 1) ' Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
' If Dep.Contains("@") Then ' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1)) ' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else ' Else
@@ -436,10 +432,10 @@ GotFabric:
'文件标准化:统一换行符为 vbLf,去除注释、头尾的空格、空行 '文件标准化:统一换行符为 vbLf,去除注释、头尾的空格、空行
Dim Lines As New List(Of String) Dim Lines As New List(Of String)
For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符 For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符
If Line.StartsWith("#") Then '去除注释 If Line.StartsWithF("#") Then '去除注释
Continue For Continue For
ElseIf Line.Contains("#") Then ElseIf Line.Contains("#") Then
Line = Line.Substring(0, Line.IndexOf("#")) Line = Line.Substring(0, Line.IndexOfF("#"))
End If End If
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格 Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
If Line.Count > 0 Then Lines.Add(Line) '去除空行 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))} 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 For i = 0 To Lines.Count - 1
Dim Line As String = Lines(i) 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) Dim Header = Line.Trim("[]".ToCharArray)
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object))) TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
ElseIf Line.Contains("=") Then ElseIf Line.Contains("=") Then
'字段标记 '字段标记
Dim Key As String = Line.Substring(0, Line.IndexOf("=")).TrimEnd(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.IndexOf("=") + 1).TrimStart(New Char() {" "c, " "c, " "c}) Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
Dim Value As Object Dim Value As Object
If RawValue.StartsWith("""") AndAlso RawValue.EndsWith("""") Then If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
'单行字符串 '单行字符串
Value = RawValue.Trim("""") Value = RawValue.Trim("""")
ElseIf RawValue.StartsWith("'''") Then ElseIf RawValue.StartsWithF("'''") Then
'多行字符串 '多行字符串
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")} 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("'") ValueLines(0) = ValueLines(0).TrimEnd("'")
Else Else
Do Until i >= Lines.Count - 1 Do Until i >= Lines.Count - 1
i += 1 i += 1
Dim ValueLine As String = Lines(i) Dim ValueLine As String = Lines(i)
If ValueLine.EndsWith("'''") Then If ValueLine.EndsWithF("'''") Then
ValueLines.Add(ValueLine.TrimEnd("'")) ValueLines.Add(ValueLine.TrimEnd("'"))
Exit Do Exit Do
Else Else
@@ -575,8 +571,8 @@ Got:
Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "") Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
If Deps <> "" Then If Deps <> "" Then
For Each Dep In Deps.Split(";") For Each Dep In Deps.Split(";")
If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOf(":") + 1) Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
If Dep.Contains("@") Then If Dep.Contains("@") Then
AddDependency(Dep.Split("@")(0), Dep.Split("@")(1)) AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
Else Else
@@ -597,7 +593,7 @@ Finished:
If MetaEntry IsNot Nothing Then If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":") Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then 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 MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
Version = MetaString Version = MetaString
End If End If
@@ -610,97 +606,17 @@ Finished:
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region #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 Sub
#End Region #End Region
#Region "网络信息" #Region "网络信息"
''' <summary>
''' 当任何网络信息更新时触发。
''' </summary>
Public Event OnCompUpdate(sender As McMod)
''' <summary> ''' <summary>
''' 该 Mod 关联的网络项目。 ''' 该 Mod 关联的网络项目。
''' </summary> ''' </summary>
@@ -710,12 +626,70 @@ VersionFindFail:
End Get End Get
Set(value As CompProject) Set(value As CompProject)
_Comp = value _Comp = value
RaiseEvent OnGetCompProject(Me) RaiseEvent OnCompUpdate(Me)
End Set End Set
End Property End Property
Private _Comp As CompProject 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> ''' <summary>
''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。 ''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。
@@ -723,6 +697,14 @@ VersionFindFail:
Public ReadOnly Property CurseForgeHash As UInteger Public ReadOnly Property CurseForgeHash As UInteger
Get Get
If _CurseForgeHash Is Nothing Then 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) Dim data As New List(Of Byte)
For Each b As Byte In File.ReadAllBytes(Path) For Each b As Byte In File.ReadAllBytes(Path)
@@ -757,6 +739,8 @@ VersionFindFail:
h = (h * &H5BD1E995L) And &HFFFFFFFFL h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor (h >> 15) h = h Xor (h >> 15)
_CurseForgeHash = h _CurseForgeHash = h
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
End If End If
Return _CurseForgeHash Return _CurseForgeHash
End Get End Get
@@ -769,7 +753,18 @@ VersionFindFail:
Public ReadOnly Property ModrinthHash As String Public ReadOnly Property ModrinthHash As String
Get Get
If _ModrinthHash Is Nothing Then 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) _ModrinthHash = GetFileSHA1(Path)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If End If
Return _ModrinthHash Return _ModrinthHash
End Get End Get
@@ -794,7 +789,7 @@ VersionFindFail:
''' 是否可能为前置 Mod。 ''' 是否可能为前置 Mod。
''' </summary> ''' </summary>
Public Function IsPresetMod() As Boolean 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 End Function
''' <summary> ''' <summary>
@@ -803,9 +798,9 @@ VersionFindFail:
Public Shared Function IsModFile(Path As String) Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower Path = Path.ToLower
If Path.EndsWith(".jar") OrElse Path.EndsWith(".zip") OrElse Path.EndsWith(".litemod") OrElse If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") OrElse Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
Path.EndsWith(".jar.old") OrElse Path.EndsWith(".zip.old") OrElse Path.EndsWith(".litemod.old") Then Return True Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
Return False Return False
End Function End Function
@@ -817,6 +812,20 @@ VersionFindFail:
Try Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False) 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 文件夹下的可用文件列表 '获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo) Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then If Directory.Exists(Loader.Input) Then
@@ -846,7 +855,7 @@ VersionFindFail:
If CacheContent <> "" Then If CacheContent <> "" Then
Cache = GetJson(CacheContent) Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息") Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
Cache = New JObject Cache = New JObject
End If End If
End If End If
@@ -859,7 +868,7 @@ VersionFindFail:
Dim ModList As New List(Of McMod) Dim ModList As New List(Of McMod)
Dim ModUpdateList As New List(Of McMod) Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList 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 If Loader.IsAborted Then Exit Sub
'加载 McMod 对象 '加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName) Dim ModEntry As New McMod(ModFile.FullName)
@@ -880,10 +889,9 @@ VersionFindFail:
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
Dim Hash = ModEntry.ModrinthHash Dim Hash = ModEntry.ModrinthHash
If Cache.ContainsKey(Hash) Then If Cache.ContainsKey(Hash) Then
ModEntry.Comp = New CompProject(Cache(Hash)) ModEntry.FromJson(Cache(Hash))
ModEntry.IsCompFromModrinth = Not ModEntry.Comp.FromCurseForge
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取 '如果缓存中的信息在 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 End If
ModUpdateList.Add(ModEntry) ModUpdateList.Add(ModEntry)
Next Next
@@ -906,10 +914,10 @@ VersionFindFail:
'开始联网加载 '开始联网加载
If ModUpdateList.Any() Then If ModUpdateList.Any() Then
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True) McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
End If End If
Loader.Progress = 1
Catch ex As Exception Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug) Log(ex, "Mod 列表加载失败", LogLevel.Debug)
Throw Throw
@@ -917,29 +925,31 @@ VersionFindFail:
End Sub End Sub
'联网加载 Mod 详情 '联网加载 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) 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)) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Cache As JObject = Loader.Input.Value Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本 '获取作为检查目标的加载器和版本
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders As New List(Of String) Dim ModLoaders As New List(Of CompModLoaderType)
If TargetMcVersion.HasForge Then ModLoaders.Add("forge") If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If TargetMcVersion.HasFabric Then ModLoaders.Add("fabric") If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add("liteloader") If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({"forge", "fabric", "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} Dim McVersions As New List(Of String) From {TargetMcVersion.McName}
If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then '暂不向下扩展检查的 MC 小版本
McVersions.Add($"1.{TargetMcVersion.McCodeMain}") '例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
For i = 1 To TargetMcVersion.McCodeSub 'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}") ' McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
Next ' For i = 1 To TargetMcVersion.McCodeSub
End If ' McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
McVersions = McVersions.Distinct().ToList() ' Next
'End If
'McVersions = McVersions.Distinct().ToList()
'开始网络获取 '开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersions.Join("/")}") 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 Dim MainThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息 '从 Modrinth 获取信息
RunInNewThread( RunInNewThread(
@@ -947,25 +957,24 @@ VersionFindFail:
Try Try
'步骤 1:获取 Hash 与对应的工程 ID '步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST", Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
""loaders"": [""{ModLoaders.Join(""",""")}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject) Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
Log($"[Mod] 从 Modrinth 获取到 {ModrinthUpdate.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 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)) Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each ModEntity In Mods For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(ModEntity.ModrinthHash) Then Continue For If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
Dim ProjectId = ModrinthUpdate(ModEntity.ModrinthHash)("project_id").ToString Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) Then If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
ModEntity.Comp = CompProjectCache(ProjectId)
Else
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod) If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(ModEntity) ModrinthMapping(ProjectId).Add(Entry)
End If '记录对应的 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 Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 类本地 Mod 的工程信息") Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry( Dim ModrinthProject = CType(GetJson(NetRequestRetry(
@@ -974,18 +983,37 @@ VersionFindFail:
For Each ProjectJson In ModrinthProject For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson) Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id) For Each Entry In ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 加载不出来
End If
Entry.IsCompFromModrinth = True
Entry.Comp = Project Entry.Comp = Project
Next Next
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 信息结束") Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
SucceedThreadCount += 1
Catch ex As Exception Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败") Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
Finally Finally
CompletedThread += 1 EndedThreadCount += 1
End Try End Try
End Sub, "Mod List Detail Loader Modrinth") End Sub, "Mod List Detail Loader Modrinth")
'从 CurseForge 获取信息 '从 CurseForge 获取信息
@@ -994,57 +1022,110 @@ VersionFindFail:
Try Try
'步骤 1:获取 Hash 与对应的工程 ID '步骤 1:获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger) Dim CurseForgeHashes As New List(Of UInteger)
For Each ModEntity In Mods For Each Entry In Mods
CurseForgeHashes.Add(ModEntity.CurseForgeHash) CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST", Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 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)) Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint") Dim Hash As UInteger = Project("file")("fileFingerprint")
For Each Entry In Mods For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For If Entry.CurseForgeHash <> Hash Then Continue For
If CompProjectCache.ContainsKey(ProjectId) Then If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
Entry.Comp = CompProjectCache(ProjectId)
Else
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod) If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry) CurseForgeMapping(ProjectId).Add(Entry)
End If '记录对应的 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
Next Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""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 For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson) Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏 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.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件 Entry.Comp = Entry.Comp '再次触发修改事件
Continue For Continue For
End If End If
Entry.IsCompFromModrinth = False
Entry.Comp = Project Entry.Comp = Project
Next 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 Next
Log($"[Mod] 从 CurseForge 获取本地 Mod 信息结束") 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 信息,需要获取 {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 Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败") Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
Finally Finally
CompletedThread += 1 EndedThreadCount += 1
End Try End Try
End Sub, "Mod List Detail Loader CurseForge") End Sub, "Mod List Detail Loader CurseForge")
'等待线程结束 '等待线程结束
Do Until CompletedThread = 2 Do Until EndedThreadCount = 2
If Loader.IsAborted Then Exit Sub If Loader.IsAborted Then Exit Sub
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
@@ -1052,8 +1133,9 @@ VersionFindFail:
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList() Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存") Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub If Not Mods.Any() Then Exit Sub
For Each ModEntity In Mods For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Cache(ModEntity.ModrinthHash) = ModEntity.Comp.ToJson() Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
End Sub End Sub
@@ -1106,8 +1188,8 @@ VersionFindFail:
If Dependency.Value IsNot Nothing Then If Dependency.Value IsNot Nothing Then
'获取分段后的详细版本信息 '获取分段后的详细版本信息
Dim ReqVersion As String = Dependency.Value Dim ReqVersion As String = Dependency.Value
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWith("[") Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWith("]") Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
Dim ReqVersionHead As String Dim ReqVersionHead As String
Dim ReqVersionTail As String Dim ReqVersionTail As String
If ReqVersion.Contains(",") Then If ReqVersion.Contains(",") Then
@@ -1121,8 +1203,8 @@ VersionFindFail:
ReqVersionTailCanEqual = False ReqVersionTailCanEqual = False
End If End If
End If End If
If ReqVersionHead.StartsWith("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOf("-") + 1) If ReqVersionHead.StartsWithF("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOfF("-") + 1)
If ReqVersionTail.StartsWith("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOf("-") + 1) If ReqVersionTail.StartsWithF("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOfF("-") + 1)
'获取报错描述文本 '获取报错描述文本
Dim VersionRequire As String Dim VersionRequire As String
If ReqVersionHead = ReqVersionTail Then If ReqVersionHead = ReqVersionTail Then
@@ -1150,7 +1232,7 @@ VersionFindFail:
Continue For Continue For
End If End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0") 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 头部版本 '对比前置 Mod 头部版本
If ReqVersionHead.Contains(".") Then If ReqVersionHead.Contains(".") Then
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
@@ -1179,7 +1261,7 @@ VersionFindFail:
Log(ex, "检查 Mod 时出错") Log(ex, "检查 Mod 时出错")
End Try End Try
Next Next
If Result.Count = 0 Then If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常") Log("[Minecraft] Mod 检查未发现异常")
Else Else
Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf)) Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
@@ -40,7 +40,7 @@ Public Module ModModpack
For Each Entry In Archive.Entries For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/") Dim FullNames As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/" 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 If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件 '判断是否为关键文件
@@ -61,7 +61,7 @@ Public Module ModModpack
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False 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)) Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return False
Else Else
@@ -186,7 +186,7 @@ Retry:
Dim FabricVersion As String = Nothing Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {}) For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower Dim Id As String = If(Entry("id"), "").ToString.ToLower
If Id.StartsWith("forge-") Then If Id.StartsWithF("forge-") Then
'Forge 指定 'Forge 指定
If Id.Contains("recommended") Then If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint) Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
@@ -199,7 +199,7 @@ Retry:
Catch ex As Exception Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id) Log(ex, "读取整合包 Forge 版本失败:" & Id)
End Try End Try
ElseIf Id.StartsWith("fabric-") Then ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定 'Fabric 指定
Try Try
Log("[ModPack] 整合包 Fabric 版本:" & Id) Log("[ModPack] 整合包 Fabric 版本:" & Id)
@@ -277,7 +277,7 @@ Retry:
IsResourcePack = IsResourcePack =
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info (Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
(Not File.FileName.EndsWith(".jar")) '文件后缀不是 .jar (Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar
Else Else
IsResourcePack = False IsResourcePack = False
End If End If
@@ -143,7 +143,7 @@
'输出文本 '输出文本
Dim Copyed As New List(Of String) Dim Copyed As New List(Of String)
SyncLock WaitingLogLock SyncLock WaitingLogLock
If WaitingLog.Count = 0 Then Exit Sub If Not WaitingLog.Any() Then Exit Sub
Copyed = WaitingLog Copyed = WaitingLog
WaitingLog = New List(Of String)(1000) WaitingLog = New List(Of String)(1000)
End SyncLock End SyncLock
@@ -192,7 +192,7 @@
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+ WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+
LogProgress = 2 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 版本已确认") WatcherLog("日志 3/5:LWJGL 版本已确认")
LogProgress = 3 LogProgress = 3
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then 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 If MinecraftWindow Is Nothing Then Exit Sub
Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
'已找到窗口 '已找到窗口
If Not MinecraftWindowName.StartsWith("FML") Then If Not MinecraftWindowName.StartsWithF("FML") Then
'已找到 Minecraft 窗口 '已找到 Minecraft 窗口
WindowHandle = MinecraftWindowHandle WindowHandle = MinecraftWindowHandle
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})") WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
@@ -317,7 +317,7 @@
Dim WindowText As String = str.ToString Dim WindowText As String = str.ToString
'有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确 '有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确
'部分版本会搞个 GLFW message window 出来所以得反选 '部分版本会搞个 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 Dim ProcessId As Integer
GetWindowThreadProcessId(hwnd, ProcessId) GetWindowThreadProcessId(hwnd, ProcessId)
@@ -14,11 +14,11 @@
_Logo = value _Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try Try
If _Logo.ToLower.StartsWith("http") Then If _Logo.StartsWithF("http", True) Then
'网络图片 '网络图片
If File.Exists(FileAddress) Then If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress) 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}") Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png") PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else Else
@@ -1,6 +1,7 @@
<Grid x:Class="MyLocalModItem" <Grid x:Class="MyLocalModItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL;assembly="
x:Name="PanBack" Height="44" x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True"> RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -27,10 +28,26 @@
</Border> </Border>
<!-- 标题 --> <!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal" <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"> SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" /> <TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" /> <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> </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 与 详情 --> <!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False"> <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"> <!--<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 _Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try Try
If _Logo.ToLower.StartsWith("http") Then If _Logo.StartsWithF("http", True) Then
'网络图片 '网络图片
If File.Exists(FileAddress) Then If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress) 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}") Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png") PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else Else
@@ -190,6 +190,39 @@ RetryStart:
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub 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 Check(sender As Object, e As RouteEventArgs)
Public Event Changed(sender As Object, e As RouteEventArgs) Public Event Changed(sender As Object, e As RouteEventArgs)
@@ -201,10 +234,10 @@ RetryStart:
Set(value As Boolean) Set(value As Boolean)
Try Try
'触发属性值修改 '触发属性值修改
Dim ChangedEventArgs As New RouteEventArgs(False)
Dim RawValue = _Checked Dim RawValue = _Checked
If value = _Checked Then Exit Property If value = _Checked Then Exit Property
_Checked = value _Checked = value
Dim ChangedEventArgs As New RouteEventArgs(False)
If IsInitialized Then If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs) RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then If ChangedEventArgs.Handled Then
@@ -310,7 +343,7 @@ RetryStart:
Children.Remove(ButtonStack) Children.Remove(ButtonStack)
ButtonStack = Nothing ButtonStack = Nothing
End If End If
If value.Count = 0 Then Exit Property If Not value.Any() Then Exit Property
'添加新 Stack '添加新 Stack
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal, 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} .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
@@ -347,6 +380,30 @@ RetryStart:
Public Sub Refresh() Public Sub Refresh()
RunInUi( RunInUi(
Sub() 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 If Entry.Comp Is Nothing Then
Title = Entry.Name Title = Entry.Name
@@ -409,11 +466,7 @@ RetryStart:
End Sub End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
'按钮虚拟化检测 InitLate(sender, e)
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
'触发颜色动画 '触发颜色动画
Dim Time As Integer = If(IsMouseOver, 120, 180) Dim Time As Integer = If(IsMouseOver, 120, 180)
Dim Ani As New List(Of AniData) Dim Ani As New List(Of AniData)
@@ -450,4 +503,34 @@ RetryStart:
AniStart(Ani, "LocalModItem Color " & Uuid) AniStart(Ani, "LocalModItem Color " & Uuid)
End Sub 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 End Class
+4 -4
View File
@@ -13,7 +13,7 @@
Case "打开网页" Case "打开网页"
Data(0) = Data(0).Replace("\", "/") 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 改为 打开文件。", "事件执行失败") MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Exit Sub Exit Sub
End If End If
@@ -78,7 +78,7 @@
Case "下载文件" Case "下载文件"
Data(0) = Data(0).Replace("\", "/") 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 不支持其他乱七八糟的下载协议。", "事件执行失败") MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub Exit Sub
End If End If
@@ -99,7 +99,7 @@
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String() 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 If RunInUi() Then
Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf & Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf &
"因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!") "因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
@@ -108,7 +108,7 @@
Dim RawFileName As String Dim RawFileName As String
Try Try
RawFileName = GetFileNameFromPath(RelativeUrl) 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 Catch ex As Exception
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf & Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
"例如:" & vbCrLf & "例如:" & vbCrLf &
+13 -7
View File
@@ -1,4 +1,6 @@
Public Module ModMusic Imports System.Security.Cryptography
Public Module ModMusic
#Region "播放列表" #Region "播放列表"
@@ -31,7 +33,7 @@
End If End If
'打乱顺序播放 '打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList)) 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.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst) MusicWaitingList.Add(IgnoreFirst)
@@ -45,11 +47,11 @@
''' </summary> ''' </summary>
Private Function DequeueNextMusicAddress() As String 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) DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0) MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress) If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function End Function
#End Region #End Region
@@ -63,7 +65,7 @@
RunInUi(Sub() RunInUi(Sub()
Try Try
If MusicAllList.Count = 0 Then If Not MusicAllList.Any() Then
'无背景音乐 '无背景音乐
FrmMain.BtnExtraMusic.Show = False FrmMain.BtnExtraMusic.Show = False
Else Else
@@ -160,7 +162,7 @@
Try Try
MusicListInit(True) MusicListInit(True)
If MusicAllList.Count = 0 Then If Not MusicAllList.Any() Then
If MusicNAudio Is Nothing Then If MusicNAudio Is Nothing Then
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical) If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical)
Else Else
@@ -267,9 +269,13 @@
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress) If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent) 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 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) 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) Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint) Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.6.15.0")> <Assembly: AssemblyVersion("2.7.0.0")>
<Assembly: AssemblyFileVersion("2.6.15.0")> <Assembly: AssemblyFileVersion("2.7.0.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
@@ -283,7 +283,7 @@ Public Module ModDownloadLib
WikiName = "Java版Combat_Test_8c" WikiName = "Java版Combat_Test_8c"
ElseIf Id = "1.0.0-rc2-2" Then ElseIf Id = "1.0.0-rc2-2" Then
WikiName = "Java版RC2" 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_") 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 ElseIf Id = "b1.9-pre6" Then
WikiName = "Java版Beta_1.9_Prerelease_6" WikiName = "Java版Beta_1.9_Prerelease_6"
@@ -291,19 +291,19 @@ Public Module ModDownloadLib
WikiName = "Java版Beta_1.9_Prerelease" WikiName = "Java版Beta_1.9_Prerelease"
ElseIf VersionJson("type") = "release" OrElse VersionJson("type") = "snapshot" OrElse VersionJson("type") = "special" Then ElseIf VersionJson("type") = "release" OrElse VersionJson("type") = "snapshot" OrElse VersionJson("type") = "special" Then
WikiName = If(Id.Contains("w"), "", "Java版") & Id.Replace(" Pre-Release ", "-pre") 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_") 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") WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("a", "Alpha_v")
ElseIf Id = "inf-20100618" Then ElseIf Id = "inf-20100618" Then
WikiName = "Java版Infdev_20100618" WikiName = "Java版Infdev_20100618"
ElseIf Id = "c0.30_01c" OrElse Id = "c0.30_survival" OrElse Id.Contains("生存测试") Then ElseIf Id = "c0.30_01c" OrElse Id = "c0.30_survival" OrElse Id.Contains("生存测试") Then
WikiName = "Java版Classic_0.30(生存模式)" WikiName = "Java版Classic_0.30(生存模式)"
ElseIf Id.StartsWith("c0.31") Then ElseIf Id.StartsWithF("c0.31") Then
WikiName = "Java版Indev_0.31_20100130" WikiName = "Java版Indev_0.31_20100130"
ElseIf Id.StartsWith("c") Then ElseIf Id.StartsWithF("c") Then
WikiName = "Java版" & Id.Replace("c", "Classic_") WikiName = "Java版" & Id.Replace("c", "Classic_")
ElseIf Id.StartsWith("rd-") Then ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id WikiName = "Java版Pre-classic_" & Id
Else Else
Log("[Error] 未知的版本格式:" & Id & "。", LogLevel.Feedback) Log("[Error] 未知的版本格式:" & Id & "。", LogLevel.Feedback)
@@ -428,7 +428,8 @@ Public Module ModDownloadLib
Dim LastResult As String = "" Dim LastResult As String = ""
Using outputWaitHandle As New AutoResetEvent(False) Using outputWaitHandle As New AutoResetEvent(False)
Using errorWaitHandle As New AutoResetEvent(False) Using errorWaitHandle As New AutoResetEvent(False)
AddHandler process.OutputDataReceived, Function(sender, e) AddHandler process.OutputDataReceived,
Function(sender, e)
Try Try
If e.Data Is Nothing Then If e.Data Is Nothing Then
outputWaitHandle.[Set]() outputWaitHandle.[Set]()
@@ -451,7 +452,8 @@ Public Module ModDownloadLib
End Try End Try
Return Nothing Return Nothing
End Function End Function
AddHandler process.ErrorDataReceived, Function(sender, e) AddHandler process.ErrorDataReceived,
Function(sender, e)
Try Try
If e.Data Is Nothing Then If e.Data Is Nothing Then
errorWaitHandle.[Set]() errorWaitHandle.[Set]()
@@ -1010,7 +1012,7 @@ Retry:
End If End If
Exit Sub Exit Sub
End If 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 & If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。", "若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。",
"版本过老", "继续", "取消") = 1 Then "版本过老", "继续", "取消") = 1 Then
@@ -1214,9 +1216,9 @@ Retry:
End SyncLock End SyncLock
End Sub End Sub
Private Sub ForgeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean)) 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) If ModeDebug Then Log("[Installer] " & Content)
ElseIf Content.StartsWith(" Reading patch ") Then ElseIf Content.StartsWithF(" Reading patch ") Then
If ModeDebug Then Log("[Installer] " & Content) If ModeDebug Then Log("[Installer] " & Content)
Task.Progress = 0.86 Task.Progress = 0.86
Else Else
@@ -1265,7 +1267,7 @@ Retry:
'参数初始化 '参数初始化
McFolder = If(McFolder, PathMcFolder) 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) '类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge)
Inherit = Version.Split("-").First Inherit = Version.Split("-").First
Version = Version.Split("-").Last Version = Version.Split("-").Last
@@ -1345,8 +1347,8 @@ Retry:
Task.Progress = 0.8 Task.Progress = 0.8
'去除其中的原始 Forge 项 '去除其中的原始 Forge 项
For i = 0 To Libs.Count - 1 For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse If Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & "-client.jar") Then
Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug) Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i) Libs.RemoveAt(i)
Exit For Exit For
@@ -1644,7 +1646,7 @@ Retry:
For Each Version As JObject In ResultJson For Each Version As JObject In ResultJson
If Version("name") Is Nothing OrElse Version("build") Is Nothing Then Continue For If Version("name") Is Nothing OrElse Version("build") Is Nothing Then Continue For
Dim Name As String = Version("name") 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" '内容为:"1.15.2":"31.2.0"
RecommendedList.Add("""" & Name.Replace("-recommended", """:""" & Version("build")("version").ToString & """")) RecommendedList.Add("""" & Name.Replace("-recommended", """:""" & Version("build")("version").ToString & """"))
Next Next
@@ -1974,9 +1976,9 @@ Retry:
Request.OptiFineEntry = New DlOptiFineListEntry With { Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"), .NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName, .Inherit = Request.MinecraftName,
.IsPreview = Request.OptiFineVersion.ToLower.Contains("pre"), .IsPreview = Request.OptiFineVersion.ContainsF("pre", True),
.NameVersion = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion, .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" "OptiFine_" & Request.MinecraftName & "_" & Request.OptiFineVersion & ".jar"
} }
End If End If
@@ -2012,7 +2014,7 @@ Retry:
Dim LoaderList As New List(Of LoaderBase) 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 'Fabric API
If Request.FabricApi IsNot Nothing Then 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}) 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 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 Dim OutputJar As String, MinecraftJar As String
#Region "初始化路径信息" #Region "初始化路径信息"
If Not OutputFolder.EndsWith("\") Then OutputFolder += "\" If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\"
OutputName = GetFolderNameFromPath(OutputFolder) OutputName = GetFolderNameFromPath(OutputFolder)
OutputJsonPath = OutputFolder & OutputName & ".json" OutputJsonPath = OutputFolder & OutputName & ".json"
OutputJar = OutputFolder & OutputName & ".jar" OutputJar = OutputFolder & OutputName & ".jar"
If Not MinecraftFolder.EndsWith("\") Then MinecraftFolder += "\" If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\"
MinecraftName = GetFolderNameFromPath(MinecraftFolder) MinecraftName = GetFolderNameFromPath(MinecraftFolder)
MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json" MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json"
MinecraftJar = MinecraftFolder & MinecraftName & ".jar" MinecraftJar = MinecraftFolder & MinecraftName & ".jar"
If HasOptiFine Then If HasOptiFine Then
If Not OptiFineFolder.EndsWith("\") Then OptiFineFolder += "\" If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\"
OptiFineName = GetFolderNameFromPath(OptiFineFolder) OptiFineName = GetFolderNameFromPath(OptiFineFolder)
OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json" OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json"
End If End If
If HasForge Then If HasForge Then
If Not ForgeFolder.EndsWith("\") Then ForgeFolder += "\" If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\"
ForgeName = GetFolderNameFromPath(ForgeFolder) ForgeName = GetFolderNameFromPath(ForgeFolder)
ForgeJsonPath = ForgeFolder & ForgeName & ".json" ForgeJsonPath = ForgeFolder & ForgeName & ".json"
End If End If
If HasLiteLoader Then If HasLiteLoader Then
If Not LiteLoaderFolder.EndsWith("\") Then LiteLoaderFolder += "\" If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\"
LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder) LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder)
LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json" LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json"
End If End If
If HasFabric Then If HasFabric Then
If Not FabricFolder.EndsWith("\") Then FabricFolder += "\" If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\"
FabricName = GetFolderNameFromPath(FabricFolder) FabricName = GetFolderNameFromPath(FabricFolder)
FabricJsonPath = FabricFolder & FabricName & ".json" FabricJsonPath = FabricFolder & FabricName & ".json"
End If 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 Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规" #Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath) 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) MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath) 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) OptiFineJson = GetJson(OptiFineJsonText)
End If End If
If HasForge Then If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath) 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) ForgeJson = GetJson(ForgeJsonText)
End If End If
If HasLiteLoader Then If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath) 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) LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If End If
If HasFabric Then If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath) 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) FabricJson = GetJson(FabricJsonText)
End If End If
#End Region #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 RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String) Dim SplitArguments As New List(Of String)
For i = 0 To RawArguments.Count - 1 For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWith("-") Then If RawArguments(i).StartsWithF("-") Then
SplitArguments.Add(RawArguments(i)) 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) SplitArguments(SplitArguments.Count - 1) = SplitArguments.Last & " " & RawArguments(i)
Else Else
SplitArguments.Add(RawArguments(i)) SplitArguments.Add(RawArguments(i))
@@ -39,7 +39,7 @@
Version("id") = "20w14∞" Version("id") = "20w14∞"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) 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 = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
@@ -77,7 +77,7 @@
PanMain.Children.Add(CardInfo) PanMain.Children.Add(CardInfo)
'添加其他版本 '添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict 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 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} 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() PanMain.Children.Clear()
'转化为 UI '转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict 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 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} 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) For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version) If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
Next Next
If SuitableVersions.Count = 0 Then If Not SuitableVersions.Any() Then
DefaultFolder = PathMcFolder DefaultFolder = PathMcFolder
If NeedLoad Then If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!") Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!")
@@ -523,7 +523,7 @@
Version("id") = "20w14∞" Version("id") = "20w14∞"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) 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 = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
@@ -562,7 +562,7 @@
PanMinecraft.Children.Insert(0, CardInfo) PanMinecraft.Children.Insert(0, CardInfo)
'添加其他版本 '添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict 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 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} 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 SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version) If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version)
Next 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 Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
@@ -724,7 +724,7 @@
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version) If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version)
Next Next
If Versions.Count = 0 Then Exit Sub If Not Versions.Any() Then Exit Sub
'可视化 '可视化
PanLiteLoader.Children.Clear() PanLiteLoader.Children.Clear()
For Each Version In Versions For Each Version In Versions
@@ -804,7 +804,7 @@
'获取要显示的版本 '获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry) Dim Versions As New List(Of DlForgeVersionEntry)
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空 Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
If Loader.Output.Count = 0 Then Exit Sub If Not Loader.Output.Any() Then Exit Sub
PanForge.Children.Clear() PanForge.Children.Clear()
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)). Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
Where(Function(v) Where(Function(v)
@@ -870,7 +870,7 @@
If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub
'获取版本列表 '获取版本列表
Dim Versions As JArray = DlFabricListLoader.Output.Value("loader") 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.Children.Clear()
PanFabric.Tag = Versions PanFabric.Tag = Versions
@@ -983,7 +983,7 @@
Versions.Add(Version) Versions.Add(Version)
End If End If
Next 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) Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化 '可视化
PanFabricApi.Children.Clear() PanFabricApi.Children.Clear()
@@ -1073,7 +1073,7 @@
For Each Version In DlOptiFabricLoader.Output For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version) If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
Next 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) Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化 '可视化
@@ -28,7 +28,7 @@
PanMain.Children.Clear() PanMain.Children.Clear()
'转化为 UI '转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict 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 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} 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() PanMain.Children.Clear()
'转化为 UI '转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict 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 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} 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)) Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) If Not 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 Version = Nothing
Setup.Set("LaunchVersionSelect", "") Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本") Log("[Launch] 无可用 Minecraft 版本")
@@ -258,7 +258,7 @@ Public Class PageLinkIoi
Public Function GetDescription() As String Public Function GetDescription() As String
Return If(Progress < 1, Return If(Progress < 1,
"正在连接," & Math.Round(Progress * 100) & "%", "正在连接," & Math.Round(Progress * 100) & "%",
"已连接," & If(PingRecord.Count = 0, "检查延迟中", Math.Round(PingRecord.Average) & "ms")) "已连接," & If(Not PingRecord.Any(), "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
End Function End Function
Public Function ToListItem() As MyListItem Public Function ToListItem() As MyListItem
Dim Item As New MyListItem With { Dim Item As New MyListItem With {
@@ -149,7 +149,7 @@
'进行搜索,构造列表 '进行搜索,构造列表
Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.08) Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.08)
PanSearchList.Children.Clear() PanSearchList.Children.Clear()
If SearchResult.Count = 0 Then If Not SearchResult.Any() Then
PanSearch.Title = "无搜索结果" PanSearch.Title = "无搜索结果"
PanSearchList.Visibility = Visibility.Collapsed PanSearchList.Visibility = Visibility.Collapsed
Else Else
@@ -129,7 +129,7 @@
Exit Sub Exit Sub
End If End If
Next Next
If McFolderList.Count = 0 Then If Not McFolderList.Any() Then
Throw New ArgumentNullException("没有可用的 Minecraft 文件夹") Throw New ArgumentNullException("没有可用的 Minecraft 文件夹")
Else Else
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$")) Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
@@ -301,7 +301,7 @@
End If End If
Next 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) Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Finish)
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
@@ -325,7 +325,7 @@
Exit For Exit For
End If End If
Next Next
Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|"))) Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
End If End If
RunInNewThread(Sub() RunInNewThread(Sub()
'删除文件夹 '删除文件夹
@@ -229,7 +229,7 @@
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" /> <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" /> 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" /> <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 则会以试玩模式启动游戏。" /> <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() RunInThread(Sub()
Hint("正在搜索 Java!") Hint("正在搜索 Java!")
JavaSearchLoader.WaitForExit(IsForceRestart:=True) JavaSearchLoader.WaitForExit(IsForceRestart:=True)
If JavaList.Count = 0 Then If Not JavaList.Any() Then
Hint("未找到可用的 Java!", HintType.Critical) Hint("未找到可用的 Java!", HintType.Critical)
Else Else
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish) Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish)
@@ -36,7 +36,7 @@
Try Try
#Region "更新左边栏" #Region "更新左边栏"
If LoaderTaskbar.Count = 0 Then If Not LoaderTaskbar.Any() Then
'无任务 '无任务
LabProgress.Text = "100 %" LabProgress.Text = "100 %"
LabSpeed.Text = "0 B/s" LabSpeed.Text = "0 B/s"
@@ -214,7 +214,8 @@
End Sub End Sub
Public Sub TaskRemove(Loader As Object) Public Sub TaskRemove(Loader As Object)
If RightCards.ContainsKey(Loader.Name) Then If RightCards.ContainsKey(Loader.Name) Then
RunInUiWait(Sub() RunInUiWait(
Sub()
'移除已有的卡片 '移除已有的卡片
Dim Card As Grid = RightCards(Loader.Name) Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card) FrmSpeedRight.PanMain.Children.Remove(Card)
@@ -47,6 +47,8 @@
</local:MyCard.RenderTransform> </local:MyCard.RenderTransform>
<TextBlock x:Name="LabSelect" Text="已选择 8 个文件" HorizontalAlignment="Center" VerticalAlignment="Top" Margin="9" Foreground="{DynamicResource ColorBrush2}" /> <TextBlock x:Name="LabSelect" Text="已选择 8 个文件" HorizontalAlignment="Center" VerticalAlignment="Top" Margin="9" Foreground="{DynamicResource ColorBrush2}" />
<StackPanel Orientation="Horizontal" Margin="5,28,5,5"> <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="启用" <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" /> 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="禁用" <local:MyIconTextButton x:Name="BtnSelectDisable" Text="禁用"
@@ -1,6 +1,4 @@
Imports System.Security.Principal Public Class PageVersionMod
Public Class PageVersionMod
#Region "初始化" #Region "初始化"
@@ -27,7 +25,6 @@ Public Class PageVersionMod
''' 刷新 Mod 列表。 ''' 刷新 Mod 列表。
''' </summary> ''' </summary>
Public Sub RefreshList(Optional ForceReload As Boolean = False) 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 If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表") Log("[System] 已刷新 Mod 列表")
PanBack.ScrollToHome() PanBack.ScrollToHome()
@@ -82,7 +79,7 @@ Public Class PageVersionMod
AniControlEnabled += 1 AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry, Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)} .ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)}
AddHandler Entry.OnGetCompProject, AddressOf NewItem.Refresh AddHandler Entry.OnCompUpdate, AddressOf NewItem.Refresh
NewItem.Refresh() NewItem.Refresh()
AniControlEnabled -= 1 AniControlEnabled -= 1
Return NewItem Return NewItem
@@ -104,17 +101,14 @@ Public Class PageVersionMod
ToolTipService.SetVerticalOffset(BtnCont, 30) ToolTipService.SetVerticalOffset(BtnCont, 30)
ToolTipService.SetHorizontalOffset(BtnCont, 2) ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click, AddressOf Info_Click 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} Dim BtnDelete As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonDelete, .Tag = sender}
BtnDelete.ToolTip = "删除" BtnDelete.ToolTip = "删除"
ToolTipService.SetPlacement(BtnDelete, Primitives.PlacementMode.Center) ToolTipService.SetPlacement(BtnDelete, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnDelete, 30) ToolTipService.SetVerticalOffset(BtnDelete, 30)
ToolTipService.SetHorizontalOffset(BtnDelete, 2) ToolTipService.SetHorizontalOffset(BtnDelete, 2)
AddHandler BtnDelete.Click, AddressOf Delete_Click AddHandler BtnDelete.Click, AddressOf Delete_Click
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine, Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine, Logo.IconButtonStop, Logo.IconButtonCheck), .Tag = sender}
"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}
BtnED.ToolTip = If(sender.Entry.State = McMod.McModState.Fine, "禁用", "启用") BtnED.ToolTip = If(sender.Entry.State = McMod.McModState.Fine, "禁用", "启用")
ToolTipService.SetPlacement(BtnED, Primitives.PlacementMode.Center) ToolTipService.SetPlacement(BtnED, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnED, 30) ToolTipService.SetVerticalOffset(BtnED, 30)
@@ -242,10 +236,12 @@ Public Class PageVersionMod
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字 If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性 '按钮可用性
If Selected Then If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then ElseIf ModEntity.State = McMod.McModState.Disabled Then
@@ -255,9 +251,9 @@ Public Class PageVersionMod
Next Next
BtnSelectDisable.IsEnabled = HasEnabled BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If End If
'更新显示状态 '更新显示状态
CardSelect.IsHitTestVisible = Selected
If AniControlEnabled = 0 Then If AniControlEnabled = 0 Then
If Selected Then If Selected Then
'仅在数量增加时播放出现/跳跃动画 '仅在数量增加时播放出现/跳跃动画
@@ -374,7 +370,7 @@ Public Class PageVersionMod
End Try End Try
'更改 Loader 中的列表 '更改 Loader 中的列表
Dim NewModEntity As New McMod(NewPath) Dim NewModEntity As New McMod(NewPath)
NewModEntity.Comp = ModEntity.Comp NewModEntity.FromJson(ModEntity.ToJson)
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity) Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader) McModLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity) McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
@@ -395,10 +391,128 @@ Public Class PageVersionMod
End If End If
End Sub 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 Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
Dim DeleteList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList() DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
DeleteMods(DeleteList)
End Sub End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of McMod)) Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
Try Try
@@ -191,7 +191,7 @@
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" /> <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" /> 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" /> <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="使用全局设置" /> <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"> <local:MyCard Title="事件 4:其他事件类型" Margin="0,0,0,15" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15"> <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 共有以下种类:" /> Text="EventType 共有以下种类:" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" <TextBlock Margin="0,0,0,4"
Text="· 打开网页、启动游戏、打开文件:已在上方的卡片中介绍" /> Text="· 打开网页、启动游戏、打开文件:已在上方的卡片中介绍" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <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"/> 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="· 今日人品、清理垃圾、内存优化、安装整合包:触发对应功能" /> Text="· 今日人品、清理垃圾、内存优化、安装整合包:触发对应功能" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" <TextBlock Margin="0,0,0,4"
Text="· 复制文本:将 EventData 中的内容复制到剪贴板" /> Text="· 复制文本:将 EventData 中的内容复制到剪贴板" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" <TextBlock Margin="0,0,0,4"
Text="· 刷新主页:点击重新加载主页。如果主页文件为联网更新,这会重新下载主页内容" /> Text="· 刷新主页:点击重新加载主页。如果主页文件为联网更新,这会重新下载主页内容" />
<TextBlock TextWrapping="Wrap" Margin="0,0,0,4" <TextBlock Margin="0,0,0,4"
Text="· 下载文件:在点击时要求选择文件保存位置,并且下载 EventData 的链接中的文件" /> Text="· 下载文件:在点击时要求选择文件保存位置,并且下载 EventData 的链接中的文件" />
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <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" /> 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 文件夹的路径)"/> Text="· 打开帮助:跳转到 EventData 对应的帮助文件(输入相对 Help 文件夹的路径)"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="打开自定义帮助页面" EventType="打开帮助" EventData="帮助/自定义帮助.json"/> 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 行左右的位置即可查找到对应数值"/> Text="· 切换页面:强制切换到 PCL 的某一页面(尝试切换到不太对头的页面会出现不可预知的 Bug,使用时请谨慎)&#xa;      EventData 为 页面种类|次要页面种类(PageType|PageSubType,例如 1|1)&#xa;      点击上方的 查看 PCL 源代码 按钮,在 1000 行左右的位置即可查找到对应数值"/>
<local:MyButton Margin="0,5,0,6" Width="250" Height="35" <local:MyButton Margin="0,5,0,6" Width="250" Height="35"
Text="切换到下载页面" EventType="切换页面" EventData="1|1"/> Text="切换到下载页面" EventType="切换页面" EventData="1|1"/>
+1 -1
View File
@@ -3648,7 +3648,7 @@ vpn-blocker|禁用VPN (VPN Blocker)
premium-wood@ premium-wood@
tenshilib¨tenshilib-fabric tenshilib¨tenshilib-fabric
randomportals|随意传送门 (RandomPortals) randomportals|随意传送门 (RandomPortals)
configured|配置界面* - Forge¨configured-fabric|配置界面 (Configured) - Fabric configured|配置界面*¨configured-fabric|配置界面 (Configured) - Fabric
jellyfishing@|抓水母* jellyfishing@|抓水母*
accurate-block-placement accurate-block-placement
Binary file not shown.