Merge branch 'Hex-Dragon:main' into main

This commit is contained in:
allMagic
2024-07-11 21:10:19 +08:00
committed by GitHub
15 changed files with 130 additions and 108 deletions
+14
View File
@@ -10,6 +10,12 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 330 Then 'Release 2.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 15
BugCount += 22
End If
If LastVersion < 326 Then 'Release 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
@@ -115,6 +121,14 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 329 Then 'Snapshot 2.8.2
If LastVersion >= 327 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Beta 版 NeoForge 的整合包的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复自动安装无法选择部分 OptiFine 的 Bug"))
End If
FeatureCount += 4
BugCount += 8
End If
If LastVersion < 328 Then 'Snapshot 2.8.1
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.12.2- 的 Bug"))
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法输入解锁码的 Bug"))
+27 -10
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.1." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.2." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 326 'Release
Public Const VersionCode As Integer = 330 'Release
#Else
Public Const VersionCode As Integer = 328 'Snapshot
Public Const VersionCode As Integer = 329 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -86,7 +86,7 @@ Public Module ModBase
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\"
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
''' <summary>
''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary>
@@ -1257,12 +1257,19 @@ Re:
Dim DeletedCount As Integer = 0
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
For Each FilePath As String In Temp
Dim RetriedFile As Boolean = False
RetryFile:
Try
File.Delete(str)
File.Delete(FilePath)
DeletedCount += 1
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedFile Then
RetriedFile = True
Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
Thread.Sleep(300)
GoTo RetryFile
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件可忽略地失败")
Else
Throw
@@ -1273,10 +1280,17 @@ Re:
For Each str As String In Temp
DeleteDirectory(str, IgnoreIssue)
Next
Dim RetriedDir As Boolean = False
RetryDir:
Try
Directory.Delete(Path, True)
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedDir Then
RetriedDir = True
Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
Thread.Sleep(300)
GoTo RetryDir
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件夹可忽略地失败")
Else
Throw
@@ -1652,7 +1666,10 @@ Re:
''' 为字符串进行 XML 转义。
''' </summary>
Public Function EscapeXML(Str As String) As String
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
Return Str.
Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function
'正则
@@ -639,9 +639,9 @@ NoSubtitle:
'来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -8,9 +8,13 @@
''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本
Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
@@ -610,7 +614,9 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True)
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
@@ -679,7 +685,9 @@
''' Forge 版本列表,BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057
IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -1278,7 +1278,9 @@ SystemBrowser:
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper"))
If Not WriteFile(WrapperPath, GetResources("JavaWrapper")) Then
Throw New FileNotFoundException("释放 Java Wrapper 失败")
End If
End SyncLock
Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
Return WrapperPath
@@ -25,6 +25,7 @@ Public Module ModModpack
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
'从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
@@ -35,7 +36,6 @@ Public Module ModModpack
End If
End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
'从一级目录判断整合包类型
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
+3 -1
View File
@@ -21,11 +21,13 @@
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
RunInThread(Sub()
RunInThread(
Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.1.0")>
<Assembly: AssemblyFileVersion("2.8.1.0")>
<Assembly: AssemblyVersion("2.8.2.0")>
<Assembly: AssemblyFileVersion("2.8.2.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -316,46 +316,6 @@ Public Module ModDownloadLib
#Region "OptiFine 下载"
Public Sub McDownloadOptiFine(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.NameVersion
Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\"
Dim IsNewVersion As Boolean = Val(DownloadInfo.Inherit.Split(".")(1)) >= 14
Dim Target As String = If(IsNewVersion,
PathTemp & "Cache\Code\" & DownloadInfo.NameVersion & "_" & GetUuid(),
PathMcFolder & "libraries\optifine\OptiFine\" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & "\" & DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", ""))
'重复任务检查
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'已有版本检查
If File.Exists(VersionFolder & Id & ".json") Then
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(VersionFolder & Id & ".jar")
File.Delete(VersionFolder & Id & ".json")
Else
Exit Sub
End If
End If
'启动
Dim Loader As New LoaderCombo(Of String)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineLoader(DownloadInfo)) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 OptiFine 下载失败", LogLevel.Feedback)
End Try
End Sub
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.NameVersion
@@ -1282,9 +1242,11 @@ Retry:
Else
'Forge
Dim Forge As DlForgeVersionEntry = Info
Dim FileName As String =
$"{Forge.Inherit.Replace("-", "_")}-{Forge.FileVersion}/forge-{Forge.Inherit.Replace("-", "_")}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}"
Files.Add(New NetFile({
$"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}",
$"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}"
$"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{FileName}",
$"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{FileName}"
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=Forge.Hash)))
End If
Task.Output = Files
@@ -724,7 +724,7 @@
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge
If OptiFine.RequiredForgeVersion = "" Then Return True
If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183
If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX
Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0
Else 'XXXX
@@ -21,6 +21,19 @@
'加载版本
RunInNewThread(
Sub()
''自动整合包安装:准备
'Dim PackInstallPath As String = Nothing
'If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
'If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
'If PackInstallPath IsNot Nothing Then
' Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
' If Not Directory.Exists(Path & ".minecraft\") Then
' Directory.CreateDirectory(Path & ".minecraft\")
' Directory.CreateDirectory(Path & ".minecraft\versions\")
' McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
' End If
' Setup.Set("LaunchFolderSelect", "$.minecraft\")
'End If
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
@@ -35,17 +48,21 @@
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
''自动整合包安装
'If PackInstallPath IsNot Nothing Then
' If ModpackInstall(PackInstallPath) Then
' Log("[Launch] 自动安装整合包成功:" & PackInstallPath)
' File.Delete(PackInstallPath)
' Else
' Log("[Launch] 自动安装整合包失败:" & PackInstallPath)
' End If
'End If
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion
If Selection = "" Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Version Is Nothing OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
Log("[Launch] Minecraft 版本无效" & If(Version Is Nothing, ",没有有效版本", ":" & 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 McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
@@ -619,7 +636,7 @@ Finish:
Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载版本列表,请稍候"
FrmLaunchLeft.LabVersion.Text = "正在加载中,请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1
@@ -438,7 +438,7 @@ Refresh:
End If
End Sub
Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse LabLauncherTheme11Click.ToolTip.ToString.Contains("点击") Then
If LabLauncherTheme11Click.Visibility = Visibility.Collapsed OrElse If(LabLauncherTheme11Click.ToolTip, "").ToString.Contains("点击") Then
If MyMsgBox(
"1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf &
"2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf &
@@ -38,7 +38,7 @@
<DefineDebug>false</DefineDebug>
<DefineTrace>false</DefineTrace>
<IncrementalBuild>true</IncrementalBuild>
<OutputPath>.\Output\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
@@ -55,7 +55,7 @@
<DefineTrace>false</DefineTrace>
<IncrementalBuild>false</IncrementalBuild>
<Optimize>true</Optimize>
<OutputPath>.\Output\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
@@ -100,7 +100,7 @@
<SignManifests>false</SignManifests>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Snapshot|AnyCPU'">
<OutputPath>.\Output\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
@@ -111,7 +111,7 @@
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'BETA|AnyCPU'">
<OutputPath>.\Output\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
@@ -129,7 +129,7 @@
</AssemblyOriginatorKeyFile>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'ReleaseUpdate|AnyCPU'">
<OutputPath>.\Output\</OutputPath>
<OutputPath>.\bin\</OutputPath>
<DefineConstants>RELEASE,BY_UPDATE</DefineConstants>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize>
+2 -2
View File
@@ -148,7 +148,7 @@
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Margin="0,0,10,0" Width="140" Height="35" HorizontalAlignment="Left" Padding="13,0,13,0"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" />
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</StackPanel>
<!-- 这是第二行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0">
@@ -270,7 +270,7 @@
<local:MyButton Grid.Column="1" Margin="0,0,10,0" Height="35"
Text="进入 Hypixel" EventType="启动游戏" EventData="1.16.3|mc.hypixel.net" ToolTip="使用 Minecraft 1.16.3 进入 Hypixel" />
<local:MyButton Grid.Column="2" Margin="0,0,10,0" Height="35"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" />
Text="打开记事本" EventType="打开文件" EventData="notepad" />
</Grid>
</StackPanel>
</local:MyCard>
Binary file not shown.