InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

2.5.0

Browse Source
This commit is contained in:
龙腾猫跃
2023-02-16 22:21:04 +08:00
parent a9bf0b682a
commit 6dc8789ac0
32 changed files with 3605 additions and 2453 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Controls/MyCard.vb
+13 -7
View File
@@ -96,8 +96,8 @@
Return VersionSortBoolean(Left.Version, Right.Version)
End Function)
Case 8, 9
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlCfFile)), Function(Left As DlCfFile, Right As DlCfFile) As Boolean
Return Left.Date > Right.Date
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
End Select
'控件转换
@@ -113,7 +113,7 @@
Case 6
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
Case 8
DlCfFilesPreload(Stack, Stack.Tag, AddressOf FrmDownloadMod.ProjectClick)
CompFilesCardPreload(Stack, Stack.Tag, AddressOf FrmDownloadMod.ProjectClick)
End Select
'实现控件虚拟化
For Each Data As Object In Stack.Tag
@@ -134,9 +134,9 @@
FrmDownloadInstall.MinecraftSelected(sender, e)
End Sub, False))
Case 8
Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Save_Click))
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
Case 9
Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Install_Click, AddressOf FrmDownloadCfDetail.Save_Click))
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11
@@ -173,7 +173,11 @@
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
'高度改变动画
#Region "高度改变动画"
''' <summary>
''' 是否启用高度改变动画。
''' </summary>
Public Property UseAnimation As Boolean = True
Private IsHeightAnimating As Boolean = False
Private ActualUsedHeight As Double '回滚实际高度（例如 NaN）
@@ -221,6 +225,8 @@
IsHeightAnimating = False
End Sub
#End Region
'折叠
'若设置了 CanSwap，或 SwapControl 不为空，则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl
@@ -237,7 +243,7 @@
Get
Return _IsSwaped
End Get
Set(ByVal value As Boolean)
Set(value As Boolean)
If _IsSwaped = value Then Exit Property
_IsSwaped = value
If SwapControl Is Nothing Then Exit Property
Plain Craft Launcher 2/FormMain.xaml.vb
+30 -14
View File
@@ -126,6 +126,13 @@ Public Class FormMain
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'1：BUG-
If LastVersion < 283 Then 'Snapshot 2.5.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 Modrinth 整合包"))
FeatureCount += 5
BugCount += 5
End If
If LastVersion < 282 Then 'Snapshot 2.4.9
FeatureCount += 1
BugCount += 5
@@ -507,7 +514,7 @@ Reopen:
Dim UnlockedTheme As New List(Of String) From {"2"}
UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide").ToString.Split("|")))
UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")))
Setup.Set("UiLauncherThemeHide2", Join(ArrayNoDouble(UnlockedTheme), "|"))
Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme.Distinct.ToList, "|"))
End If
'重置欧皇彩
If LastVersionCode <= 115 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
@@ -866,7 +873,7 @@ Install:
Exit Sub
End If
'安装整合包
If {"zip", "rar"}.Contains(Extension) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试
If {"zip", "rar", "mrpack"}.Contains(Extension) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试
Log("[System] 文件为压缩包，尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
End If
@@ -1010,9 +1017,9 @@ Install:
''' </summary>
VersionSetup
''' <summary>
''' CurseForge 工程详情。这是一个副页面。
''' 资源工程详情。这是一个副页面。
''' </summary>
CfDetail
CompDetail
''' <summary>
''' 帮助详情。这是一个副页面。
''' </summary>
@@ -1059,13 +1066,20 @@ Install:
Return "下载管理"
Case PageType.VersionSetup
Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name)
Case PageType.CfDetail
Case PageType.CompDetail
If Stack.Additional Is Nothing Then
Log("[Control] CurseForge 工程详情页面未提供关键项", LogLevel.Feedback)
Log("[Control] 资源工程详情页面未提供关键项", LogLevel.Feedback)
Return "未知页面"
Else
Dim Project As DlCfProject = Stack.Additional
Return If(Project.IsModPack, "整合包下载 - ", "Mod 下载 - ") & Project.ChineseName
Dim Project As CompProject = Stack.Additional
Select Case Project.Type
Case CompType.Mod
Return "Mod 下载 - " & Project.TranslatedName
Case CompType.ModPack
Return "整合包下载 - " & Project.TranslatedName
Case Else 'CompType.ResourcePack
Return "资源包下载 - " & Project.TranslatedName
End Select
End If
Case PageType.HelpDetail
If Stack.Additional Is Nothing Then
@@ -1303,9 +1317,9 @@ Install:
Case PageType.VersionSetup '版本设置
If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
PageChangeAnim(FrmVersionLeft, FrmVersionLeft.PageGet(SubType))
Case PageType.CfDetail 'Mod 信息
If FrmDownloadCfDetail Is Nothing Then FrmDownloadCfDetail = New PageDownloadCfDetail
PageChangeAnim(New MyPageLeft, FrmDownloadCfDetail)
Case PageType.CompDetail 'Mod 信息
If FrmDownloadCompDetail Is Nothing Then FrmDownloadCompDetail = New PageDownloadCompDetail
PageChangeAnim(New MyPageLeft, FrmDownloadCompDetail)
Case PageType.HelpDetail '帮助详情
PageChangeAnim(New MyPageLeft, Stack.Additional(1))
End Select
@@ -1505,14 +1519,16 @@ Install:
Return HasRunningMinecraft
End Function
'返回顶部
Private Sub BtnExtraBack_Click(sender As Object, e As EventArgs) Handles BtnExtraBack.Click
''' <summary>
''' 返回顶部。
''' </summary>
Public Sub BackToTop() Handles BtnExtraBack.Click
Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
End Sub
Private Function BtnExtraBack_ShowCheck() As Boolean
Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild()
Return RealScroll IsNot Nothing AndAlso RealScroll.Visibility = Visibility.Visible AndAlso RealScroll.VerticalOffset > Height + If(BtnExtraBack.Show, 0, 1500)
Return RealScroll IsNot Nothing AndAlso RealScroll.Visibility = Visibility.Visible AndAlso RealScroll.VerticalOffset > Height + If(BtnExtraBack.Show, 0, 700)
End Function
Private Function BtnExtraBack_GetRealChild() As MyScrollViewer
If PanMainRight.Child Is Nothing Then Return Nothing
Plain Craft Launcher 2/Images/Icons/NoIcon.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 312 B

After

Width:  |  Height:  |  Size: 3.8 KiB

