This commit is contained in:
龙腾猫跃
2022-11-26 22:39:08 +08:00
parent 5ef1d60e2e
commit 5fb5a3b963
21 changed files with 335 additions and 214 deletions
@@ -15,7 +15,6 @@ Public Class Application
Log(ex, "开发者模式测试出错", LogLevel.Feedback)
End Try
End Sub
#End If
'开始
+11 -3
View File
@@ -287,9 +287,9 @@
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
Control.IsHitTestVisible = False
AniStart({
If Control.IsHitTestVisible Then
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
@@ -302,5 +302,13 @@ Partial Public Module ModAnimation
If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid)
Else
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
End If
If CallBack IsNot Nothing Then CallBack(Control)
End If
End Sub
End Module
+13 -1
View File
@@ -10,6 +10,12 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 270 Then 'Release 2.4.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
FeatureCount += 6
BugCount += 15
End If
If LastVersion < 268 Then 'Release 2.4.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
@@ -100,6 +106,12 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 271 Then 'Snapshot 2.4.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
FeatureCount += 6
BugCount += 15
End If
If LastVersion < 269 Then 'Snapshot 2.4.2
If LastVersion = 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法下载 CurseForge 整合包的 Bug"))
FeatureCount += 2
@@ -1136,7 +1148,7 @@ Install:
If MyMsgBox("由于联机提供商要求新联机强制付费,且高度商业化,PCL 将暂时关闭联机功能,不再使用该联机模块。" & vbCrLf &
"PCL、HMCL、BakaXL 将合作开发新的跨启动器联机功能,在开发结束后将同步开放,请各位多多理解。",
"联机功能已暂时关闭", "查看详情", "确定") = 1 Then
OpenWebsite("https://www.bilibili.com/read/cv19553725")
OpenWebsite("https://www.bilibili.com/read/cv19845645")
End If
e.Handled = True
End Sub
@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.4.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.2." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.4.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.3." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 268 'Release
Public Const VersionCode As Integer = 270 'Release
#Else
Public Const VersionCode As Integer = 269 'Snapshot
Public Const VersionCode As Integer = 271 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -771,6 +771,8 @@ Public Module ModBase
'还原文件路径
If Not FromPath.Contains(":\") Then FromPath = Path & FromPath
If Not ToPath.Contains(":\") Then ToPath = Path & ToPath
'如果复制同一个文件则跳过
If FromPath = ToPath Then Exit Sub
'读取文件内容
Dim FileBytes As Byte()
Using ReadStream As New FileStream(FromPath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
@@ -221,6 +221,7 @@
McDownloadClientUpdateHint(Version, Json)
IsNewClientVersionHinted = True
End If
McVersionHighest = Version.Split(".")(1)
Setup.Set("ToolUpdateReleaseLast", Version)
'解析更新提示(Snapshot)
Version = Json("latest")("snapshot")
@@ -772,7 +773,7 @@
''' </summary>
Public IsLegacy As Boolean
''' <summary>
''' 发布时间,格式为“yyyy/mm/dd HH:mm:ss”。
''' 发布时间,格式为“yyyy/mm/dd HH:mm”。
''' </summary>
Public ReleaseTime As String
''' <summary>
@@ -1090,33 +1091,27 @@
DateUpdate = Data("dateModified")
DownloadCount = Data("downloadCount")
IsModPack = Not Website.Contains("/mc-mods/")
'获取常见文件
'获取 Mod Loader 列表
ModLoaders = New List(Of String)
For Each File In If(Data("latestFiles"), {})
Dim NewFile As New DlCfFile(File, IsModPack)
If Not NewFile.IsAvailable Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Next
'获取游戏版本、Mod Loader
ModLoaders = ModLoaders.Distinct.ToList
'用一个偷懒的方式让 Forge 排在 Fabric 的前面
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Forge", "Aorge")).ToList()
ModLoaders.Sort()
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Aorge", "Forge")).ToList()
'获取游戏版本
Dim GameVersions As New List(Of Integer)
ModLoaders = New List(Of String)
For Each File In If(Data("latestFilesIndexes"), {})
Dim Version As String = File("gameVersion")
If Not Version.Contains("1.") Then Continue For
GameVersions.Add(Version.Split(".")(1).Split("-").First)
Select Case If(File("modLoader"), "0").ToString
Case 1
ModLoaders.Add("Forge")
Case 2
ModLoaders.Add("Cauldron")
Case 3
ModLoaders.Add("LiteLoader")
Case 4
ModLoaders.Add("Fabric")
End Select
FileIndexes.Add(File("fileId"))
Next
GameVersions = Sort(GameVersions.Distinct.ToList, AddressOf VersionSortBoolean)
ModLoaders = ModLoaders.Distinct.ToList
ModLoaders.Sort()
If GameVersions.Count = 0 Then
GameVersionDesc = ""
Else
@@ -1133,8 +1128,15 @@
Next
If StartVersion = EndVersion Then
SpaVersions.Add("1." & StartVersion)
ElseIf StartVersion >= McVersionHighest Then
SpaVersions.Add("1." & EndVersion & "+")
ElseIf EndVersion <= 7 Then
SpaVersions.Add("1." & StartVersion & "-")
Exit For
ElseIf StartVersion - EndVersion = 1 Then
SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion)
Else
SpaVersions.Add("1." & StartVersion & "-1." & EndVersion)
SpaVersions.Add("1." & StartVersion & "~1." & EndVersion)
End If
Next
GameVersionDesc = "[" & Join(SpaVersions, ", ") & "] "
@@ -1211,12 +1213,11 @@
Dim NewItem As New MyCfItem With {.Tag = Me}
NewItem.LabTitle.Text = ChineseName
NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "")
NewItem.LabLeft.Text = If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders, " & ") & "] ", "") &
If(ShowVersionDesc, GameVersionDesc, "") &
NewItem.LabLeft.Text = (If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders, "/") & "] ", "") &
If(ShowVersionDesc, GameVersionDesc, "")).Replace("] [", " ") &
Join(CategoryDesc, ",") & " (" &
GetTimeSpanString(DateUpdate - Date.Now) & "更新" &
If(DownloadCount > 0,
"," & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载", DownloadCount & " 次下载"), "") & ")"
GetTimeSpanString(DateUpdate - Date.Now) & "更新," &
If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载", DownloadCount & " 次下载") & ")"
If Thumb Is Nothing Then
NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png"
Else
@@ -1279,7 +1280,7 @@
Dim SearchResult As String = ""
For i = 0 To SearchResults.Count - 1
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
SearchResult += SearchResults(i).Item.Replace(" (", "|").Split("|").Last.TrimEnd(")") & " "
SearchResult += SearchResults(i).Item.Replace(" - ", "§").Split("§").First.Replace(" (", "|").Split("|").Last.TrimEnd(")") & " "
Next
Log("[Download] CurseForge 工程列表中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
'去除常见连接词
@@ -1432,6 +1433,7 @@
Public DisplayName As String
Public [Date] As Date
Public GameVersion As String()
Public ModLoaders As New List(Of String)
Public ReleaseType As Integer
Public FileName As String
Public DownloadCount As Integer
@@ -1481,11 +1483,13 @@
End If
Next
End If
'获取游戏版本
'获取游戏版本与 Mod 加载器列表
Dim Versions As New List(Of String)
For Each Version In Data("gameVersions")
If Version.ToString.StartsWith("1.") OrElse Version.ToString.Contains("w") Then
Versions.Add(Version.ToString.Trim.ToLower)
For Each Version In Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower)
If Version.StartsWith("1.") OrElse Version.Contains("w") Then
Versions.Add(Version)
ElseIf Version = "forge" OrElse Version = "fabric" OrElse Version = "quilt" OrElse Version = "rift" Then
ModLoaders.Add(Version.First.ToString.ToUpper & Version.Substring(1))
End If
Next
If Versions.Count > 1 Then
@@ -1493,11 +1497,13 @@
If IsModPack Then GameVersion = {GameVersion(0)}
ElseIf Versions.Count = 1 Then
GameVersion = Versions.ToArray
'ElseIf Data("gameVersion").Count = 1 AndAlso Not Data("gameVersion")(0).ToString.Contains("1.") Then
' GameVersion = {"1.16.4"}
Else
GameVersion = {"未知版本"}
End If
'用一个偷懒的方式让 Forge 排在 Fabric 的前面
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Forge", "Aorge")).ToList()
ModLoaders.Sort()
ModLoaders = ModLoaders.Select(Function(s) s.Replace("Aorge", "Forge")).ToList()
End Sub
''' <summary>
@@ -1513,10 +1519,14 @@
'获取描述信息
Dim Info As String = ""
If Not IsModPack Then
Info += "适用于 " & Join(GameVersion, "、").Replace("-snapshot", " 快照") &
If(ModeDebug AndAlso Dependencies.Count > 0, "," & Dependencies.Count & " 个前置,", ",")
Info += If(ModLoaders.Count > 0, Join(ModLoaders, "/"), "") &
If(GameVersion.Count > 1, If(ModLoaders.Count > 0, " ", "") & Join(GameVersion, "、").Replace("-snapshot", " 快照"), "")
If Info <> "" Then Info = "适用于 " & Info & ","
Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "")
End If
Info += If(DownloadCount > 0, If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,"), "")
'If DownloadCount > 0 Then 'DownloadCount 目前的返回内容完全不正确,经常是 0,干脆不显示了
' Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,")
'End If
Info += GetTimeSpanString([Date] - Date.Now) & "更新"
Info += If(ReleaseType <> 1, "," & ReleaseTypeString, "")
@@ -1078,19 +1078,30 @@ SystemBrowser:
MaxVer = New Version(1, 12, 999, 999)
End If
'OptiFine 检测
If McVersionCurrent.Version.HasOptiFine Then
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'<1.7:至多 Java 8(Java 9 - 10 未测试)
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 8 AndAlso McVersionCurrent.Version.McCodeMain <= 11 Then
'1.8 - 1.11:必须恰好 Java 8(Java 9 - 10 未测试)
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
End If
End If
'Forge 检测
If McVersionCurrent.Version.HasForge Then
If McVersionCurrent.Version.McName = "1.7.2" Then
'1.7.2:必须 Java 7
MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then
'1.12,Forge 14.23.5.2855 及更低:Java 8
'<1.12,Forge 14.23.5.2855 及更低:Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then
'1.13 - 1.14,Forge 28.2.23 及更低:Java 8 - 10
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'1.15 - 1.16:Java 8 - 15
ElseIf McVersionCurrent.Version.McCodeMain <= 15 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'1.15:Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
'1.18+:若安装了 OptiFine,最高 Java 18
@@ -1101,8 +1112,8 @@ SystemBrowser:
'Fabric 检测
If McVersionCurrent.Version.HasFabric Then
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16:Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
'1.15 - 1.16:Java 8 - 18
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 18, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
'1.18+:Java 17 - 18
MinVer = New Version(1, 17, 0, 0) : MaxVer = New Version(1, 18, 999, 999)
@@ -1150,24 +1161,31 @@ SystemBrowser:
Private McLaunchArgument As String
''' <summary>
''' 释放 Java Wrapper 并返回文件路径。
''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = PathAppdata & "JavaWrapper.jar"
If Encoding.UTF8.GetByteCount(WrapperPath) <> WrapperPath.Length Then
Log("[Java] AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
WrapperPath = PathTemp & "JavaWrapper.jar"
If Encoding.UTF8.GetByteCount(PathTemp) <> PathTemp.Length Then
Log("[Java] Temp 路径中包含非 ASCII 字符,换用 C 盘根目录")
WrapperPath = "C:\PCL\JavaWrapper.jar"
End If
End If
If Not File.Exists(WrapperPath) OrElse New FileInfo(WrapperPath).Length > 20 * 1024 Then
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
If Not File.Exists(WrapperPath) OrElse New FileInfo(WrapperPath).Length <> 16818 Then
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Log("[Java] 已自动释放 Java Wrapper:" & WrapperPath)
End If
Return WrapperPath
End Function
''' <summary>
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
''' </summary>
Public Function GetJavaWrapperDir() As String
Dim WrapperPath As String = PathAppdata.TrimEnd("\")
If Encoding.UTF8.GetByteCount(WrapperPath) <> WrapperPath.Length Then
Log("[Java] AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
WrapperPath = PathTemp.TrimEnd("\")
If Encoding.UTF8.GetByteCount(PathTemp) <> PathTemp.Length Then
Log("[Java] Temp 路径中包含非 ASCII 字符,换用 C 盘根目录")
WrapperPath = "C:\PCL"
End If
End If
Return WrapperPath
End Function
'主方法,合并 Jvm、Game、Replace 三部分的参数数据
Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, List(Of McLibToken)))
@@ -1185,7 +1203,7 @@ SystemBrowser:
McLaunchLog("旧版 JVM 参数获取成功:")
McLaunchLog(Arguments)
End If
If McVersionCurrent.JsonObject("minecraftArguments") IsNot Nothing Then
If Not String.IsNullOrEmpty(McVersionCurrent.JsonObject("minecraftArguments")) Then '有的版本是空字符串
McLaunchLog("获取旧版 Game 参数")
Arguments += " " & McLaunchArgumentsGameOld(McVersionCurrent)
McLaunchLog("旧版 Game 参数获取成功")
@@ -1270,6 +1288,7 @@ SystemBrowser:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'添加 MainClass
@@ -1336,6 +1355,7 @@ NextVersion:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1502,9 +1522,7 @@ NextVersion:
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))
'支持库参数
'Dim LibList As List(Of McLibToken) = McLibListGet(Version,
' Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17)) '包含版本 Jar 的条件是不为 1.17+ 的 Forge
Dim LibList As List(Of McLibToken) = McLibListGet(Version, True) '如果在 1.19.x Forge 不包含版本 Jar 会导致 #188
Dim LibList As List(Of McLibToken) = McLibListGet(Version, True)
Loader.Output = LibList
Dim CpStrings As New List(Of String)
Dim OptiFineCp As String = Nothing
@@ -2327,13 +2327,16 @@ NextVersion:
Dim RealVersion As McVersion
Dim RequiredJar As String = Version.JsonObject("jar")?.ToString
If Version.IsHmclFormatJson OrElse RequiredJar Is Nothing Then
'HMCL 项直接使用自身的 Jar
'根据 Inherit 获取最深层版本
'此外,HMCL 项直接使用自身的 Jar
Dim OriginalVersion As McVersion = Version
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
Loop
'1.17+ 的 Forge 不寻找 Inherit
If Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
Loop
End If
'需要新建对象,否则后面的 Check 会导致 McVersionCurrent 的 State 变回 Original
'复现:启动一个 Snapshot 版本
RealVersion = New McVersion(OriginalVersion.Path)
@@ -2380,6 +2383,11 @@ NextVersion:
'转换为 LibToken
For Each Library As JObject In AllLibs.Children
'清理 null 项(BakaXL 会把没有的项序列化为 null,但会被 Newtonsoft 转换为 JValue,导致 Is Nothing = false;这导致了 #409)
For i = Library.Properties.Count - 1 To 0 Step -1
If Library.Properties(i).Value.Type = JTokenType.Null Then Library.Remove(Library.Properties(i).Name)
Next
'检查是否需要(Rules)
If Not McJsonRuleCheck(Library("rules")) Then Continue For
@@ -241,8 +241,12 @@ Retry:
For Each ModJson In Task.Input
'跳过重复的 Mod(疑似 CurseForge Bug)
If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
'根据 modules 判断是资源包还是 Mod
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
Dim IsResourcePack As Boolean = Not ModuleNames.Contains("META-INF") AndAlso ModuleNames.Contains("pack.mcmeta")
'实际的添加
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(
PathMcFolder & "versions\" & VersionName & "\" & If(IsResourcePack, "resourcepacks", "mods") & "\", False))
Task.Progress += 1 / (1 + ModFileList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.4.2.0")>
<Assembly: AssemblyFileVersion("2.4.2.0")>
<Assembly: AssemblyVersion("2.4.3.0")>
<Assembly: AssemblyFileVersion("2.4.3.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -1,8 +1,15 @@
Imports System.IO.Compression
Public Module ModDownloadLib
'如果 OptiFine 与 Forge 同时开始安装,就会导致 Forge 安装失败
''' <summary>
''' 如果 OptiFine 与 Forge 同时开始安装,就会导致 Forge 安装失败,所以在这里添加一个锁。
''' </summary>
Private InstallSyncLock As New Object
''' <summary>
''' 最高的 Minecraft 大版本号,-1 代表尚未获取。
''' </summary>
Public McVersionHighest As Integer = -1
#Region "Minecraft 下载"
@@ -114,7 +121,7 @@ Public Module ModDownloadLib
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")}
End Sub) With {.ProgressWeight = 2, .Show = False})
End If
Loaders.Add(New LoaderDownload("下载原版 Json 文件", New List(Of NetFile) From {
Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 3})
@@ -159,6 +166,7 @@ Public Module ModDownloadLib
End Function
Private Const McDownloadClientLibName As String = "下载原版支持库文件"
Private Const McDownloadClientJsonName As String = "下载原版 Json 文件"
#End Region
@@ -378,7 +386,7 @@ Public Module ModDownloadLib
Throw New Exception("未找到用于安装 OptiFine 的 Java")
End If
'添加 Java Wrapper 作为主 Jar
Dim Arguments = "-Duser.home=""" & BaseMcFolderHome & """ -cp """ & Target & """ -jar """ & ExtractJavaWrapper() & """ optifine.Installer"
Dim Arguments = "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """ -Duser.home=""" & BaseMcFolderHome & """ -cp """ & Target & """ -jar """ & ExtractJavaWrapper() & """ optifine.Installer"
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
@@ -518,27 +526,28 @@ Public Module ModDownloadLib
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
'是否已经存在原版文件
If ClientDownloadLoader Is Nothing Then Exit Sub
'等待原版文件下载完成
For Each Loader In ClientDownloadLoader.GetLoaderList
If Loader.Name <> McDownloadClientLibName Then Continue For
If Loader.State = LoadState.Loading Then
Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Loader.WaitForExit()
End If
Exit For
Next
If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
'拷贝原版文件
If IsCustomFolder Then
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
End If
If Not IsCustomFolder Then Exit Sub
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -876,8 +885,8 @@ Public Module ModDownloadLib
'构造版本 Json
Dim VersionJson As New JObject
VersionJson.Add("id", VersionName)
VersionJson.Add("time", DateTime.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm:ss", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("releaseTime", DateTime.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm:ss", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("time", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture))
VersionJson.Add("type", "release")
VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}"))
VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries"))
@@ -1094,7 +1103,7 @@ Public Module ModDownloadLib
Throw New Exception("未找到用于安装 Forge 的 Java")
End If
'添加 Java Wrapper 作为主 Jar
Dim Arguments = "-cp """ & PathTemp & "Cache\forge_installer.jar;" & Target & """ -jar """ & ExtractJavaWrapper() & """ com.bangbang93.ForgeInstaller """ & McFolder
Dim Arguments = "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """ -cp """ & PathTemp & "Cache\forge_installer.jar;" & Target & """ -jar """ & ExtractJavaWrapper() & """ com.bangbang93.ForgeInstaller """ & McFolder
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
@@ -1329,27 +1338,26 @@ Public Module ModDownloadLib
End If
#End Region
#Region "原版文件"
'是否已经存在原版文件
If ClientDownloadLoader Is Nothing Then Exit Sub
'等待原版文件下载完成
For Each Loader In ClientDownloadLoader.GetLoaderList
If Loader.Name <> McDownloadClientLibName Then Continue For
If Loader.State = LoadState.Loading Then
Log("[Download] Forge 安装正在等待原版文件下载完成")
Loader.WaitForExit()
End If
Exit For
Next
If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
'拷贝原版文件
If IsCustomFolder Then
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
If Not IsCustomFolder Then Exit Sub
Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
#End Region
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -192,63 +192,124 @@
End Try
End Sub
'Mod 下载;整合包另存为
Public Shared DownloadFolder = Nothing '仅在本次缓存的下载文件夹
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Try
Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ")
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If Not Project.IsModPack Then
DefaultFolder = DownloadFolder
If McVersionCurrent IsNot Nothing Then
If Not McVersionCurrent.IsLoaded Then McVersionCurrent.Load()
If McVersionCurrent.Modable Then
Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread(
Sub()
Try
Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ")
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If Not Project.IsModPack Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing 'FUTURE: Quilt 支持
If File.ModLoaders.Count > 0 Then '从文件中获取
AllowForge = False : AllowFabric = False
For Each LoaderType In File.ModLoaders
If LoaderType = "Forge" Then AllowForge = True
If LoaderType = "Fabric" Then AllowFabric = True
Next
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
AllowForge = False : AllowFabric = False
For Each LoaderType In Project.ModLoaders
If LoaderType = "Forge" Then AllowForge = True
If LoaderType = "Fabric" Then AllowFabric = True
Next
End If
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
AllowFabric IsNot Nothing AndAlso Not AllowFabric Then
AllowForge = Nothing : AllowFabric = Nothing
End If
Log("[Download] 允许 Forge:" & If(AllowForge, "未知") & ",允许 Fabric:" & If(AllowFabric, "未知"))
'判断某个版本是否符合要求
Dim IsVersionSuitable As Func(Of McVersion, Boolean) =
Function(Version)
If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False
If File.GameVersion.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersion.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso Version.Version.HasForge Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
Return False
End Function
'获取 Mod 默认下载位置
If CachedFolder IsNot Nothing Then
DefaultFolder = CachedFolder
Log("[Download] 使用上次下载时的文件夹作为默认下载位置")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = McVersionCurrent.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用当前版本的 mods 文件夹作为默认下载位置(" & McVersionCurrent.Name & ")")
Else
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
If NeedLoad Then
Hint("正在查找适合的游戏版本……")
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If
Dim SuitableVersions As New List(Of McVersion)
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
Next
If SuitableVersions.Count = 0 Then
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中未找到适合这个 Mod 的游戏版本")
Else
Log("[Download] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v)
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
End If
End If
End If
If String.IsNullOrEmpty(DefaultFolder) Then DefaultFolder = Nothing
End If
'获取基本信息
Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
Dim ChineseName As String = If(Project.ChineseName = Project.Name, "",
Project.ChineseName.Replace(" (", "Å").Split("Å").First.Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":"))
Dim FileName As String
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
FileName = If(ChineseName = "", "", "[" & ChineseName & "] ") & File.FileName
Case 1
FileName = If(ChineseName = "", "", ChineseName & "-") & File.FileName
Case 2
FileName = File.FileName & If(ChineseName = "", "", "-" & ChineseName)
Case Else
FileName = File.FileName
End Select
Dim Target As String
If File.FileName.EndsWith(".litemod") Then
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.litemod"), DefaultFolder)
Else
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.jar"), DefaultFolder)
End If
If Not Target.Contains("\") Then Exit Sub
Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " "
If Target <> DefaultFolder AndAlso Not Project.IsModPack Then DownloadFolder = GetPathFromFullPath(Target)
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(1)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback)
End Try
'获取基本信息
Dim ChineseName As String = If(Project.ChineseName = Project.Name, "",
Project.ChineseName.Replace(" (", "Å").Split("Å").First.Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":"))
Dim FileName As String
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
FileName = If(ChineseName = "", "", "[" & ChineseName & "] ") & File.FileName
Case 1
FileName = If(ChineseName = "", "", ChineseName & "-") & File.FileName
Case 2
FileName = File.FileName & If(ChineseName = "", "", "-" & ChineseName)
Case Else
FileName = File.FileName
End Select
RunInUi(
Sub()
'弹窗要求选择保存位置
Dim Target As String
If File.FileName.EndsWith(".litemod") Then
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.litemod"), DefaultFolder)
Else
Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.jar"), DefaultFolder)
End If
If Not Target.Contains("\") Then Exit Sub
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " "
If Target <> DefaultFolder AndAlso Not Project.IsModPack Then CachedFolder = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(1)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback)
End Try
End Sub, "Download CFDetail Save")
End Sub
Private Sub BtnIntroCf_Click(sender As Object, e As EventArgs) Handles BtnIntroCf.Click
@@ -51,28 +51,17 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
<local:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.3" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" />
<local:MyComboBoxItem Content="1.19" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.18.1" />
<local:MyComboBoxItem Content="1.18" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.17" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.16.4" />
<local:MyComboBoxItem Content="1.16.3" />
<local:MyComboBoxItem Content="1.16.2" />
<local:MyComboBoxItem Content="1.16.1" />
<local:MyComboBoxItem Content="1.16" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.15" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.14" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.13" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.12" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
@@ -83,9 +72,10 @@
<local:MyComboBoxItem Content="1.5.2" />
</local:MyComboBox>
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="5" MaxDropDownHeight="320" Margin="10,0,0,0">
<local:MyComboBoxItem Content="Forge 或 Fabric" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
</local:MyComboBox>
</Grid>
<Grid Margin="0,4,0,6" Height="35">
@@ -3,6 +3,7 @@
'初始化加载器信息
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject Mod", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private Shared Function LoaderInput() As DlCfProjectRequest
@@ -47,42 +47,21 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
<local:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.3" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" />
<local:MyComboBoxItem Content="1.19" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.18.1" />
<local:MyComboBoxItem Content="1.18" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.17" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.16.4" />
<local:MyComboBoxItem Content="1.16.3" />
<local:MyComboBoxItem Content="1.16.2" />
<local:MyComboBoxItem Content="1.16.1" />
<local:MyComboBoxItem Content="1.16" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.15.1" />
<local:MyComboBoxItem Content="1.15" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.14.3" />
<local:MyComboBoxItem Content="1.14.2" />
<local:MyComboBoxItem Content="1.14.1" />
<local:MyComboBoxItem Content="1.14" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.13.1" />
<local:MyComboBoxItem Content="1.13" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.12.1" />
<local:MyComboBoxItem Content="1.12" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.11" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.10" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.9" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.8" />
<local:MyComboBoxItem Content="1.7.10" />
<local:MyComboBoxItem Content="1.7.2" />
<local:MyComboBoxItem Content="1.6.4" />
@@ -3,6 +3,7 @@
'初始化加载器信息
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject ModPack", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private Shared Function LoaderInput() As DlCfProjectRequest
@@ -83,12 +83,21 @@
'加载
Dim Image As New MyBitmap(Address)
ImgBack.Tag = Address
'大小检查
Dim Scale As Integer = Image.Pic.Width / 64
If Image.Pic.Width < 32 OrElse Image.Pic.Height < 32 Then
ImgFore.Source = Nothing : ImgBack.Source = Nothing
Throw New Exception("图片大小不足,长为 " & Image.Pic.Height & ",宽为 " & Image.Pic.Width)
End If
'头发层(附加层)
If Image.Pic.Width >= 64 AndAlso Image.Pic.Height >= 32 Then
'如果图片中有透明像素,或是头部颜色和透明区均不一样,则加载附加层
If (Image.Pic.GetPixel(1, 1).A = 0 OrElse Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1).A = 0 OrElse Image.Pic.GetPixel(Image.Pic.Width - 2, 2).A = 0) OrElse
(Image.Pic.GetPixel(1, 1) <> Image.Pic.GetPixel(41, 9) AndAlso Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1) <> Image.Pic.GetPixel(41, 9) AndAlso Image.Pic.GetPixel(Image.Pic.Width - 2, 2) <> Image.Pic.GetPixel(41, 9)) Then
ImgFore.Source = New CroppedBitmap(Image, New Int32Rect(40, 8, 8, 8))
If (Image.Pic.GetPixel(1, 1).A = 0 OrElse '如果图片中有任何透明像素(避免纯色白底)
Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1).A = 0 OrElse
Image.Pic.GetPixel(Image.Pic.Width - 2, Image.Pic.Height / 2 - 2).A = 0) OrElse
(Image.Pic.GetPixel(1, 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso '或是头部颜色和透明区均不一样
Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1) <> Image.Pic.GetPixel(Scale * 41, Scale * 9) AndAlso
Image.Pic.GetPixel(Image.Pic.Width - 2, Image.Pic.Height / 2 - 2) <> Image.Pic.GetPixel(Scale * 41, Scale * 9)) Then
ImgFore.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 40, Scale * 8, Scale * 8, Scale * 8))
Else
ImgFore.Source = Nothing
End If
@@ -96,13 +105,8 @@
ImgFore.Source = Nothing
End If
'脸层
If Image.Pic.Width >= 32 AndAlso Image.Pic.Height >= 32 Then
ImgBack.Source = New CroppedBitmap(Image, New Int32Rect(8, 8, 8, 8))
Log("[Skin] 载入头像成功:" & Loader.Name)
Else
ImgBack.Source = Nothing
Throw New Exception("图片大小不足,长为 " & Image.Pic.Height & ",宽为 " & Image.Pic.Width)
End If
ImgBack.Source = New CroppedBitmap(Image, New Int32Rect(Scale * 8, Scale * 8, Scale * 8, Scale * 8))
Log("[Skin] 载入头像成功:" & Loader.Name)
Catch ex As Exception
Log(ex, "载入头像失败(" & If(Address, "null") & "," & Loader.Name & ")", LogLevel.Hint)
End Try
@@ -18,7 +18,6 @@
<local:MyListItem x:Name="ItemFeedback" IsScaleAnimationEnabled="False" Type="Clickable" Tag="3" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="反馈"
LogoScale="0.9" Logo="M613.717333 64.426667l3.413334 3.242666 331.861333 331.861334a85.333333 85.333333 0 0 1 3.2 117.269333l-3.2 3.413333L573.162667 896H960a21.333333 21.333333 0 0 1 21.333333 21.333333v42.666667a21.333333 21.333333 0 0 1-21.333333 21.333333H64a21.333333 21.333333 0 0 1-21.333333-21.333333v-42.666667a21.333333 21.333333 0 0 1 21.333333-21.333333h295.338667L74.069333 610.709333a85.333333 85.333333 0 0 1-3.221333-117.269333l3.2-3.413333 422.4-422.357334a85.333333 85.333333 0 0 1 117.269333-3.221333z m-20.629333 99.882666l-21.418667 321.493334a85.333333 85.333333 0 0 1-74.944 79.04l-4.522666 0.426666-321.493334 21.44 295.552 295.530667 422.4-422.378667L593.066667 164.309333z m-86.442667 13.824L184.533333 500.266667l301.994667-20.117334 20.117333-301.994666z" />
<local:MyListItem x:Name="ItemVote" IsScaleAnimationEnabled="False" Type="Clickable" Tag="4" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="新功能投票"
EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8"
LogoScale="0.92" Logo="M979 1024H45c-24.9 0-45-20.1-45-45s20.1-45 45-45h934c24.9 0 45 20.1 45 45s-20.1 45-45 45zM135 887C60.6 887 0 826.4 0 752V334c0-74.4 60.6-135 135-135s135 60.6 135 135v418c0 74.4-60.6 135-135 135z m0-598c-24.8 0-45 20.2-45 45v418c0 24.8 20.2 45 45 45s45-20.2 45-45V334c0-24.8-20.2-45-45-45zM512 887c-74.4 0-135-60.6-135-135V532c0-74.4 60.6-135 135-135s135 60.6 135 135v220c0 74.4-60.6 135-135 135z m0-400c-24.8 0-45 20.2-45 45v220c0 24.8 20.2 45 45 45s45-20.2 45-45V532c0-24.8-20.2-45-45-45zM889 887c-74.4 0-135-60.6-135-135V135C754 60.6 814.6 0 889 0s135 60.6 135 135v617c0 74.4-60.6 135-135 135z m0-797c-24.8 0-45 20.2-45 45v617c0 24.8 20.2 45 45 45s45-20.2 45-45V135c0-24.8-20.2-45-45-45z" />
</StackPanel>
</local:MyPageLeft>
@@ -122,9 +122,17 @@
FrmOtherHelp.SearchBox.Text = ""
End Sub
'打开反馈
'打开网页
Public Shared Sub TryFeedback() Handles ItemFeedback.Click
If CanFeedback(True) Then Feedback(True, False)
If Not CanFeedback(True) Then Exit Sub
If MyMsgBox("是否要打开反馈列表网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"提醒", "打开", "取消") = 2 Then Exit Sub
Feedback(True, False)
End Sub
Public Shared Sub TryVote() Handles ItemVote.Click
If MyMsgBox("是否要打开新功能投票网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"提醒", "打开", "取消") = 2 Then Exit Sub
OpenWebsite("https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8?discussions_q=category%3A%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8+sort%3Adate_created")
End Sub
End Class
@@ -899,5 +899,14 @@
<ItemGroup>
<Resource Include="Resources\ModData.txt" />
</ItemGroup>
<ItemGroup>
<Resource Include="Images\Skins\Ari.png" />
<Resource Include="Images\Skins\Efe.png" />
<Resource Include="Images\Skins\Kai.png" />
<Resource Include="Images\Skins\Makena.png" />
<Resource Include="Images\Skins\Noor.png" />
<Resource Include="Images\Skins\Sunny.png" />
<Resource Include="Images\Skins\Zuri.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>
Binary file not shown.
Binary file not shown.