This commit is contained in:
龙腾猫跃
2024-07-11 20:13:26 +08:00
parent 73a8d60d6d
commit 5436c5ec8a
15 changed files with 130 additions and 124 deletions
+14
View File
@@ -10,6 +10,12 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #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 If LastVersion < 326 Then 'Release 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
@@ -115,6 +121,14 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '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 < 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, "修复无法安装 Forge 1.12.2- 的 Bug"))
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法输入解锁码的 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 "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.1" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.8.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.1." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.8.2." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 326 'Release Public Const VersionCode As Integer = 330 'Release
#Else #Else
Public Const VersionCode As Integer = 328 'Snapshot Public Const VersionCode As Integer = 329 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -86,7 +86,7 @@ Public Module ModBase
''' <summary> ''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。 ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary> ''' </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>
''' 程序的缓存文件夹路径,以 \ 结尾。 ''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary> ''' </summary>
@@ -1257,12 +1257,19 @@ Re:
Dim DeletedCount As Integer = 0 Dim DeletedCount As Integer = 0
Dim Temp As String() Dim Temp As String()
Temp = Directory.GetFiles(Path) 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 Try
File.Delete(str) File.Delete(FilePath)
DeletedCount += 1 DeletedCount += 1
Catch ex As Exception 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, "删除单个文件可忽略地失败") Log(ex, "删除单个文件可忽略地失败")
Else Else
Throw Throw
@@ -1273,10 +1280,17 @@ Re:
For Each str As String In Temp For Each str As String In Temp
DeleteDirectory(str, IgnoreIssue) DeleteDirectory(str, IgnoreIssue)
Next Next
Dim RetriedDir As Boolean = False
RetryDir:
Try Try
Directory.Delete(Path, True) Directory.Delete(Path, True)
Catch ex As Exception 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, "删除单个文件夹可忽略地失败") Log(ex, "删除单个文件夹可忽略地失败")
Else Else
Throw Throw
@@ -1652,7 +1666,10 @@ Re:
''' 为字符串进行 XML 转义。 ''' 为字符串进行 XML 转义。
''' </summary> ''' </summary>
Public Function EscapeXML(Str As String) As String 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 End Function
'正则 '正则
@@ -629,19 +629,19 @@ NoSubtitle:
If Id = Project.Id Then Return True '相同实例 If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字 '提取字符串中的字母和数字
Dim GetRaw = Dim GetRaw =
Function(Data As String) As String Function(Data As String) As String
Dim Result As New StringBuilder() Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c)) For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r) Result.Append(r)
Next Next
Return Result.ToString.ToLower Return Result.ToString.ToLower
End Function End Function
'来自不同的网站 '来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致 '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 版本一致 '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 的英文部分相同 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -8,9 +8,13 @@
''' </summary> ''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本 '获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion) Try
Version = New McVersion(Version.InheritVersion) Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Loop Version = New McVersion(Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准 '检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then 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 文件下载信息") Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
@@ -610,7 +614,9 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String Dim Result As String
Try 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 Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本") Throw New Exception("没有可用版本")
@@ -679,7 +685,9 @@
''' Forge 版本列表,BMCLAPI。 ''' Forge 版本列表,BMCLAPI。
''' </summary> ''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) 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) Dim Versions As New List(Of DlForgeVersionEntry)
Try Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input) Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -1278,7 +1278,9 @@ SystemBrowser:
Public Function ExtractJavaWrapper() As String Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar" Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突 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 End SyncLock
Log("[Java] 已释放 Java Wrapper:" & WrapperPath) Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
Return WrapperPath Return WrapperPath
@@ -25,6 +25,7 @@ Public Module ModModpack
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)) 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("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("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8)) Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
@@ -35,7 +36,6 @@ Public Module ModModpack
End If End If
End If End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包 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 For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/") Dim FullNames As String() = Entry.FullName.Split("/")
+22 -20
View File
@@ -21,26 +21,28 @@
OpenWebsite(Data(0)) OpenWebsite(Data(0))
Case "打开文件", "打开帮助" Case "打开文件", "打开帮助"
RunInThread(Sub() RunInThread(
Try Sub()
'确认实际路径 Try
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type) '确认实际路径
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1) Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
'执行 Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
If Type = "打开文件" Then Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
Dim Info As New ProcessStartInfo With { '执行
.Arguments = If(Data.Length >= 2, Data(1), ""), If Type = "打开文件" Then
.FileName = Location, Dim Info As New ProcessStartInfo With {
.WorkingDirectory = WorkingDir .Arguments = If(Data.Length >= 2, Data(1), ""),
} .FileName = Location,
Process.Start(Info) .WorkingDirectory = WorkingDir
Else '打开帮助 }
PageOtherHelp.EnterHelpPage(Location) Process.Start(Info)
End If Else '打开帮助
Catch ex As Exception PageOtherHelp.EnterHelpPage(Location)
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) End If
End Try Catch ex As Exception
End Sub) Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
Case "启动游戏" Case "启动游戏"
If Data(0) = "\current" Then If Data(0) = "\current" Then
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.1.0")> <Assembly: AssemblyVersion("2.8.2.0")>
<Assembly: AssemblyFileVersion("2.8.1.0")> <Assembly: AssemblyFileVersion("2.8.2.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
@@ -316,46 +316,6 @@ Public Module ModDownloadLib
#Region "OptiFine 下载" #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) Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try Try
Dim Id As String = DownloadInfo.NameVersion Dim Id As String = DownloadInfo.NameVersion
@@ -1282,9 +1242,11 @@ Retry:
Else Else
'Forge 'Forge
Dim Forge As DlForgeVersionEntry = Info 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({ 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://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{FileName}",
$"https://files.minecraftforge.net/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/{FileName}"
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=Forge.Hash))) }, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=Forge.Hash)))
End If End If
Task.Output = Files Task.Output = Files
@@ -724,7 +724,7 @@
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry) Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本 If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge 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 If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX
Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0 Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0
Else 'XXXX Else 'XXXX
@@ -21,6 +21,19 @@
'加载版本 '加载版本
RunInNewThread( RunInNewThread(
Sub() 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 文件夹存在 '确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
@@ -35,17 +48,21 @@
End If End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder) Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) 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 版本存在 '确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect") Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Selection = "" Then If Version Is Nothing OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) 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 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 If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing Version = Nothing
@@ -57,7 +74,6 @@
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path) Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path)
End If End If
End If End If
RunInUi( RunInUi(
Sub() Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变 McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
@@ -73,21 +89,6 @@
If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True
RefreshPage(False, False) RefreshPage(False, False)
'整合包安装
If McVersionList.Count = 0 AndAlso File.Exists(Path & "modpack.zip") Then
If MyMsgBox("即将自动安装整合包,是否继续?", Button2:="取消") = 1 Then
If Not Directory.Exists(Path & ".minecraft\") Then
Directory.CreateDirectory(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
Setup.Set("LaunchFolderSelect", "$.minecraft\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
McFolderListLoader.Start(IsForceRestart:=True)
RunInNewThread(Sub() ModpackInstall(Path & "modpack.zip", ShowHint:=False), "Modpack Auto Install")
End If
End If
AniControlEnabled -= 1 AniControlEnabled -= 1
End Sub End Sub
@@ -635,7 +636,7 @@ Finish:
Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本") Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载" FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载版本列表,请稍候" FrmLaunchLeft.LabVersion.Text = "正在加载中,请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1 Case 1
@@ -438,7 +438,7 @@ Refresh:
End If End If
End Sub End Sub
Private Sub LabLauncherTheme11Click_MouseLeftButtonUp() Handles LabLauncherTheme11Click.MouseLeftButtonUp, RadioLauncherTheme11.MouseRightButtonUp 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( If MyMsgBox(
"1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf & "1. 不爬取或攻击相关服务或网站,不盗取相关账号,没有谜题可以或需要以此来解决。" & vbCrLf &
"2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf & "2. 不得篡改或损毁相关公开信息,请尽量让它们保持原状。" & vbCrLf &
@@ -38,7 +38,7 @@
<DefineDebug>false</DefineDebug> <DefineDebug>false</DefineDebug>
<DefineTrace>false</DefineTrace> <DefineTrace>false</DefineTrace>
<IncrementalBuild>true</IncrementalBuild> <IncrementalBuild>true</IncrementalBuild>
<OutputPath>.\Output\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn> <NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit> <Prefer32Bit>false</Prefer32Bit>
@@ -55,7 +55,7 @@
<DefineTrace>false</DefineTrace> <DefineTrace>false</DefineTrace>
<IncrementalBuild>false</IncrementalBuild> <IncrementalBuild>false</IncrementalBuild>
<Optimize>true</Optimize> <Optimize>true</Optimize>
<OutputPath>.\Output\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn> <NoWarn>41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314</NoWarn>
<Prefer32Bit>false</Prefer32Bit> <Prefer32Bit>false</Prefer32Bit>
@@ -100,7 +100,7 @@
<SignManifests>false</SignManifests> <SignManifests>false</SignManifests>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Snapshot|AnyCPU'"> <PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Snapshot|AnyCPU'">
<OutputPath>.\Output\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize> <Optimize>true</Optimize>
<WarningLevel>1</WarningLevel> <WarningLevel>1</WarningLevel>
@@ -111,7 +111,7 @@
<Prefer32Bit>false</Prefer32Bit> <Prefer32Bit>false</Prefer32Bit>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'BETA|AnyCPU'"> <PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'BETA|AnyCPU'">
<OutputPath>.\Output\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize> <Optimize>true</Optimize>
<WarningLevel>1</WarningLevel> <WarningLevel>1</WarningLevel>
@@ -129,7 +129,7 @@
</AssemblyOriginatorKeyFile> </AssemblyOriginatorKeyFile>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'ReleaseUpdate|AnyCPU'"> <PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'ReleaseUpdate|AnyCPU'">
<OutputPath>.\Output\</OutputPath> <OutputPath>.\bin\</OutputPath>
<DefineConstants>RELEASE,BY_UPDATE</DefineConstants> <DefineConstants>RELEASE,BY_UPDATE</DefineConstants>
<DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile> <DocumentationFile>Plain Craft Launcher 2.xml</DocumentationFile>
<Optimize>true</Optimize> <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" <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" /> 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" <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>
<!-- 这是第二行 --> <!-- 这是第二行 -->
<StackPanel Orientation="Horizontal" HorizontalAlignment="Center" Margin="0,10,0,0"> <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" <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" /> 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" <local:MyButton Grid.Column="2" Margin="0,0,10,0" Height="35"
Text="打开画图" EventType="打开文件" EventData="mspaint.exe" /> Text="打开记事本" EventType="打开文件" EventData="notepad" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
Binary file not shown.