Plain Craft Launcher 2/Modules/Base/ModBase.vb
+7 -36
View File
@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.4.9" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.9." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.5.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.5.0." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 281 'Release
#Else
Public Const VersionCode As Integer = 282 'Snapshot
Public Const VersionCode As Integer = 283 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1241,7 +1241,7 @@ Re:
Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
Try
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWith(".zip") OrElse CompressFilePath.EndsWith(".jar") Then
If CompressFilePath.EndsWith(".zip") OrElse CompressFilePath.EndsWith(".jar") OrElse CompressFilePath.EndsWith(".mrpack") Then
'以 zip 方式解压
ZipFile.ExtractToDirectory(CompressFilePath, DestDirectory, If(Encode, Encoding.GetEncoding("GB18030")))
Return True
@@ -1757,25 +1757,7 @@ Re:
''' <summary>
''' 数组去重。
''' </summary>
Public Function ArrayNoDouble(Of T)(Arr As T(), Optional IsEqual As CompareThreadStart = Nothing) As T()
Dim ResultArray As New List(Of T)
For i = 0 To UBound(Arr)
For ii = i + 1 To UBound(Arr)
If IsEqual Is Nothing Then
If Arr(i).Equals(Arr(ii)) Then GoTo NextElement
Else
If IsEqual(Arr(i), Arr(ii)) Then GoTo NextElement
End If
Next
ResultArray.Add(Arr(i))
NextElement:
Next i
Return ResultArray.ToArray
End Function
''' <summary>
''' 数组去重。
''' </summary>
Public Function ArrayNoDouble(Of T)(Arr As List(Of T), Optional IsEqual As CompareThreadStart = Nothing) As List(Of T)
Public Function Distinct(Of T)(Arr As ICollection(Of T), Optional IsEqual As CompareThreadStart(Of T) = Nothing) As List(Of T)
Dim ResultArray As New List(Of T)
For i = 0 To Arr.Count - 1
For ii = i + 1 To Arr.Count - 1
@@ -1790,17 +1772,6 @@ NextElement:
Next i
Return ResultArray
End Function
''' <summary>
''' 若 Key 不存在于辞典，则加入辞典。
''' 若 Key 已存在于辞典，则更新 Value。
''' </summary>
Public Sub DictionaryAdd(Of TKey, TValue)(ByRef Dict As Dictionary(Of TKey, TValue), Key As TKey, Value As TValue)
If Dict.ContainsKey(Key) Then
Dict(Key) = Value
Else
Dict.Add(Key, Value)
End If
End Sub
''' <summary>
''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
@@ -2016,7 +1987,7 @@ NextElement:
''' 按照既定的函数进行选择排序。
''' </summary>
''' <param name="SortRule">传入两个对象，若第一个对象应该排在前面，则返回 True。</param>
Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart) As List(Of T)
Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T)
Dim NewList As New List(Of T)
While List.Count > 0
Dim Highest = List(0)
@@ -2028,7 +1999,7 @@ NextElement:
End While
Return NewList
End Function
Public Delegate Function CompareThreadStart(Left, Right) As Boolean
Public Delegate Function CompareThreadStart(Of T)(Left As T, Right As T) As Boolean
''' <summary>
''' 获取程序启动参数。
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+1 -1
View File
@@ -679,7 +679,7 @@ Restart:
Log(ex, "文件夹加载器启动检测出错")
End Try
'写入检查数据
DictionaryAdd(LoaderFolderDictionary, Loader, Value)
LoaderFolderDictionary(Loader) = Value
'开始检查
If Type = LoaderFolderRunType.UpdateOnly Then Return False
If WaitForExit Then
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+3 -3
View File
@@ -891,7 +891,7 @@ RequestFinished:
Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing)
Dim Sources As New List(Of NetSource)
Dim Count As Integer = 0
Urls = ArrayNoDouble(Urls)
Urls = Urls.Distinct.ToArray
For Each Source As String In Urls
Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing})
Count += 1
@@ -1585,7 +1585,7 @@ NextElement:
For Each Folder In McFolderList
Folders.Add(Folder.Path)
Next
Folders = ArrayNoDouble(Folders)
Folders = Folders.Distinct.ToList
For Each Folder In Folders
If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
Next
@@ -1725,7 +1725,7 @@ Retry:
For Each Ex As Exception In ExList
ErrOutput.Add(GetExceptionDetail(Ex))
Next
Log("[Download] " & Join(ArrayNoDouble(ErrOutput.ToArray), vbCrLf))
Log("[Download] " & Join(ErrOutput.Distinct.ToArray, vbCrLf))
End Sub
Public Overrides Sub Abort()
SyncLock LockState
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+1216
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+10 -8
View File
@@ -63,7 +63,7 @@
End Try
PossibleLogs.Add(VersionPathIndie & "logs\latest.log") 'Minecraft 日志
PossibleLogs.Add(VersionPathIndie & "logs\debug.log") 'Minecraft Debug 日志
PossibleLogs = ArrayNoDouble(PossibleLogs)
PossibleLogs = PossibleLogs.Distinct.ToList
'确定最新的日志文件
Dim RightLogs As New List(Of String)
@@ -238,7 +238,7 @@
'创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles
DictionaryAdd(FileNameDict, GetFileNameFromPath(SelectedFile.Key).ToLower, SelectedFile)
FileNameDict(GetFileNameFromPath(SelectedFile.Key).ToLower) = SelectedFile
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为 Minecraft 或启动器日志")
Next
@@ -399,7 +399,7 @@
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
If Keywords.Count > 0 Then
AppendReason(CrashReason.MC日志堆栈分析发现关键字, ArrayNoDouble(Keywords))
AppendReason(CrashReason.MC日志堆栈分析发现关键字, Keywords.Distinct.ToList)
GoTo Done
End If
End If
@@ -429,7 +429,7 @@ Done:
If CrashReasons.ContainsKey(Reason) Then
If Additional IsNot Nothing Then
CrashReasons(Reason).AddRange(Additional)
CrashReasons(Reason) = ArrayNoDouble(CrashReasons(Reason))
CrashReasons(Reason) = CrashReasons(Reason).Distinct.ToList
End If
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
@@ -464,6 +464,8 @@ Done:
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>(int[], int, net.minecraft.core.Direction, net.minecraft.client.renderer.texture.TextureAtlasSprite, boolean, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager.addRegionTicket(net.minecraft.server.level.TicketType, net.minecraft.world.level.ChunkPos, int, java.lang.Object, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9)
If LogMc.Contains("java.lang.NoSuchFieldException: ucp") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高)
@@ -584,7 +586,7 @@ Done:
PossibleStacks.Add(Stack.Trim) '.Split("$").First)
NextStack:
Next
PossibleStacks = ArrayNoDouble(PossibleStacks)
PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
If PossibleStacks.Count = 0 Then Return New List(Of String)
For Each Stack As String In PossibleStacks
@@ -608,7 +610,7 @@ NextStack:
PossibleWords.Add(Word.Trim)
Next
Next
PossibleWords = ArrayNoDouble(PossibleWords)
PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Count > 10 Then
@@ -666,7 +668,7 @@ NextStack:
Exit For
Next
Next
HintLines = ArrayNoDouble(HintLines)
HintLines = HintLines.Distinct.ToList
Log("[Crash] 找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
For Each ModName As String In HintLines
Log("[Crash] - " & ModName)
@@ -682,7 +684,7 @@ NextStack:
End If
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
ModFileNames = ArrayNoDouble(ModFileNames)
ModFileNames = ModFileNames.Distinct.ToList
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+7 -710
View File
@@ -335,7 +335,7 @@
''' </summary>
Public ReleaseTime As String
''' <summary>
''' 需要的最低 Forge 版本。空字符串为无限制，“28.1.56” 表示版本号，“1161” 表示版本号的最后一位。
''' 需要的最低 Forge 版本。空字符串为无限制，Nothing 为不兼容，“28.1.56” 表示版本号，“1161” 表示版本号的最后一位。
''' </summary>
Public RequiredForgeVersion As String
End Class
@@ -389,6 +389,7 @@
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ToLower.Contains("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
@@ -413,6 +414,7 @@
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
@@ -944,719 +946,14 @@
''' <summary>
''' Fabric API 列表，官方源。
''' </summary>
Public DlFabricApiLoader As New LoaderTask(Of Integer, List(Of DlCfFile))("Fabric API List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of DlCfFile))) Task.Output = DlCfGetFiles(306612, False))
Public DlFabricApiLoader As New LoaderTask(Of Integer, List(Of CompFile))("Fabric API List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet("fabric-api", False))
''' <summary>
''' OptiFabric 列表，官方源。
''' </summary>
Public DlOptiFabricLoader As New LoaderTask(Of Integer, List(Of DlCfFile))("OptiFabric List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of DlCfFile))) Task.Output = DlCfGetFiles(322385, False))
#End Region
#Region "DlCfProject | CurseForge 工程"
Private DlCfProjectDb As Dictionary(Of String, DlCfDbEntry) = Nothing
Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject)
''' <summary>
''' CurseForge 工程列表获取、搜索请求。
''' </summary>
Public Class DlCfProjectRequest
Public CategoryId As Integer = 0 '421: Mod(?), 4780: Fabric
Public IsModPack As Boolean = False
Public GameVersion As String = Nothing
Public PageSize As Integer = 50
Public SearchFilter As String = Nothing
Public Index As Integer? = Nothing
Public ModLoader As Integer? = Nothing
Public Function GetAddress() As String
GetAddress = "https://api.curseforge.com/v1/mods/search?gameId=432&sortField=Featured&sortOrder=desc" &
"&pageSize=" & PageSize &
"&categoryId=" & CategoryId &
If(IsModPack, "&classId=4471", "&classId=6") &
If(String.IsNullOrEmpty(GameVersion), "", "&gameVersion=" & GameVersion) &
If(String.IsNullOrEmpty(SearchFilter), "", "&searchFilter=" & Net.WebUtility.UrlEncode(SearchFilter)) &
If(Index IsNot Nothing, "&index=" & Index, "") &
If(ModLoader IsNot Nothing AndAlso ModLoader > 0, "&modLoaderType=" & ModLoader, "")
End Function
#Region "相同判断"
Public Overrides Function Equals(obj As Object) As Boolean
Dim request = TryCast(obj, DlCfProjectRequest)
Return request IsNot Nothing AndAlso request.GetAddress = GetAddress()
End Function
Public Shared Operator =(left As DlCfProjectRequest, right As DlCfProjectRequest) As Boolean
Return EqualityComparer(Of DlCfProjectRequest).Default.Equals(left, right)
End Operator
Public Shared Operator <>(left As DlCfProjectRequest, right As DlCfProjectRequest) As Boolean
Return Not left = right
End Operator
#End Region
End Class
''' <summary>
''' CurseForge 工程信息。
''' </summary>
Public Class DlCfProject
Public Id As Integer
Public Name As String
Public Description As String
Public Website As String
Public DateUpdate As Date
Public DownloadCount As Integer
Public ModLoaders As New List(Of String)
Public GameVersionDesc As String
Private CategoryDesc As List(Of String)
Private Thumb As String
Public IsModPack As Boolean
Public FileIndexes As New List(Of Integer)
Public Files As List(Of DlCfFile)
Private _MCBBS As Integer?
Public Property MCBBS As Integer?
Get
ReleaseCfDatabase()
If _MCBBS Is Nothing Then
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then _MCBBS = DlCfProjectDb(Keyword).MCBBS
End If
End If
Return _MCBBS
End Get
Set(value As Integer?)
_MCBBS = value
End Set
End Property
Private _ChineseName As String
Public Property ChineseName As String
Get
ReleaseCfDatabase()
If _ChineseName Is Nothing Then
_ChineseName = Name
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
Dim Result = DlCfProjectDb(Keyword)
If Not String.IsNullOrEmpty(Result.ChineseName) Then '使用原名
_ChineseName = Result.ChineseName
End If
End If
End If
End If
Return _ChineseName
End Get
Set(value As String)
_ChineseName = value
End Set
End Property
Private _WikiId As Integer = -1
''' <summary>
''' MCMOD 的页面 ID。若为 0 则代表没有对应页面。
''' </summary>
Public Property WikiId As Integer
Get
ReleaseCfDatabase()
If _WikiId = -1 Then
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
_WikiId = DlCfProjectDb(Keyword).WikiId
Else
_WikiId = 0
End If
End If
End If
Return _WikiId
End Get
Set(value As Integer)
_WikiId = value
End Set
End Property
''' <summary>
''' 从 CurseForge 工程 Json 项中初始化实例。若出错会抛出异常。
''' </summary>
Public Sub New(Data As JObject)
'https://api.curseforge.com/v1/mods/search?gameId=432&pageSize=5&categoryID=421
Id = Data("id")
Name = Data("name")
Description = Data("summary")
Website = Data("links")("websiteUrl")
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
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)
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)
FileIndexes.Add(File("fileId"))
Next
GameVersions = Sort(GameVersions.Distinct.ToList, AddressOf VersionSortBoolean)
If GameVersions.Count = 0 Then
GameVersionDesc = ""
Else
Dim SpaVersions As New List(Of String)
For i = 0 To GameVersions.Count - 1
Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i)
For ii = i + 1 To GameVersions.Count - 1
If GameVersions(ii) = EndVersion - 1 Then
EndVersion = GameVersions(ii)
i = ii
Else
Exit For
End If
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)
End If
Next
GameVersionDesc = "[" & Join(SpaVersions, ", ") & "] "
End If
'获取分类
Dim Categories = Data("categories")
Dim CategoryId As New List(Of Integer)
For Each CategoryToken In Categories
CategoryId.Add(CategoryToken("id"))
Next
CategoryId = ArrayNoDouble(CategoryId)
CategoryId.Sort()
CategoryDesc = New List(Of String)
For Each Category In CategoryId
Dim Desc As String
Select Case Category
Case 406 : Desc = "世界生成"
Case 407 : Desc = "生物群系"
Case 409 : Desc = "天然结构"
Case 410 : Desc = "维度"
Case 411 : Desc = "生物"
Case 412 : Desc = "科技"
Case 414 : Desc = "交通与移动"
Case 415 : Desc = "管道与物流"
Case 417 : Desc = "能源"
Case 4558 : Desc = "红石"
Case 420 : Desc = "仓储"
Case 416 : Desc = "农业"
Case 436 : Desc = "食物"
Case 419 : Desc = "魔法"
Case 434 : Desc = "装备与工具"
Case 422 : Desc = "冒险与探索"
Case 424 : Desc = "建筑与装饰"
Case 423 : Desc = "信息显示"
Case 425 : Desc = "杂项"
Case 421 : Desc = "支持库"
Case 435 : Desc = "服务器"
Case 4471 : Desc = "科幻"
Case 4483 : Desc = "战斗"
Case 4477 : Desc = "小游戏"
Case 4478 : Desc = "任务"
Case 4484 : Desc = "多人"
Case 4476 : Desc = "探索"
Case 4736 : Desc = "空岛"
Case 4475 : Desc = "冒险"
Case 4487 : Desc = "FTB"
Case 4480 : Desc = "基于地图"
Case 4479 : Desc = "硬核"
Case 4472 : Desc = "科技"
Case 4473 : Desc = "魔法"
Case 4481 : Desc = "小型整合"
Case 4482 : Desc = "大型整合"
Case Else : Continue For
End Select
CategoryDesc.Add(Desc)
Next
If CategoryDesc.Count = 0 Then CategoryDesc.Add("杂类")
'获取图片
If Data("logo").Count > 0 Then
If GetPixelSize(1) > 1.25 Then
Thumb = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标
Else
Thumb = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标
End If
End If
'保存缓存
If Not DlCfProjectCache.ContainsKey(Id) OrElse DlCfProjectCache(Id).Files Is Nothing Then DictionaryAdd(DlCfProjectCache, Id, Me)
End Sub
Public Function ToCfItem(ShowVersionDesc As Boolean, ShowLoaderDesc As Boolean, Optional OnClick As MyCfItem.ClickEventHandler = Nothing) As MyCfItem
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, "")).Replace("] [", " ") &
Join(CategoryDesc, "，") & " (" &
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
NewItem.Logo = Thumb
End If
If OnClick IsNot Nothing Then
AddHandler NewItem.Click, OnClick
NewItem.HasAnimation = True
Else
NewItem.HasAnimation = False
End If
'结束
Return NewItem
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Dim project = TryCast(obj, DlCfProject)
Return project IsNot Nothing AndAlso Id = project.Id
End Function
Public Shared Operator =(left As DlCfProject, right As DlCfProject) As Boolean
Return EqualityComparer(Of DlCfProject).Default.Equals(left, right)
End Operator
Public Shared Operator <>(left As DlCfProject, right As DlCfProject) As Boolean
Return Not left = right
End Operator
End Class
Public Class DlCfProjectResult
Public Projects As List(Of DlCfProject)
Public Index As Integer
Public RealCount As Long
End Class
''' <summary>
''' CurseForge 工程列表获取事件。
''' </summary>
Public Sub DlCfProjectSub(Task As LoaderTask(Of DlCfProjectRequest, DlCfProjectResult))
'拒绝 1.13- Quilt（这个版本根本没有 Quilt）
If Not Task.Input.IsModPack AndAlso
If(Task.Input.ModLoader, 0) = 5 AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion)
End If
Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim
Task.Input.SearchFilter = RawFilter
RawFilter = RawFilter.ToLower
Log("[Download] CurseForge 工程列表搜索原始文本：" & RawFilter)
'中文请求关键字处理
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]")
If IsChineseSearch AndAlso Not String.IsNullOrEmpty(RawFilter) Then
If Task.Input.IsModPack Then Throw New Exception("整合包搜索仅支持英文")
ReleaseCfDatabase()
'构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of DlCfDbEntry))
For Each Entry In DlCfProjectDb.Values
If Entry.ChineseName.Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
SearchEntries.Add(New SearchEntry(Of DlCfDbEntry) With {
.Item = Entry,
.SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(Entry.ChineseName & Entry.CurseForgeId, 1)
}
})
Next
'获取搜索结果
Dim SearchResults = Search(SearchEntries, Task.Input.SearchFilter, 3)
If SearchResults.Count = 0 Then Throw New Exception("无搜索结果，请尝试搜索英文名称")
Dim SearchResult As String = ""
For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的，也最多只要 5 个
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
SearchResult += SearchResults(i).Item.CurseForgeId.Replace("-", " ") & " "
SearchResult += SearchResults(i).Item.ChineseName.Replace(" (", "|").Split("|").Last.TrimEnd(") ").Replace(" - ", "§").Split("§").First & " "
Next
Log("[Download] CurseForge 中文搜索原始关键词：" & SearchResult, LogLevel.Developer)
'去除常见连接词
Dim RealFilter As String = ""
For Each Word In SearchResult.Split(" ")
If {"the", "of", "a", "mod"}.Contains(Word.ToLower) OrElse Val(Word) > 0 Then Continue For
If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
Next
Task.Input.SearchFilter = RealFilter
Log("[Download] CurseForge 中文搜索最终关键词：" & RealFilter, LogLevel.Developer)
End If
'驼峰英文请求关键字处理
Dim SpacedKeywords = RegexReplace(Task.Input.SearchFilter, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)")
Dim ConnectedKeywords = Task.Input.SearchFilter.Replace(" ", "")
Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchFilter, ConnectedKeywords & " " & RawFilter)).ToLower
'最终处理关键字：分割、去重
Dim RightKeywords As New List(Of String)
For Each Keyword In AllPossibleKeywords.Split(" ")
If Keyword.Trim = "" Then Continue For
If {"forge", "fabric", "for", "mod",
"forge/fabric", "fabric/forge", "fabric/quilt", "quilt/fabric"}.Contains(Keyword) Then 'https://github.com/Hex-Dragon/PCL2/issues/208
Log("[Download] 已跳过搜索关键词：" & Keyword, LogLevel.Developer)
Continue For
End If
RightKeywords.Add(Keyword)
Next
If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then
Task.Input.SearchFilter = RawFilter '全都被过滤掉了
Else
Task.Input.SearchFilter = Join(ArrayNoDouble(RightKeywords), " ").ToLower
End If
'例外项：OptiForge、OptiFabric（拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod）
If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchFilter = "optiforge"
If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchFilter = "optifabric"
Log("[Download] CurseForge 工程列表搜索最终文本：" & Task.Input.SearchFilter, LogLevel.Developer)
'正式获取
Dim Url = Task.Input.GetAddress()
Log("[Download] 开始获取 CurseForge 工程列表：" & Url)
Dim RequestResult As JObject = NetGetCodeByRequestRetry(Url, IsJson:=True, Encode:=Encoding.UTF8)
Dim FileList = GetCfProjectListFromJson(RequestResult("data"), Task.Input.IsModPack)
If FileList.Count = 0 Then Throw New Exception("无搜索结果")
'重新排序
If Not String.IsNullOrEmpty(Task.Input.SearchFilter) Then
'排序分 = 搜索相对相似度 + 默认排序相对活跃度
Dim Scores As New Dictionary(Of DlCfProject, Double)
Dim Entry As New List(Of SearchEntry(Of DlCfProject))
For i = 1 To FileList.Count
Dim File = FileList(i - 1)
Scores.Add(File, (1 - (i / FileList.Count)))
Entry.Add(New SearchEntry(Of DlCfProject) With {.Item = File, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(If(IsChineseSearch, File.ChineseName, File.Name), 1),
New KeyValuePair(Of String, Double)(File.Description, 0.05)}})
Next
Dim SearchResult = Search(Entry, RawFilter, 101, -1)
For Each OneResult In SearchResult
Scores(OneResult.Item) += OneResult.Similarity / SearchResult(0).Similarity
Next
'根据排序分得出结果
Dim ResultList = Sort(Scores.ToList, Function(Left As KeyValuePair(Of DlCfProject, Double), Right As KeyValuePair(Of DlCfProject, Double))
Return Left.Value > Right.Value
End Function)
FileList = New List(Of DlCfProject)
For Each Result In ResultList
FileList.Add(Result.Key)
Next
End If
Task.Output = New DlCfProjectResult With {.Projects = FileList, .Index = RequestResult("pagination")("index"), .RealCount = RequestResult("pagination")("totalCount")}
End Sub
''' <summary>
''' 从 API 返回的 Json 数组中获取工程信息数组。
''' </summary>
Private Function GetCfProjectListFromJson(Json As JArray, IsModPack As Boolean) As List(Of DlCfProject)
Dim FileList As New List(Of DlCfProject)
For Each JsonEntry As JObject In Json
Dim Result = GetCfProjectFromJson(JsonEntry, IsModPack)
If Result IsNot Nothing Then FileList.Add(Result)
Next
Return FileList
End Function
''' <summary>
''' 从 API 返回的 Json 中获取工程信息。
''' </summary>
Private Function GetCfProjectFromJson(Json As JObject, IsModPack As Boolean) As DlCfProject
If Json("links")("websiteUrl") Is Nothing Then
Log("[Download] 发现关键项为 Nothing 的工程：" & If(Json, "").ToString, LogLevel.Debug)
Return Nothing
End If
If IsModPack = Json("links")("websiteUrl").ToString.Contains("curseforge.com/minecraft/mc-mods") Then
Log("[Download] 返回的工程与要求的类别不一致：" & Json("links")("websiteUrl").ToString, LogLevel.Debug)
Return Nothing
End If
Return New DlCfProject(Json)
End Function
''' <summary>
''' 读取 Mod 数据库。
''' </summary>
Private Sub ReleaseCfDatabase()
If DlCfProjectDb IsNot Nothing Then Exit Sub
DlCfProjectDb = New Dictionary(Of String, DlCfDbEntry)
Dim i As Integer = 0
For Each Line In DecodeBytes(GetResources("ModData")).Split(vbLf)
i += 1
If Line = "" Then Continue For
For Each EntryData As String In Line.Split("¨")
Dim Entry = New DlCfDbEntry
Dim SplitedLine = EntryData.Split("|")
Entry.CurseForgeId = SplitedLine(0)
Entry.WikiId = i
If SplitedLine.Count >= 2 Then
Entry.ChineseName = SplitedLine(1)
Entry.MCBBS = If(SplitedLine.Count >= 3, SplitedLine(2), Nothing)
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*", " (" &
String.Join(" ", Entry.CurseForgeId.Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
End If
End If
DlCfProjectDb(Entry.CurseForgeId) = Entry
Next
Next
End Sub
Public Class DlCfDbEntry
''' <summary>
''' McMod 的 ID。
''' </summary>
Public WikiId As Integer
''' <summary>
''' 中文译名。若为空字符串则使用英文名。
''' </summary>
Public ChineseName As String = ""
''' <summary>
''' MCBBS 发布帖编号（例如 195107）。若为 Nothing 则没有发布帖。
''' </summary>
Public MCBBS As Integer?
''' <summary>
''' CurseForge ID（例如 advanced-solar-panels）。
''' </summary>
Public CurseForgeId As String
Public Overrides Function ToString() As String
Return CurseForgeId & "|" & WikiId & "|" & ChineseName & If(MCBBS Is Nothing, "", "|" & MCBBS)
End Function
End Class
#End Region
#Region "DlCfFile | CurseForge Files"
Public DlCfFileLoader As New LoaderTask(Of KeyValuePair(Of Integer, Boolean), List(Of DlCfFile))("DlCfFile Main", Sub(Task As LoaderTask(Of KeyValuePair(Of Integer, Boolean), List(Of DlCfFile))) Task.Output = DlCfGetFiles(Task.Input.Key, Task.Input.Value))
''' <summary>
''' CurseForge 工程下的单一版本文件。
''' </summary>
Public Class DlCfFile
Public IsModPack As Boolean
Public FileId As Integer
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
Public Dependencies As New List(Of Integer)
Private DownloadAddress As String()
Public ReadOnly Property ReleaseTypeString As String
Get
Select Case ReleaseType
Case 1
Return "正式版"
Case 2
Return If(ModeDebug, "Beta 测试版", "测试版")
Case Else
Return If(ModeDebug, "Alpha 测试版", "测试版")
End Select
End Get
End Property
Public ReadOnly Property IsAvailable As Boolean
Get
Return DisplayName IsNot Nothing AndAlso GameVersion IsNot Nothing AndAlso FileName IsNot Nothing AndAlso DownloadAddress(0).StartsWith("http")
End Get
End Property
''' <summary>
''' 从 CurseForge 文件 Json 项中初始化实例。若出错会抛出异常。
''' </summary>
Public Sub New(Data As JObject, IsModPack As Boolean)
FileId = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
[Date] = Data("fileDate")
ReleaseType = Data("releaseType")
DownloadCount = Data("downloadCount")
FileName = Data("fileName")
Me.IsModPack = IsModPack
'获取下载地址
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = "https://media.forgecdn.net/files/" & FileId.ToString.Substring(0, 4) & "/" & FileId.ToString.Substring(4).TrimStart("0") & "/" & FileName
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadAddress = ArrayNoDouble({Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), Url.Replace("-service.overwolf.wtf", ".forgecdn.net"), Url.Replace("://edge", "://media"), Url})
'获取前置 Mod 的 Addon ID
If Not IsModPack Then
For Each Dep In Data("dependencies")
If Dep("relationType").ToObject(Of Integer) = 3 AndAlso '是一个依赖
Dep("modId").ToObject(Of Integer) <> 306612 Then '排除 Fabric API
Dependencies.Add(Dep("modId"))
End If
Next
End If
'获取游戏版本与 Mod 加载器列表
Dim Versions As New List(Of String)
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.Replace("-snapshot", " 快照"))
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
GameVersion = Sort(Versions, AddressOf VersionSortBoolean).ToArray
If IsModPack Then GameVersion = {GameVersion(0)}
ElseIf Versions.Count = 1 Then
GameVersion = Versions.ToArray
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>
''' 获取对应的下载文件信息。
''' </summary>
''' <param name="LocalAddress">本地文件夹或文件地址。</param>
Public Function GetDownloadFile(LocalAddress As String, IsFullPath As Boolean) As NetFile
Return New NetFile(DownloadAddress, LocalAddress & If(IsFullPath, "", FileName))
End Function
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing) As MyListItem
'获取描述信息
Dim Info As String = ""
If Not IsModPack Then
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
'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, "")
'建立控件
Dim NewItem As New MyListItem With {
.Title = DisplayName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info
}
Select Case ReleaseType
Case 1 'R
NewItem.Logo = "pack://application:,,,/images/Icons/R.png"
Case 2 'B
NewItem.Logo = "pack://application:,,,/images/Icons/B.png"
Case Else 'A
NewItem.Logo = "pack://application:,,,/images/Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
'建立另存为按钮
If OnSaveClick IsNot Nothing Then
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnSave, 30)
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, OnSaveClick
NewItem.Buttons = {BtnSave}
NewItem.PaddingRight = 35
End If
'结束
Return NewItem
End Function
Public Overrides Function ToString() As String
Return DisplayName
End Function
End Class
''' <summary>
''' 获取某个 CurseForge 工程下的全部文件列表。
''' 必须在工作线程执行，失败会抛出异常。
''' </summary>
Public Function DlCfGetFiles(ProjectId As Integer, IsModPack As Boolean) As List(Of DlCfFile)
'获取工程对象
Dim TargetProject As DlCfProject
If DlCfProjectCache.ContainsKey(ProjectId) Then
TargetProject = DlCfProjectCache(ProjectId)
Else
TargetProject = GetCfProjectFromJson(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data"), IsModPack)
End If
'获取工程对象的文件列表
If TargetProject.Files Is Nothing Then
Log("[Download] 开始获取 CurseForge 工程 ID 为 " & ProjectId & " 的文件列表")
Dim Json As JArray
If TargetProject.IsModPack Then
'整合包使用全部文件
Json = NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId & "/files?pageSize=999", Accept:="application/json", IsJson:=True)("data")
Else
'Mod 使用每个版本最新的文件
Json = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.FileIndexes, ",") & "]}", "application/json"))("data")
End If
Dim Files As New Dictionary(Of Integer, DlCfFile)
For Each JsonEntry As JObject In Json
Dim NewFile As New DlCfFile(JsonEntry, IsModPack)
If NewFile.IsAvailable AndAlso Not Files.ContainsKey(NewFile.FileId) Then Files.Add(NewFile.FileId, NewFile)
Next
TargetProject.Files = Files.Values.ToList
End If
'获取前置 Mod 列表
If IsModPack Then GoTo ExitSub
Dim Deps As New List(Of Integer)
For Each File In TargetProject.Files
For Each AddonId In File.Dependencies
If Not Deps.Contains(AddonId) AndAlso Not DlCfProjectCache.ContainsKey(AddonId) Then Deps.Add(AddonId)
Next
Next
If Deps.Count > 0 Then
'获取前置 Mod 工程信息
Log("[Download] 文件列表中需要获取的前置 Mod：" & Join(Deps, "，"))
GetCfProjectListFromJson(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", "{""modIds"": [" & Join(Deps, ",") & "]}", "application/json"))("data"), False)
End If
'返回
ExitSub:
Return TargetProject.Files
End Function
Public Sub DlCfFilesPreload(Stack As StackPanel, Entrys As List(Of DlCfFile), OnClick As MyListItem.ClickEventHandler)
'获取卡片对应的前置 ID
'如果为整合包就不会有 Dependencies 信息，所以不用管
Dim Deps As New List(Of Integer)
For Each File In Entrys
For Each AddonId In If(File.Dependencies, New List(Of Integer))
If Not Deps.Contains(AddonId) Then
If Not DlCfProjectCache.ContainsKey(AddonId) Then
Log("[Download] 未找到 ID 为 " & AddonId & " 的前置 Mod 信息", LogLevel.Developer)
Continue For
End If
Deps.Add(AddonId)
End If
Next
Next
Deps.Remove(306612) '移除 Fabric API
If Deps.Count = 0 Then Exit Sub
Deps.Sort()
'添加开头间隔
Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
'添加前置 Mod 列表
For Each Dep In Deps
Dim Item = DlCfProjectCache(Dep).ToCfItem(False, True, AddressOf FrmDownloadMod.ProjectClick)
'Item.Margin = New Thickness(5, 0, 0, 0)
Stack.Children.Add(Item)
Next
'添加结尾间隔
Stack.Children.Add(New TextBlock With {.Text = "可选版本", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)})
End Sub
Public DlOptiFabricLoader As New LoaderTask(Of Integer, List(Of CompFile))("OptiFabric List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet("322385", True))
#End Region
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+4 -4
View File
@@ -1457,7 +1457,7 @@ NextVersion:
Next
'去重
Dim Result As String = Join(ArrayNoDouble(DeDuplicateDataList), " ")
Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ")
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
@@ -1549,7 +1549,7 @@ NextVersion:
DeDuplicateDataList.Add(CurrentEntry)
Next
'去重
McLaunchArgumentsGameNew = Join(ArrayNoDouble(DeDuplicateDataList), " ")
McLaunchArgumentsGameNew = Join(DeDuplicateDataList.Distinct.ToList, " ")
'特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
@@ -1592,7 +1592,7 @@ NextVersion:
GameArguments.Add("${auth_access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${user_type}", If(McLoginLoader.Output.Type = "Legacy", "Legacy", "Mojang"))
GameArguments.Add("${user_type}", "msa") '#1221
Dim GameSize As Size = Setup.GetLaunchArgumentWindowSize()
GameArguments.Add("${resolution_width}", GameSize.Width)
GameArguments.Add("${resolution_height}", GameSize.Height)
@@ -1982,7 +1982,7 @@ IgnoreCustomSkin:
End If
Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
Paths.Add(McLaunchJavaSelected.PathFolder)
StartInfo.EnvironmentVariables("Path") = Join(ArrayNoDouble(Paths), ";")
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
'设置其他参数
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+10 -14
View File
@@ -220,7 +220,7 @@ Public Module ModMinecraft
PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If Not PathInEnv.EndsWith("\") Then PathInEnv += "\"
'粗略检查有效性
If File.Exists(PathInEnv & "javaw.exe") Then DictionaryAdd(JavaPreList, PathInEnv, False)
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
Next
'查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives()
@@ -272,7 +272,7 @@ Public Module ModMinecraft
Try
For Each JavaJsonObject In GetJson(ImportedJava)
Dim Entry = JavaEntry.FromJson(JavaJsonObject)
If Entry.IsUserImport Then DictionaryAdd(JavaPreList, Entry.PathFolder, True)
If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True
Next
Catch ex As Exception
Log(ex, "Java 列表已损坏", LogLevel.Feedback)
@@ -283,10 +283,7 @@ Public Module ModMinecraft
'确保可用并获取详细信息，转入正式列表
Dim NewJavaList As New List(Of JavaEntry)
For Each Entry In ArrayNoDouble(JavaPreList.ToList,
Function(a As KeyValuePair(Of String, Boolean), b As KeyValuePair(Of String, Boolean))
Return a.Key.ToLower = b.Key.ToLower '#794
End Function)
For Each Entry In Distinct(JavaPreList.ToList, Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = Sort(JavaCheckList(NewJavaList), AddressOf JavaSorter)
@@ -373,7 +370,7 @@ Wait:
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWith("\") Then Path += "\"
'若该目录有 Java，则加入结果
If File.Exists(Path & "javaw.exe") Then DictionaryAdd(Results, Path, Source)
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
@@ -473,7 +470,7 @@ RetryGet:
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) <> "使用全局设置" Then
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWith("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
'确保版本独立设置中指定的 Java 在 Java 列表中（#978）
@@ -533,6 +530,7 @@ RetryGet:
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & "，但当前" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java，可能会导致出现异常。" & vbCrLf &
"你可以将 游戏 Java 设置修改为 自动选择合适的 Java 来避免这一提示。" & vbCrLf &
vbCrLf &
" - 指定的 Java：" & UserJava.ToString,
"Java 兼容性警告", "让 PCL2 自动选择", "强制使用该 Java", "取消")
@@ -853,7 +851,7 @@ NoUserJava:
_McVersionLast = value
If value Is Nothing Then Exit Property
'重置缓存的 Mod 文件夹
PageDownloadCfDetail.CachedFolder = Nothing
PageDownloadCompDetail.CachedFolder = Nothing
'统一通行证重判
If AniControlEnabled = 0 AndAlso
Setup.Get("VersionServerNide", Version:=value) <> Setup.Get("CacheNideServer") AndAlso
@@ -2644,12 +2642,10 @@ NextVersion:
'普通文件
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
End If
Result.Add(New NetFile(ArrayNoDouble(Urls.ToArray()), Token.LocalPath, Checker))
Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker))
Next
'去重并返回
Return ArrayNoDouble(Result, Function(Left As NetFile, Right As NetFile)
Return Left.LocalPath = Right.LocalPath
End Function)
Return Distinct(Result, Function(a, b) a.LocalPath = b.LocalPath)
End Function
''' <summary>
''' 获取对应的支持库文件地址。
@@ -3268,7 +3264,7 @@ NextVersion:
'不知道是个啥玩意儿，直接存储
Value = RawValue
End If
DictionaryAdd(TomlData.Last.Value, Key, Value)
TomlData.Last.Value(Key) = Value
Else
'不知道是个啥玩意儿
Exit Try
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+185 -30
View File
@@ -5,7 +5,7 @@
''' 弹窗要求选择一个整合包文件并进行安装。
''' </summary>
Public Sub ModpackInstall()
Dim File As String = SelectFile("压缩包文件(*.rar;*.zip)|*.rar;*.zip", "选择整合包压缩文件") '选择整合包文件
Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
If String.IsNullOrEmpty(File) Then Exit Sub
RunInThread(Sub() ModpackInstall(File))
End Sub
@@ -23,6 +23,7 @@
Archive = New Compression.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("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))
If Json("addons") Is Nothing Then
@@ -42,6 +43,7 @@
If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If FullNames(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
If Json("addons") Is Nothing Then
@@ -79,6 +81,9 @@
Case 3
Log("[ModPack] 整合包种类：MCBBS")
InstallPackMCBBS(File, Archive, ArchiveBaseFolder)
Case 4
Log("[ModPack] 整合包种类：Modrinth")
InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 9
Log("[ModPack] 整合包种类：压缩包")
Archive.Dispose()
@@ -152,11 +157,8 @@ Retry:
#Region "不同类型整合包的安装方法"
'CurseForge
''' <summary>
''' 获取安装 CurseForge 整合包的加载器，若失败或跳过则返回 Nothing。
''' 加载器以安装目标版本文件夹为输入。
''' </summary>
Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
'读取 Json 文件
Dim Json As JObject
Try
@@ -164,8 +166,19 @@ Retry:
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Return Nothing
Exit Sub
End Try
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub
End If
'获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
@@ -175,7 +188,7 @@ Retry:
'Forge 指定
If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老，已不支持进行安装！", LogLevel.Hint)
Return Nothing
Exit Sub
End If
Try
Log("[ModPack] 整合包 Forge 版本：" & Id)
@@ -250,8 +263,8 @@ Retry:
IsResourcePack = False
End If
'实际的添加
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(
PathMcFolder & "versions\" & VersionName & "\" & If(IsResourcePack, "resourcepacks", "mods") & "\", False))
FileList.Add(ModJson("id"), New CompFile(ModJson, CompType.Mod).ToNetFile(
PathMcFolder & "versions\" & VersionName & "\" & If(IsResourcePack, "resourcepacks", "mods") & "\"))
Task.Progress += 1 / (1 + ModFileList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -259,6 +272,7 @@ Retry:
'下载 Mod 文件
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModFileList.Count * 1.5}) '每个 Mod 需要 1.5s
End If
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
@@ -271,7 +285,7 @@ Retry:
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Return Nothing
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
@@ -293,14 +307,15 @@ Retry:
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[Download] 已设置整合包 Logo：" & Logo)
Log("[ModPack] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
Dim Target As String = VersionFolder & "原始整合包.zip"
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[Download] 根据设置要求删除原始整合包文件：" & Target)
Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
@@ -309,38 +324,166 @@ Retry:
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中！", HintType.Critical)
Return Nothing
Exit Sub
End If
Next
End SyncLock
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Return Loader
End Function
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
End Sub
'Modrinth
Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open))
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub
End Try
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower
Case "minecraft"
MinecraftVersion = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859
ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本：" & ForgeVersion)
Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
Exit Sub
Case Else
Hint($"无法安装整合包，其中出现了未知的 Mod 加载器 {Entry.Value}！", HintType.Critical)
Exit Sub
End Select
Next
'获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub
End If
'解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress)
Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 override 目录，已跳过")
End If
Task.Progress = 0.8
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
End If
Task.Progress = 0.9
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {})
'检查是否需要该文件
If File("env") IsNot Nothing Then
Select Case File("env")("client").ToString
Case "optional"
If MyMsgBox("是否要下载整合包中的可选文件 " & GetFileNameFromPath(File("path").ToString) & "？",
"下载可选文件", "是", "否") = 2 Then
Continue For
End If
Case "unsupported"
Continue For
End Select
End If
'添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString).ToArray,
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString)))
Next
If FileList.Count > 0 Then
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
End If
'启动加载器
Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName, Logo)
If Loader Is Nothing Then Exit Sub
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.FabricVersion = FabricVersion
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装：" & VersionName & " "
SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1
If LoaderTaskbar(i).Name = LoaderName Then
Hint("该整合包正在安装中！", HintType.Critical)
Exit Sub
End If
Next
End SyncLock
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -382,7 +525,10 @@ Retry:
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
If Json("gameVersion") Is Nothing Then
Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
Exit Sub
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.MinecraftName = Json("gameVersion").ToString
@@ -477,7 +623,10 @@ Retry:
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
If PackJson("components") Is Nothing Then
Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
Exit Sub
End If
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName}
For Each Component In PackJson("components")
Select Case If(Component("uid"), "").ToString
@@ -564,12 +713,18 @@ Retry:
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器
If Json("addons") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
If Json("addons") Is Nothing Then
Hint("该整合包未提供游戏版本附加信息，无法安装！", HintType.Critical)
Exit Sub
End If
Dim Addons As New Dictionary(Of String, String)
For Each Entry In Json("addons")
Addons.Add(Entry("id"), Entry("version"))
Next
If Not Addons.ContainsKey("game") Then Throw New Exception("整合包未提供游戏版本信息")
If Not Addons.ContainsKey("game") Then
Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
Exit Sub
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.MinecraftName = Addons("game"),
Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml → Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml
+3 -3
View File
@@ -1,10 +1,10 @@
<Grid x:Class="MyCfItem"
<Grid x:Class="MyCompItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack" Height="57"
x:Name="PanBack" Height="59"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="7" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="9" />
<ColumnDefinition Width="1*"/>
Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml.vb → Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
+22 -14
View File
@@ -1,4 +1,4 @@
Public Class MyCfItem
Public Class MyCompItem
Public Uuid As Integer = GetUuid()
#Region "Logo"
@@ -11,33 +11,36 @@
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CFLogo\" & GetHash(_Logo) & ".png"
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标，已更改为默认图标：{_Logo}")
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "CurseForge Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载 CurseForge 工程图标时读取失败（" & FileAddress & "）")
Log(ex, "加载资源工程图标时读取失败（" & FileAddress & "）")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化 CurseForge 工程图标失败（" & FileAddress & "）")
Log(ex, "可视化资源工程图标失败（" & FileAddress & "）")
Try
File.Delete(FileAddress)
Log("[Download] 已清理损坏的 CurseForge 工程图标：" & FileAddress)
Log("[Comp] 已清理损坏的资源工程图标：" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的 CurseForge 工程图标缓存失败（" & FileAddress & "）", LogLevel.Hint)
Log(exx, "清理损坏的资源工程图标缓存失败（" & FileAddress & "）", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载 CurseForge 工程图标失败（" & value & "）")
Log(ex, "加载资源工程图标失败（" & value & "）")
End Try
End Set
End Property
@@ -48,16 +51,20 @@
RetryStart:
Try
NetDownload(_Logo, Address & DownloadEnd)
Dim LoadError As Exception = Nothing
RunInUiWait(Sub()
Try
'在地址更换时取消加载
If Not Address = PathTemp & "CFLogo\" & GetHash(_Logo) & ".png" Then Exit Sub
If Not Address = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(Address & DownloadEnd)
Catch ex As Exception
Log(ex, "读取 CurseForge 工程图标失败（" & Address & "）", LogLevel.Hint)
Log(ex, "读取资源工程图标失败（" & Address & "）")
File.Delete(Address & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(Address) Then
File.Delete(Address & DownloadEnd)
Else
@@ -68,7 +75,8 @@ RetryStart:
Retry = True
GoTo RetryStart
Else
Log(ex, "下载 CurseForge 工程图标失败")
Log(ex, $"下载资源工程图标失败（{_Logo}）")
RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png"))
End If
End Try
End Sub
@@ -83,7 +91,7 @@ RetryStart:
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
Log("[Control] 按下 CurseForge 工程列表项：" & LabTitle.Text)
Log("[Control] 按下资源工程列表项：" & LabTitle.Text)
End If
End Sub
@@ -172,10 +180,10 @@ RetryStart:
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "CfItem Color " & Uuid)
AniStart(Ani, "CompItem Color " & Uuid)
Else
'无动画
AniStop("CfItem Color " & Uuid)
AniStop("CompItem Color " & Uuid)
If _RectBack IsNot Nothing Then RectBack.Opacity = 0
End If
End Sub
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.4.9.0")>
<Assembly: AssemblyFileVersion("2.4.9.0")>
<Assembly: AssemblyVersion("2.5.0.0")>
<Assembly: AssemblyFileVersion("2.5.0.0")>
<Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+10 -10
View File
@@ -690,7 +690,7 @@ Public Module ModDownloadLib
.Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = If(Entry.IsPreview, "测试版", "正式版") &
If(Entry.ReleaseTime = "", "", "，发布于 " & Entry.ReleaseTime) &
If(Entry.RequiredForgeVersion = "", "", "，推荐 Forge 版本：" & Entry.RequiredForgeVersion),
If(Entry.RequiredForgeVersion Is Nothing, "，不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", "，推荐 Forge 版本：" & Entry.RequiredForgeVersion)),
.Logo = "pack://application:,,,/images/Blocks/GrassPath.png"
}
AddHandler NewItem.Click, OnClick
@@ -1730,22 +1730,22 @@ Public Module ModDownloadLib
'结束
Return NewItem
End Function
Public Function FabricApiDownloadListItem(Entry As DlCfFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = Entry.ReleaseTypeString & "，发布于 " & Entry.Date.ToString("yyyy/MM/dd HH:mm"),
.Info = Entry.StatusDescription & "，发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/Fabric.png"
}
AddHandler NewItem.Click, OnClick
'结束
Return NewItem
End Function
Public Function OptiFabricDownloadListItem(Entry As DlCfFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
Public Function OptiFabricDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60,
.Info = Entry.ReleaseTypeString & "，发布于 " & Entry.Date.ToString("yyyy/MM/dd HH:mm"),
.Info = Entry.StatusDescription & "，发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"),
.Logo = "pack://application:,,,/images/Blocks/OptiFabric.png"
}
AddHandler NewItem.Click, OnClick
@@ -1804,12 +1804,12 @@ Public Module ModDownloadLib
''' <summary>
''' 欲下载的 Fabric API 信息。
''' </summary>
Public FabricApi As DlCfFile = Nothing
Public FabricApi As CompFile = Nothing
''' <summary>
''' 欲下载的 OptiFabric 信息。
''' </summary>
Public OptiFabric As DlCfFile = Nothing
Public OptiFabric As CompFile = Nothing
''' <summary>
''' 欲下载的 LiteLoader 详细信息。
@@ -1962,11 +1962,11 @@ Public Module ModDownloadLib
Dim LoaderList As New List(Of LoaderBase)
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.GetDownloadFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\", False)}) 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})
End If
'OptiFabric
If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.GetDownloadFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\", False)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
End If
'原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, .Block = Request.ForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}
@@ -2112,7 +2112,7 @@ Public Module ModDownloadLib
SplitArguments.Add(RawArguments(i))
End If
Next
Dim RealArguments As String = Join(ArrayNoDouble(SplitArguments), " ")
Dim RealArguments As String = Join(SplitArguments.Distinct.ToList, " ")
'合并
OutputJson = MinecraftJson
If HasOptiFine Then
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml → Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml
+4 -4
View File
@@ -2,7 +2,7 @@
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCfDetail"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
d:DesignWidth="778.571" d:DesignHeight="90.857">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,25,25,10">
@@ -14,9 +14,9 @@
<local:MyCard Margin="0,0,0,25" x:Name="CardIntro">
<StackPanel Margin="22,22,22,19" x:Name="PanIntro">
<StackPanel Orientation="Horizontal" Height="35">
<local:MyButton x:Name="BtnIntroCf" MinWidth="140" Text="查看 CurseForge" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnIntroWiki" MinWidth="140" Text="查看百科" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroMCBBS" MinWidth="140" Text="查看 MCBBS" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroWeb" MinWidth="140" Text="转到 CurseForge" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnIntroWiki" MinWidth="140" Text="转到 MC 百科" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroMCBBS" MinWidth="140" Text="转到 MCBBS" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnIntroCopy" MinWidth="140" Text="复制名称" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</StackPanel>
</StackPanel>
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml.vb → Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb
+77 -78
View File
@@ -1,25 +1,25 @@
Public Class PageDownloadCfDetail
Private CfItem As MyCfItem = Nothing
Private Project As DlCfProject
Public Class PageDownloadCompDetail
Private CompItem As MyCompItem = Nothing
Private Project As CompProject
#Region "加载器"
Private CompFileLoader As New LoaderTask(Of Integer, List(Of CompFile))(
"Comp File", Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet(Project.Id, Project.FromCurseForge))
'初始化加载器信息
Private Sub PageDownloadCfDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Project = FrmMain.PageCurrent.Additional
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, DlCfFileLoader, AddressOf Load_OnFinish, AddressOf LoaderInput)
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
End Sub
Private Function LoaderInput() As KeyValuePair(Of Integer, Boolean)
Return New KeyValuePair(Of Integer, Boolean)(Project.Id, Project.IsModPack)
End Function
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case DlCfFileLoader.State
Select Case CompFileLoader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message
If CompFileLoader.Error IsNot Nothing Then ErrorMessage = CompFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的 Mod 列表 Json 文件损坏，已自动重试", LogLevel.Debug)
Log("[Comp] 下载的文件 Json 列表损坏，已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
@@ -42,38 +42,42 @@
'初始化字典，并将当前版本排在最上面
Dim TopVersion As String
If Project.IsModPack Then
TopVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Else
Select Case Project.Type
Case CompType.Mod
TopVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
End If
Dim Dict As New SortedDictionary(Of String, List(Of DlCfFile))(New VersionSorterWithSelect(TopVersion))
'PCL#8826 汇报了奇怪的这个 Try 块里出现 NPE 的问题，但实在找不到，就瞎加点检测
Case CompType.ModPack
TopVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TopVersion = Nothing 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TopVersion))
'#8826 汇报了奇怪的这个 Try 块里出现 NPE 的问题，但实在找不到，就瞎加点检测
Try
Dict.Add("未知版本", New List(Of DlCfFile))
If DlCfFileLoader.Output Is Nothing Then
Log("[Download] 列表加载输出为 Nothing，请反馈此问题", LogLevel.Feedback)
Dict.Add("未知版本", New List(Of CompFile))
If CompFileLoader.Output Is Nothing Then
Log("[Comp] 列表加载输出为 Nothing，请反馈此问题", LogLevel.Feedback)
Exit Try
End If
For Each Version As DlCfFile In DlCfFileLoader.Output
For Each Version As CompFile In CompFileLoader.Output
If Version Is Nothing Then
Log("[Download] 列表中的一个版本为 Nothing，请反馈此问题", LogLevel.Feedback)
Log("[Comp] 列表中的一个版本为 Nothing，请反馈此问题", LogLevel.Feedback)
Continue For
End If
If Version.GameVersion Is Nothing Then
Log("[Download] 列表中的一个版本没有任何适配的游戏版本，返回为 Nothing，请反馈此问题", LogLevel.Feedback)
Continue For
End If
For Each GameVersion In Version.GameVersion
For Each GameVersion In Version.GameVersions
'决定添加到哪个版本
Dim TargetVersion As String
If GameVersion Is Nothing OrElse GameVersion.Split(".").Count < 2 Then
If GameVersion Is Nothing Then
TargetVersion = "未知版本"
Else
ElseIf GameVersion.Contains("w") Then
TargetVersion = "快照版本"
ElseIf GameVersion.Split(".").Count >= 2 Then
TargetVersion = GameVersion
Else
TargetVersion = "未知版本"
End If
'实际进行添加
If Not Dict.ContainsKey(TargetVersion) Then Dict.Add(TargetVersion, New List(Of DlCfFile))
If Not Dict.ContainsKey(TargetVersion) Then Dict.Add(TargetVersion, New List(Of CompFile))
If Not Dict(TargetVersion).Contains(Version) Then Dict(TargetVersion).Add(Version)
Next
Next
@@ -86,17 +90,17 @@
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlCfFile)) In Dict
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Pair.Value.Count = 0 Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.IsModPack, 9, 8)}
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}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
PanMain.Children.Add(NewCard)
'确定卡片是否展开
If Pair.Key = TopVersion Then
MyCard.StackInstall(NewStack, If(Project.IsModPack, 9, 8), Pair.Key)
MyCard.StackInstall(NewStack, If(Project.Type = CompType.ModPack, 9, 8), Pair.Key) 'FUTURE: Res
Else
NewCard.IsSwaped = True
End If
@@ -133,14 +137,15 @@
End If
'放置当前工程
If CfItem IsNot Nothing Then PanIntro.Children.Remove(CfItem)
CfItem = Project.ToCfItem(True, True)
CfItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CfItem)
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True)
CompItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CompItem)
'决定按钮显示
BtnIntroWeb.Text = If(Project.FromCurseForge, "转到 CurseForge", "转到 Modrinth")
BtnIntroWiki.Visibility = If(Project.WikiId = 0, Visibility.Collapsed, Visibility.Visible)
BtnIntroMCBBS.Visibility = If(Project.MCBBS Is Nothing, Visibility.Collapsed, Visibility.Visible)
BtnIntroMCBBS.Visibility = If(Project.MCBBS = 0, Visibility.Collapsed, Visibility.Visible)
AniControlEnabled -= 1
End Sub
@@ -150,11 +155,11 @@
Try
'获取基本信息
Dim File As DlCfFile = sender.Tag
Dim LoaderName As String = "CurseForge 整合包下载：" & Project.ChineseName & " "
Dim File As CompFile = sender.Tag
Dim LoaderName As String = $"{If(Project.FromCurseForge, "CurseForge", "Modrinth")} 整合包下载：{Project.TranslatedName} "
'获取版本名
Dim PackName As String = Project.ChineseName.Replace(".zip", "").Replace(".rar", "").Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
@@ -162,9 +167,9 @@
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
Dim LogoFileAddress As String = PathTemp & "CFLogo\" & GetHash(CfItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True})
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then
@@ -190,47 +195,41 @@
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "下载 CurseForge 整合包失败", LogLevel.Feedback)
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
End Try
End Sub
'Mod 下载；整合包另存为
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread(
Sub()
Try
Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ")
Dim Desc As String = If(Project.Type = CompType.ModPack, "整合包", If(Project.Type = CompType.Mod, "Mod ", "资源包"))
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If Not Project.IsModPack Then
If Project.Type = CompType.Mod Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
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
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
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
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
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, "未知"))
Log("[Comp] 允许 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.ToString) Then Return False
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) 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
@@ -239,11 +238,11 @@
'获取 Mod 默认下载位置
If CachedFolder IsNot Nothing Then
DefaultFolder = CachedFolder
Log("[Download] 使用上次下载时的文件夹作为默认下载位置")
Log("[Comp] 使用上次下载时的文件夹作为默认下载位置")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = McVersionCurrent.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用当前版本的 mods 文件夹作为默认下载位置（" & McVersionCurrent.Name & "）")
Log("[Comp] 使用当前版本的 mods 文件夹作为默认下载位置（" & McVersionCurrent.Name & "）")
Else
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
If NeedLoad Then
@@ -259,7 +258,7 @@
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本！")
Else
Log("[Download] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
Log("[Comp] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
End If
Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v)
@@ -268,13 +267,13 @@
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Download] 使用适合的游戏版本作为默认下载位置（" & SelectedVersion.Name & "）")
Log("[Comp] 使用适合的游戏版本作为默认下载位置（" & SelectedVersion.Name & "）")
End If
End If
End If
'获取基本信息
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 ChineseName As String = If(Project.TranslatedName = Project.RawName, "",
Project.TranslatedName.Replace(" (", "Å").Split("Å").First.Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "："))
Dim FileName As String
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
@@ -290,17 +289,17 @@
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
Target = SelectAs("选择保存位置", FileName,
Desc & "文件|" &
If(Project.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
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)
If Target <> DefaultFolder AndAlso Project.Type = CompType.Mod 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})
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(1)
@@ -309,12 +308,12 @@
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback)
Log(ex, "保存资源文件失败", LogLevel.Feedback)
End Try
End Sub, "Download CFDetail Save")
End Sub, "Download CompDetail Save")
End Sub
Private Sub BtnIntroCf_Click(sender As Object, e As EventArgs) Handles BtnIntroCf.Click
Private Sub BtnIntroWeb_Click(sender As Object, e As EventArgs) Handles BtnIntroWeb.Click
OpenWebsite(Project.Website)
End Sub
Private Sub BtnIntroWiki_Click(sender As Object, e As EventArgs) Handles BtnIntroWiki.Click
@@ -324,7 +323,7 @@
OpenWebsite("https://www.mcbbs.net/thread-" & Project.MCBBS & "-1-1.html")
End Sub
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
ClipboardSet(CfItem.LabTitle.Text)
ClipboardSet(CompItem.LabTitle.Text)
End Sub
End Class
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+37 -22
View File
@@ -232,7 +232,7 @@
End Sub
'FabricApi
Private SelectedFabricApi As DlCfFile = Nothing
Private SelectedFabricApi As CompFile = Nothing
Private Sub SetFabricApiInfoShow(IsShow As String)
If PanFabricApiInfo.Tag = IsShow Then Exit Sub
PanFabricApiInfo.Tag = IsShow
@@ -252,7 +252,7 @@
End Sub
'OptiFabric
Private SelectedOptiFabric As DlCfFile = Nothing
Private SelectedOptiFabric As CompFile = Nothing
Private Sub SetOptiFabricInfoShow(IsShow As String)
If PanOptiFabricInfo.Tag = IsShow Then Exit Sub
PanOptiFabricInfo.Tag = IsShow
@@ -591,18 +591,23 @@
End If
'检查最低 Forge 版本
Dim MinimalForgeVersion As String = "9999.9999"
Dim NotSuitForForge As Boolean = False
For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Not OptiFineVersion.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Continue For '不是同一个大版本
If SelectedForge Is Nothing OrElse IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then
Return Nothing
If SelectedForge Is Nothing Then Return Nothing '该版本可用
If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then
Return Nothing '该版本可用
Else
'设置用于显示的最低 Forge 版本
NotSuitForForge = True
If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then
'设置用于显示的最低允许的 Forge 版本
MinimalForgeVersion = If(VersionSortBoolean(MinimalForgeVersion, OptiFineVersion.RequiredForgeVersion),
OptiFineVersion.RequiredForgeVersion, MinimalForgeVersion)
End If
End If
Next
If MinimalForgeVersion = "9999.9999" Then
Return "没有可用版本"
Return If(NotSuitForForge, "与 Forge 不兼容", "没有可用版本")
Else
Return "需要 Forge " & If(MinimalForgeVersion.Contains("."), "", "#") & MinimalForgeVersion & " 或更高版本"
End If
@@ -611,6 +616,7 @@
'检查某个 OptiFine 是否与某个 Forge 兼容（最低 Forge 版本是否达到需求）
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
Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX
VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse
(Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX
@@ -749,13 +755,21 @@
End If
End If
If Loader.State <> LoadState.Finished Then Return "获取版本列表失败：未知错误，状态为 " & GetStringFromEnum(Loader.State)
Dim NotSuitForOptiFine As Boolean = False
For Each Version In Loader.Output
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then Return "与 OptiFine 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then
Return "与 OptiFine 不兼容" '1.13 ~ 1.14.3 OptiFine 检查
End If
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, Version) Then
NotSuitForOptiFine = True '与 OptiFine 不兼容
Continue For
End If
Return Nothing
Next
Return "该版本不支持自动安装"
Return If(NotSuitForOptiFine, "与 OptiFine 不兼容", "该版本不支持自动安装")
End Function
'限制展开
@@ -772,18 +786,19 @@
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State
If SelectedMinecraftId <> Loader.Input Then Exit Sub
If Loader.State <> LoadState.Finished Then Exit Sub
'可视化
'获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry)
Versions.AddRange(Loader.Output) '复制数组，以免 Output 在实例化后变空
If Loader.Output.Count = 0 Then Exit Sub
PanForge.Children.Clear()
Versions = Sort(Versions, Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean
Return New Version(Left.Version) > New Version(Right.Version)
End Function)
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
Where(Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True
End Function).ToList
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, Version) Then Continue For
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next
Catch ex As Exception
@@ -941,7 +956,7 @@
If DlFabricApiLoader.State <> LoadState.Finished Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing Then Exit Sub
'获取版本列表
Dim Versions As New List(Of DlCfFile)
Dim Versions As New List(Of CompFile)
For Each Version In DlFabricApiLoader.Output
If IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then
If Not Version.DisplayName.StartsWith("[") Then
@@ -953,8 +968,8 @@
Next
If Versions.Count = 0 Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlCfFile, Right As DlCfFile) As Boolean
Return Left.Date > Right.Date
Versions = Sort(Versions, Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
'可视化
PanFabricApi.Children.Clear()
@@ -987,10 +1002,10 @@
''' <summary>
''' 从显示名判断该 Mod 是否与某版本适配。
''' </summary>
Private Function IsSuitableOptiFabric(ModFile As DlCfFile, MinecraftVersion As String) As Boolean
Private Function IsSuitableOptiFabric(ModFile As CompFile, MinecraftVersion As String) As Boolean
Try
If MinecraftVersion Is Nothing Then Return False
Return ModFile.GameVersion.Contains(MinecraftVersion)
Return ModFile.GameVersions.Contains(MinecraftVersion)
Catch ex As Exception
Log(ex, "判断 OptiFabric 版本适配性出错（" & MinecraftVersion & "）")
Return False
@@ -1026,14 +1041,14 @@
If DlOptiFabricLoader.State <> LoadState.Finished Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then Exit Sub
'获取版本列表
Dim Versions As New List(Of DlCfFile)
Dim Versions As New List(Of CompFile)
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlCfFile, Right As DlCfFile) As Boolean
Return Left.Date > Right.Date
Versions = Sort(Versions, Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
'可视化
PanOptiFabric.Children.Clear()
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml
+2 -2
View File
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}">
<StackPanel Margin="0,12,0,0" Name="PanItem">
<TextBlock x:Name="LabGame" Text="游戏组件" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<TextBlock x:Name="LabGame" Text="Minecraft" Margin="13,6,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="自动安装"
LogoScale="0.87" Logo="M1091.291429 0H78.935771C35.34848 0.035109 0.029257 35.354331 0 78.935771v863.331475c0 43.534629 35.401143 78.994286 78.935771 78.994285H1091.291429c43.534629 0 78.994286-35.401143 78.994285-78.994285V78.871406C1170.156983 35.319223 1134.849463 0.064366 1091.291429 0z m-8.835658 87.771429v78.754377H87.771429v-78.760229h994.684342zM87.771429 933.425737V254.232869h994.684342v679.140205H87.771429v0.058515zM724.95104 340.00896l-206.19264 547.605943a43.903269 43.903269 0 0 1-82.154057-31.012572l206.139977-547.547428a43.944229 43.944229 0 0 1 82.20672 30.954057zM369.558674 545.909029l-85.489371 85.489371 85.489371 85.542034a43.885714 43.885714 0 0 1-62.025143 62.083657l-116.554605-116.560457a43.8272 43.8272 0 0 1 0-62.025143l116.560457-116.49024a43.885714 43.885714 0 0 1 62.019291 61.966629z m610.567315-37.566172a43.885714 43.885714 0 0 1 0 62.083657l-116.560458 116.560457a43.768686 43.768686 0 0 1-62.019291 0 43.885714 43.885714 0 0 1 0-62.083657l85.547886-85.547885-85.547886-85.542035a43.897417 43.897417 0 0 1 62.083657-62.083657l116.496092 116.618972z">
<local:MyListItem.Buttons>
@@ -59,7 +59,7 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="CurseForge" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="10" PaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons>
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
+2
View File
@@ -97,9 +97,11 @@
DlOptiFabricLoader.Start(IsForceRestart:=True)
ItemInstall.Checked = True
Case FormMain.PageSubType.DownloadMod
PageDownloadMod.Storage = New CompProjectStorage
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
PageDownloadPack.Storage = New CompProjectStorage
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadClient
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml
+40 -23
View File
@@ -26,27 +26,32 @@
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" Grid.ColumnSpan="10" />
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="1" Grid.Row="2" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部" Tag="0" IsSelected="True" />
<local:MyComboBoxItem Content="世界生成" Tag="406" />
<local:MyComboBoxItem Content="生物群系" Tag="407" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="天然结构" Tag="409" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="维度" Tag="410" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="生物" Tag="411" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="科技" Tag="412" />
<local:MyComboBoxItem Content="交通与移动" Tag="414" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="管道与物流" Tag="415" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="能源" Tag="417" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="红石" Tag="4558" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="仓储" Tag="420" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="农业" Tag="416" />
<local:MyComboBoxItem Content="食物" Tag="436" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="魔法" Tag="419" />
<local:MyComboBoxItem Content="装备与工具" Tag="434" />
<local:MyComboBoxItem Content="冒险与探索" Tag="422" />
<local:MyComboBoxItem Content="建筑与装饰" Tag="424" />
<local:MyComboBoxItem Content="信息显示" Tag="423" />
<local:MyComboBoxItem Content="支持库" Tag="421" />
<local:MyComboBoxItem Content="服务器" Tag="435" />
<local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" />
<local:MyComboBoxItem Content="生物群系" Tag="407/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="维度" Tag="410/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="矿物与资源" Tag="408/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="天然结构" Tag="409/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="科技" Tag="412/technology" />
<local:MyComboBoxItem Content="管道与物流" Tag="415/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="自动化" Tag="4843/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="能源" Tag="417/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="红石" Tag="4558/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="食物与烹饪" Tag="436/food" />
<local:MyComboBoxItem Content="农业" Tag="416/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="游戏机制" Tag="/game-mechanics" />
<local:MyComboBoxItem Content="运输" Tag="414/transportation" />
<local:MyComboBoxItem Content="仓储" Tag="420/storage" />
<local:MyComboBoxItem Content="魔法" Tag="419/magic" />
<local:MyComboBoxItem Content="冒险" Tag="422/adventure" />
<local:MyComboBoxItem Content="装饰" Tag="424/decoration" />
<local:MyComboBoxItem Content="生物" Tag="411/mobs" />
<local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="多人" Tag="435/social" />
<local:MyComboBoxItem Content="改良" Tag="5191/utility" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
</local:MyComboBox>
<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="全部 (也可自行输入)">
@@ -88,9 +93,21 @@
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardProjects" Title="热门 Mod">
<StackPanel x:Name="PanProjects" Margin="20,40,18,20" />
<StackPanel x:Name="PanContent">
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.5"
Logo="M671.968176 911.99957c-12.287381 0-24.576482-4.67206-33.951566-14.047144L286.048434 545.984249c-18.751888-18.719204-18.751888-49.12028 0-67.872168L638.016611 126.111222c18.751888-18.751888 49.12028-18.751888 67.872168 0 18.751888 18.719204 18.751888 49.12028 0 67.872168l-318.016611 318.047574L705.888778 830.047574c18.751888 18.751888 18.751888 49.12028 0 67.872168C696.544658 907.32751 684.255557 911.99957 671.968176 911.99957z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="7,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight"
Logo="M761.055557 532.128047c0.512619-0.992555 1.343475-1.823411 1.792447-2.848649 8.800538-18.304636 5.919204-40.703346-9.664077-55.424808L399.935923 139.743798c-19.264507-18.208305-49.631179-17.344765-67.872168 1.888778-18.208305 19.264507-17.375729 49.631179 1.888778 67.872168l316.960409 299.839269L335.199677 813.631716c-19.071845 18.399247-19.648112 48.767639-1.247144 67.872168 9.407768 9.791372 21.984142 14.688778 34.560516 14.688778 12.000108 0 24.000215-4.479398 33.311652-13.439914l350.048434-337.375729c0.672598-0.672598 0.927187-1.599785 1.599785-2.303346 0.512619-0.479935 1.056202-0.832576 1.567101-1.343475C757.759656 538.879828 759.199462 535.391265 761.055557 532.128047z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 Mod 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb
+70 -26
View File
@@ -1,46 +1,61 @@
Public Class PageDownloadMod
'初始化加载器信息
Public Const PageSize = 40
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject Mod", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
PageLoaderInit(Load, PanLoad, PanContent, 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
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.Mod, Storage, (Page + 1) * PageSize)
If FrmDownloadMod IsNot Nothing AndAlso FrmDownloadMod.IsLoaded Then
Return New DlCfProjectRequest With {
.SearchFilter = FrmDownloadMod.TextSearchName.Text,
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text.Contains("."), FrmDownloadMod.TextSearchVersion.Text, Nothing),
.CategoryId = Val(FrmDownloadMod.ComboSearchTag.SelectedItem.Tag),
.IsModPack = False,
With Request
.SearchText = FrmDownloadMod.TextSearchName.Text
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text.Contains("."), FrmDownloadMod.TextSearchVersion.Text, Nothing)
.Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag
.ModLoader = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag)
} '处理列表加载失败后的点击加载器重试
Else
Return New DlCfProjectRequest With {.IsModPack = False}
End With
End If
Return Request
End Function
'结果 UI 化
Private Sub Load_OnFinish()
Try
'列表项
PanProjects.Children.Clear()
If Loader.Input.SearchFilter = "" Then
CardProjects.Title = "热门 Mod"
Else
CardProjects.Title = "搜索结果 (" & Loader.Output.Projects.Count & If(Loader.Output.Projects.Count < Loader.Output.RealCount, "+", "") & ")"
End If
For Each Project In Loader.Output.Projects
PanProjects.Children.Add(Project.ToCfItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader Is Nothing OrElse Loader.Input.ModLoader = 0, AddressOf ProjectClick))
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(
Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing,
Loader.Input.ModLoader = CompModLoaderType.Any, AddressOf ProjectClick))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal,
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.5)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.5)
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
Log(ex, "可视化 Mod 列表出错", LogLevel.Feedback)
End Try
End Sub
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case Loader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的 Mod 列表 Json 文件损坏，已自动重试", LogLevel.Debug)
PageLoaderRestart()
@@ -50,18 +65,43 @@
'进入详情页面
Public Sub ProjectClick(sender As MyCfItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CfDetail, .Additional = sender.Tag})
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
'搜索
'切换页码
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartSearch()
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
Private Shared Sub StartSearch() Handles BtnSearchRun.Click
Private Sub BtnPageRight_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageRight.Click
ChangePage(Page + 1)
End Sub
Private Sub ChangePage(NewPage As Integer)
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] Mod 切换到第 {Page + 1} 页")
RunInThread(Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
#Region "搜索"
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
Storage = New CompProjectStorage
Loader.Start()
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartNewSearch()
End Sub
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.SelectedIndex = 0
@@ -70,6 +110,8 @@
ComboSearchLoader.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
'版本选择
Private Sub TextSearchVersion_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSearchVersion.TextChanged
If TextSearchVersion.Text = "" Then
ComboSearchLoader.Visibility = Visibility.Collapsed
@@ -81,4 +123,6 @@
End If
End Sub
#End Region
End Class
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml
+33 -20
View File
@@ -25,24 +25,25 @@
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" Grid.ColumnSpan="10" HintText="仅支持使用英文搜索" />
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="1" Grid.Row="2" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部" Tag="0" IsSelected="True" />
<local:MyComboBoxItem IsHitTestVisible="False" Content="规格" />
<local:MyComboBoxItem Tag="4481" Content="小型整合" Margin="15,0,0,0" />
<local:MyComboBoxItem Tag="4482" Content="大型整合" Margin="15,0,0,0" />
<local:MyComboBoxItem IsHitTestVisible="False" Content="特殊" />
<local:MyComboBoxItem Tag="4487" Content="FTB" Margin="15,0,0,0" ToolTip="该整合包由 FTB 官方发布" />
<local:MyComboBoxItem Tag="4480" Content="基于地图" Margin="15,0,0,0" ToolTip="该整合包基于已有的 Minecraft 游戏地图运行" />
<local:MyComboBoxItem Tag="4479" Content="硬核" />
<local:MyComboBoxItem Tag="4474" Content="科幻" />
<local:MyComboBoxItem Tag="4483" Content="战斗" />
<local:MyComboBoxItem Tag="4478" Content="任务" />
<local:MyComboBoxItem Tag="4484" Content="多人" />
<local:MyComboBoxItem Tag="4476" Content="探索" />
<local:MyComboBoxItem Tag="4736" Content="空岛" />
<local:MyComboBoxItem Tag="4475" Content="冒险" />
<local:MyComboBoxItem Tag="4472" Content="科技" />
<local:MyComboBoxItem Tag="4473" Content="魔法" />
<local:MyComboBoxItem Tag="4477" Content="小游戏" />
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Tag="4484/" Content="多人" />
<local:MyComboBoxItem Tag="/optimization" Content="性能优化" />
<local:MyComboBoxItem Tag="4479/challenging" Content="硬核" />
<local:MyComboBoxItem Tag="4483/combat" Content="战斗" />
<local:MyComboBoxItem Tag="4478/quests" Content="任务" />
<local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="烹饪" />
<local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" />
<local:MyComboBoxItem Tag="4736/" Content="空岛" />
<local:MyComboBoxItem Tag="5128/" Content="原版改良" />
<local:MyComboBoxItem Tag="4487/" Content="FTB" ToolTip="该整合包由 FTB 官方发布" />
<local:MyComboBoxItem Tag="4480/" Content="基于地图" />
<local:MyComboBoxItem Tag="4481/lightweight" Content="轻量整合" />
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
</local:MyComboBox>
<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="全部 (也可自行输入)">
@@ -81,9 +82,21 @@
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardProjects" Title="热门整合包">
<StackPanel x:Name="PanProjects" Margin="20,40,18,20" />
<StackPanel x:Name="PanContent">
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.5"
Logo="M671.968176 911.99957c-12.287381 0-24.576482-4.67206-33.951566-14.047144L286.048434 545.984249c-18.751888-18.719204-18.751888-49.12028 0-67.872168L638.016611 126.111222c18.751888-18.751888 49.12028-18.751888 67.872168 0 18.751888 18.719204 18.751888 49.12028 0 67.872168l-318.016611 318.047574L705.888778 830.047574c18.751888 18.751888 18.751888 49.12028 0 67.872168C696.544658 907.32751 684.255557 911.99957 671.968176 911.99957z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="7,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight"
Logo="M761.055557 532.128047c0.512619-0.992555 1.343475-1.823411 1.792447-2.848649 8.800538-18.304636 5.919204-40.703346-9.664077-55.424808L399.935923 139.743798c-19.264507-18.208305-49.631179-17.344765-67.872168 1.888778-18.208305 19.264507-17.375729 49.631179 1.888778 67.872168l316.960409 299.839269L335.199677 813.631716c-19.071845 18.399247-19.648112 48.767639-1.247144 67.872168 9.407768 9.791372 21.984142 14.688778 34.560516 14.688778 12.000108 0 24.000215-4.479398 33.311652-13.439914l350.048434-337.375729c0.672598-0.672598 0.927187-1.599785 1.599785-2.303346 0.512619-0.479935 1.056202-0.832576 1.567101-1.343475C757.759656 538.879828 759.199462 535.391265 761.055557 532.128047z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取整合包列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb
+72 -38
View File
@@ -1,45 +1,59 @@
Public Class PageDownloadPack
'初始化加载器信息
Public Const PageSize = 40
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject ModPack", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
PageLoaderInit(Load, PanLoad, PanContent, 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
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.ModPack, Storage, (Page + 1) * PageSize)
If FrmDownloadPack IsNot Nothing AndAlso FrmDownloadPack.IsLoaded Then
Return New DlCfProjectRequest With {
.SearchFilter = FrmDownloadPack.TextSearchName.Text,
.GameVersion = If(FrmDownloadPack.TextSearchVersion.Text.Contains("."), FrmDownloadPack.TextSearchVersion.Text, Nothing),
.CategoryId = Val(FrmDownloadPack.ComboSearchTag.SelectedItem.Tag),
.IsModPack = True
} '处理列表加载失败后的点击加载器重试
Else
Return New DlCfProjectRequest With {.IsModPack = True}
With Request
.SearchText = FrmDownloadPack.TextSearchName.Text
.GameVersion = If(FrmDownloadPack.TextSearchVersion.Text.Contains("."), FrmDownloadPack.TextSearchVersion.Text, Nothing)
.Tag = FrmDownloadPack.ComboSearchTag.SelectedItem.Tag
End With
End If
Return Request
End Function
'结果 UI 化
Private Sub Load_OnFinish()
Try
'列表项
PanProjects.Children.Clear()
If Loader.Input.SearchFilter = "" Then
CardProjects.Title = "热门整合包"
Else
CardProjects.Title = "搜索结果 (" & Loader.Output.Projects.Count & If(Loader.Output.Projects.Count < Loader.Output.RealCount, "+", "") & ")"
End If
For Each Project In Loader.Output.Projects
PanProjects.Children.Add(Project.ToCfItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader Is Nothing OrElse Loader.Input.ModLoader = 0, AddressOf ProjectClick))
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(
Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, True, AddressOf ProjectClick))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal,
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.5)
BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.5)
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
Log(ex, "可视化整合包列表出错", LogLevel.Feedback)
End Try
End Sub
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case Loader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的整合包列表 Json 文件损坏，已自动重试", LogLevel.Debug)
PageLoaderRestart()
@@ -47,28 +61,49 @@
End Select
End Sub
Private Sub Load_OnStart()
PanLoad.Visibility = Visibility.Visible
AniStart({
AaOpacity(PanLoad, 1 - PanLoad.Opacity, 150),
AaOpacity(CardProjects, -CardProjects.Opacity, 150),
AaCode(Sub()
CardProjects.Visibility = Visibility.Collapsed
PanProjects.Children.Clear()
End Sub,, True)
}, "FrmDownloadPack Load Switch")
'进入详情页面
Public Sub ProjectClick(sender As MyCompItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = sender.Tag})
End Sub
Public Sub ProjectClick(sender As MyCfItem, e As EventArgs)
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CfDetail, .Additional = sender.Tag})
'切换页码
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
Private Sub BtnPageRight_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageRight.Click
ChangePage(Page + 1)
End Sub
Private Sub ChangePage(NewPage As Integer)
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] 整合包切换到第 {Page + 1} 页")
RunInThread(Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartSearch()
Private Sub BtnSearchInstall_Click(sender As Object, e As EventArgs) Handles BtnSearchInstall.Click
ModpackInstall()
End Sub
Private Shared Sub StartSearch() Handles BtnSearchRun.Click
#Region "搜索"
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
Storage = New CompProjectStorage
Loader.Start()
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
If e.Key = Key.Enter Then StartNewSearch()
End Sub
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.SelectedIndex = 0
@@ -76,8 +111,7 @@
ComboSearchTag.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
Private Sub BtnSearchInstall_Click(sender As Object, e As EventArgs) Handles BtnSearchInstall.Click
ModpackInstall()
End Sub
#End Region
End Class
Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb
+3 -3
View File
@@ -347,7 +347,7 @@ StartDownload:
If Content.Contains("'portssub' from ") Then LastPortsId = Content.Split(" ").Last
If Content.Contains("Listening tcp ") Then
If UserList.ContainsKey(LastPortsId) Then
DictionaryAdd(UserList(LastPortsId).Ports, Content.Split(" ").Last, RegexSeek(Content, "(?<=Listening tcp )[^:]+"))
UserList(LastPortsId).Ports(Content.Split(" ").Last) = RegexSeek(Content, "(?<=Listening tcp )[^:]+")
Else
Log("[IOI] 未在列表中的用户出现意料外的连接信息")
NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & LastPortsId & "&password=" & IoiPassword, "DELETE", "", "", 500)
@@ -574,7 +574,7 @@ Done:
Rooms.Add(RoomObject)
Next
RawJson("rooms") = Rooms
DictionaryAdd(User.PingPending, Unique, Date.Now)
User.PingPending(Unique) = Date.Now
End If
User.Send(RawJson)
End Sub
@@ -1179,7 +1179,7 @@ Done:
If Id > IoiId Then
Log("[IOI] 双向连接，应当抛弃当前用户（" & DisplayName & "）")
For Each Pair In UserList(User.Id).Ports.ToList
DictionaryAdd(User.Ports, Pair.Key, Pair.Value)
User.Ports(Pair.Key) = Pair.Value
Next
UserList(Id).Dispose()
Else
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+1 -1
View File
@@ -417,7 +417,7 @@ PreFin:
If ComboArgumentJava Is Nothing Then Exit Sub
'初始化列表
ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择适合所选游戏版本的 Java", .Tag = "自动选择"})
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
'更新列表
Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Setup.Get("LaunchArgumentJavaSelect")
Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml
+2 -2
View File
@@ -47,9 +47,9 @@
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="5" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1" />
<TextBlock VerticalAlignment="Top" Grid.Row="6" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" />
<TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键，即可选择打开对应文件夹。" Grid.Row="6" Grid.Column="1" VerticalAlignment="Center" />
<local:MyCheckBox Margin="0,2,0,4" Text="安装 CurseForge 整合包时保留原始压缩包" Grid.Row="7" Height="22" Grid.ColumnSpan="2"
<local:MyCheckBox Margin="0,2,0,4" Text="安装整合包时保留原始压缩包" Grid.Row="7" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack"
ToolTip="安装 CurseForge 整合包后，在版本文件夹下保留用于安装的 原始整合包.zip 文件" />
ToolTip="安装整合包时，在版本文件夹下保留用于安装的原始整合包压缩包文件" />
</Grid>
</StackPanel>
</local:MyCard>
Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb
+1 -1
View File
@@ -412,7 +412,7 @@ PreFin:
'初始化列表
ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "使用全局设置", .Tag = "使用全局设置"})
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择适合所选游戏版本的 Java", .Tag = "自动选择"})
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
'更新列表
Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Setup.Get("VersionArgumentJavaSelect", Version:=PageVersionLeft.Version)
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
+7 -6
View File
@@ -182,6 +182,7 @@
<Compile Include="Controls\MyCard.vb" />
<Compile Include="Controls\MyPageRight.vb" />
<Compile Include="Controls\MyPageLeft.vb" />
<Compile Include="Modules\Minecraft\ModComp.vb" />
<Compile Include="Modules\Minecraft\ModModpack.vb" />
<Compile Include="Modules\ModEvent.vb" />
<Compile Include="Controls\MyExtraButton.xaml.vb">
@@ -217,8 +218,8 @@
<SubType>Component</SubType>
</Compile>
<Compile Include="Pages\PageDownload\ModDownloadLib.vb" />
<Compile Include="Pages\PageDownload\MyCfItem.xaml.vb">
<DependentUpon>MyCfItem.xaml</DependentUpon>
<Compile Include="Modules\Minecraft\MyCompItem.xaml.vb">
<DependentUpon>MyCompItem.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadMod.xaml.vb">
<DependentUpon>PageDownloadMod.xaml</DependentUpon>
@@ -229,8 +230,8 @@
<Compile Include="Pages\PageDownload\PageDownloadInstall.xaml.vb">
<DependentUpon>PageDownloadInstall.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadCfDetail.xaml.vb">
<DependentUpon>PageDownloadCfDetail.xaml</DependentUpon>
<Compile Include="Pages\PageDownload\PageDownloadCompDetail.xaml.vb">
<DependentUpon>PageDownloadCompDetail.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageDownload\PageDownloadPack.xaml.vb">
<DependentUpon>PageDownloadPack.xaml</DependentUpon>
@@ -459,7 +460,7 @@
<DependentUpon>FormMain.xaml</DependentUpon>
<SubType>Code</SubType>
</Compile>
<Page Include="Pages\PageDownload\MyCfItem.xaml">
<Page Include="Modules\Minecraft\MyCompItem.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
@@ -475,7 +476,7 @@
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
<Page Include="Pages\PageDownload\PageDownloadCfDetail.xaml">
<Page Include="Pages\PageDownload\PageDownloadCompDetail.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
Plain Craft Launcher 2/Resources/ModData.txt
+1706 -1346
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Resources/java-wrapper.jar
BIN
View File
Binary file not shown.