337 lines
20 KiB
VB.net
337 lines
20 KiB
VB.net
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 PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
|
||
Project = FrmMain.PageCurrent.Additional
|
||
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
|
||
End Sub
|
||
'自动重试
|
||
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
|
||
Select Case CompFileLoader.State
|
||
Case LoadState.Failed
|
||
Dim ErrorMessage As String = ""
|
||
If CompFileLoader.Error IsNot Nothing Then ErrorMessage = CompFileLoader.Error.Message
|
||
If ErrorMessage.Contains("不是有效的 json 文件") Then
|
||
Log("[Comp] 下载的文件 json 列表损坏，已自动重试", LogLevel.Debug)
|
||
PageLoaderRestart()
|
||
End If
|
||
End Select
|
||
End Sub
|
||
'结果 UI 化
|
||
Private Class VersionSorterWithSelect
|
||
Implements IComparer(Of String)
|
||
Public Top As String = ""
|
||
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
|
||
If x = y Then Return 0
|
||
If x = Top Then Return -1
|
||
If y = Top Then Return 1
|
||
Return -VersionSortInteger(x, y)
|
||
End Function
|
||
Public Sub New(Optional Top As String = "")
|
||
Me.Top = If(Top, "")
|
||
End Sub
|
||
End Class
|
||
Private Sub Load_OnFinish()
|
||
'获取目标版本与 Mod 加载器
|
||
Dim TargetVersion As String = ""
|
||
Select Case Project.Type
|
||
Case CompType.Mod
|
||
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
|
||
Case CompType.ModPack
|
||
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
|
||
Case Else 'CompType.ResourcePack
|
||
'FUTURE: Res
|
||
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
|
||
End Select
|
||
Dim TargetLoader = CompModLoaderType.Any
|
||
If Project.Type = CompType.Mod AndAlso PageDownloadMod.Loader.Input.ModLoader <> CompModLoaderType.Any Then
|
||
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
|
||
End If
|
||
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
|
||
$"目标版本：{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "")
|
||
'初始化字典
|
||
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TargetCardName))
|
||
Dict.Add("未知版本", New List(Of CompFile))
|
||
For Each Version As CompFile In CompFileLoader.Output
|
||
For Each GameVersion In Version.GameVersions
|
||
'决定添加到哪个版本
|
||
Dim TargetCard As String
|
||
If GameVersion Is Nothing Then
|
||
TargetCard = "未知版本"
|
||
ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then
|
||
TargetCard = "快照版本"
|
||
ElseIf GameVersion.Split(".").Count >= 2 Then
|
||
TargetCard = GameVersion
|
||
Else
|
||
TargetCard = "未知版本"
|
||
End If
|
||
'实际进行添加
|
||
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
|
||
If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
|
||
Next
|
||
Next
|
||
'添加筛选的版本的卡片
|
||
If TargetCardName <> "" Then
|
||
Dict.Add(TargetCardName, New List(Of CompFile))
|
||
For Each Version As CompFile In CompFileLoader.Output
|
||
If Version.GameVersions.Contains(TargetVersion) AndAlso
|
||
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
|
||
If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
|
||
End If
|
||
Next
|
||
End If
|
||
|
||
#Region "转化为 UI"
|
||
Try
|
||
'清空当前
|
||
PanMain.Children.Clear()
|
||
'转化为 UI
|
||
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.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 = TargetCardName Then
|
||
MyCard.StackInstall(NewStack, If(Project.Type = CompType.ModPack, 9, 8), Pair.Key) 'FUTURE: Res
|
||
Else
|
||
NewCard.IsSwaped = True
|
||
End If
|
||
'增加提示
|
||
If Pair.Key = "未知版本" Then
|
||
NewStack.Children.Add(New MyHint With {.Text = "由于 API 的版本信息更新缓慢，可能无法识别刚更新不久的 MC 版本，只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)})
|
||
End If
|
||
Next
|
||
'如果只有一张卡片，展开第一张卡片
|
||
If PanMain.Children.Count = 1 Then
|
||
CType(PanMain.Children(0), MyCard).IsSwaped = False
|
||
End If
|
||
Catch ex As Exception
|
||
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
|
||
End Try
|
||
#End Region
|
||
|
||
End Sub
|
||
|
||
#End Region
|
||
|
||
Private IsFirstInit As Boolean = True
|
||
Public Sub Init() Handles Me.PageEnter
|
||
AniControlEnabled += 1
|
||
Project = FrmMain.PageCurrent.Additional
|
||
PanBack.ScrollToHome()
|
||
|
||
'重启加载器
|
||
If IsFirstInit Then
|
||
'在 Me.Initialized 已经初始化了加载器，不再重复初始化
|
||
IsFirstInit = False
|
||
Else
|
||
PageLoaderRestart(IsForceRestart:=True)
|
||
End If
|
||
|
||
'放置当前工程
|
||
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 = 0, Visibility.Collapsed, Visibility.Visible)
|
||
|
||
AniControlEnabled -= 1
|
||
End Sub
|
||
|
||
'整合包下载（安装）
|
||
Public Sub Install_Click(sender As MyListItem, e As EventArgs)
|
||
Try
|
||
|
||
'获取基本信息
|
||
Dim File As CompFile = sender.Tag
|
||
Dim LoaderName As String = $"{If(Project.FromCurseForge, "CurseForge", "Modrinth")} 整合包下载：{Project.TranslatedName} "
|
||
|
||
'获取版本名
|
||
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})
|
||
If String.IsNullOrEmpty(VersionName) Then Exit Sub
|
||
|
||
'构造步骤加载器
|
||
Dim Loaders As New List(Of LoaderBase)
|
||
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
|
||
Throw New Exception("整合包安装出现异常！")
|
||
End If
|
||
End Sub) With {.ProgressWeight = 0.1})
|
||
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader)
|
||
Select Case MyLoader.State
|
||
Case LoadState.Failed
|
||
Hint(MyLoader.Name & "失败：" & GetExceptionSummary(MyLoader.Error), HintType.Critical)
|
||
Case LoadState.Aborted
|
||
Hint(MyLoader.Name & "已取消！", HintType.Info)
|
||
Case LoadState.Loading
|
||
Exit Sub '不重新加载版本列表
|
||
End Select
|
||
McInstallFailedClearFolder(MyLoader)
|
||
End Sub}
|
||
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
FrmMain.BtnExtraDownload.Ribble()
|
||
|
||
Catch ex As Exception
|
||
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 CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
|
||
RunInNewThread(
|
||
Sub()
|
||
Try
|
||
Dim Desc As String = If(Project.Type = CompType.ModPack, "整合包", If(Project.Type = CompType.Mod, "Mod ", "资源包"))
|
||
'确认默认保存位置
|
||
Dim DefaultFolder As String = Nothing
|
||
If Project.Type = CompType.Mod Then
|
||
'获取 Mod 所需的加载器种类
|
||
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
|
||
If File.ModLoaders.Count > 0 Then '从文件中获取
|
||
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
|
||
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
|
||
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
|
||
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("[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.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
|
||
Return False
|
||
End Function
|
||
'获取 Mod 默认下载位置
|
||
If CachedFolder IsNot Nothing Then
|
||
DefaultFolder = CachedFolder
|
||
Log("[Comp] 使用上次下载时的文件夹作为默认下载位置")
|
||
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
|
||
DefaultFolder = McVersionCurrent.PathIndie & "mods\"
|
||
Directory.CreateDirectory(DefaultFolder)
|
||
Log("[Comp] 使用当前版本的 mods 文件夹作为默认下载位置（" & McVersionCurrent.Name & "）")
|
||
Else
|
||
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
|
||
If NeedLoad Then
|
||
Hint("正在查找适合的游戏版本……")
|
||
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
|
||
End If
|
||
Dim SuitableVersions As New List(Of McVersion)
|
||
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
|
||
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
|
||
Next
|
||
If SuitableVersions.Count = 0 Then
|
||
DefaultFolder = PathMcFolder
|
||
If NeedLoad Then
|
||
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本！")
|
||
Else
|
||
Log("[Comp] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
|
||
End If
|
||
Else '选择 Mod 数量最多的版本
|
||
Dim SelectedVersion = SuitableVersions.OrderBy(Function(v)
|
||
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
|
||
Return If(Info.Exists, Info.GetFiles().Length, -1)
|
||
End Function).LastOrDefault()
|
||
DefaultFolder = SelectedVersion.PathIndie & "mods\"
|
||
Directory.CreateDirectory(DefaultFolder)
|
||
Log("[Comp] 使用适合的游戏版本作为默认下载位置（" & SelectedVersion.Name & "）")
|
||
End If
|
||
End If
|
||
End If
|
||
'获取基本信息
|
||
Dim FileName As String
|
||
If Project.TranslatedName = Project.RawName Then
|
||
FileName = File.FileName
|
||
Else
|
||
Dim ChineseName As String = Project.TranslatedName.Split(" (").First.Split(" - ").First.
|
||
Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
|
||
Select Case Setup.Get("ToolDownloadTranslate")
|
||
Case 0
|
||
FileName = $"[{ChineseName}] {File.FileName}"
|
||
Case 1
|
||
FileName = $"{ChineseName}-{File.FileName}"
|
||
Case 2
|
||
FileName = $"{File.FileName}-{ChineseName}"
|
||
Case Else
|
||
FileName = File.FileName
|
||
End Select
|
||
End If
|
||
RunInUi(
|
||
Sub()
|
||
'弹窗要求选择保存位置
|
||
Dim Target As String
|
||
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 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.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
|
||
Loader.Start(1)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
FrmMain.BtnExtraDownload.Ribble()
|
||
End Sub)
|
||
Catch ex As Exception
|
||
Log(ex, "保存资源文件失败", LogLevel.Feedback)
|
||
End Try
|
||
End Sub, "Download CompDetail Save")
|
||
End Sub
|
||
|
||
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
|
||
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
|
||
End Sub
|
||
Private Sub BtnIntroMCBBS_Click(sender As Object, e As EventArgs) Handles BtnIntroMCBBS.Click
|
||
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(CompItem.LabTitle.Text)
|
||
End Sub
|
||
|
||
End Class
|