582 lines
33 KiB
VB.net
582 lines
33 KiB
VB.net
|
||
|
||
Public Class PageDownloadCompDetail
|
||
Private CompItem As MyCompItem = Nothing
|
||
|
||
#Region "加载器"
|
||
|
||
Private CompFileLoader As New LoaderTask(Of Integer, List(Of CompFile))(
|
||
"Comp File",
|
||
Sub(Task)
|
||
LoadTargetFromAdditional()
|
||
Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge)
|
||
If Task.IsAborted Then Return
|
||
Task.Output = Result
|
||
End Sub)
|
||
|
||
'初始化加载器信息
|
||
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
|
||
LoadTargetFromAdditional()
|
||
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
|
||
End Sub
|
||
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
|
||
Project = FrmMain.PageCurrent.Additional(0)
|
||
TargetVersion = FrmMain.PageCurrent.Additional(2)
|
||
TargetLoader = FrmMain.PageCurrent.Additional(3)
|
||
PageType = FrmMain.PageCurrent.Additional(4)
|
||
End Sub
|
||
Private Project As CompProject
|
||
Private TargetVersion As String, TargetLoader As CompLoaderType
|
||
''' <summary>
|
||
''' 当前页面应展示的内容类别。可能为 Any。
|
||
''' </summary>
|
||
Private PageType As CompType
|
||
'自动重试
|
||
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 CardSorter
|
||
Implements IComparer(Of String)
|
||
Public Topmost 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 = Topmost Then Return -1
|
||
If y = Topmost Then Return 1
|
||
'特殊版本
|
||
Dim IsXSpecial As Boolean = x.EndsWithF("版本")
|
||
Dim IsYSpecial As Boolean = y.EndsWithF("版本")
|
||
If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
|
||
If IsXSpecial Then Return 1
|
||
If IsYSpecial Then Return -1
|
||
'比较版本号
|
||
Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
|
||
If VersionCodeSort <> 0 Then Return VersionCodeSort
|
||
'比较全部
|
||
Return -VersionSortInteger(x, y)
|
||
End Function
|
||
Public Sub New(Optional Topmost As String = "")
|
||
Me.Topmost = If(Topmost, "")
|
||
End Sub
|
||
End Class
|
||
|
||
Private VersionFilter As String
|
||
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选（1.21 / 1.20 / 1.19 / ...）而非小版本号（1.21.1 / 1.21 / 1.20.4 / ...）
|
||
'筛选类型相同的结果（Modrinth 会返回 Mod、服务端插件、数据包混合的列表）
|
||
Private Function GetResults() As List(Of CompFile)
|
||
Dim Results As List(Of CompFile) = CompFileLoader.Output
|
||
If PageType = CompType.Any Then
|
||
Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
|
||
ElseIf PageType = CompType.Shader OrElse PageType = CompType.ResourcePack Then
|
||
'不筛选光影和资源包，否则原版光影会因为是资源包格式而被过滤（Meloong-Git/#6473）
|
||
Else
|
||
Results = Results.Where(Function(r) r.Type = PageType).ToList
|
||
End If
|
||
Return Results
|
||
End Function
|
||
Private Sub Load_OnFinish()
|
||
Dim Results = GetResults()
|
||
|
||
'初始化筛选器
|
||
Dim VersionFilters As List(Of String)
|
||
|
||
'按小版本号筛选？
|
||
IsMajorVersionFilter = False
|
||
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
|
||
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
|
||
'按大版本号筛选？
|
||
If VersionFilters.Count >= 9 Then
|
||
IsMajorVersionFilter = True
|
||
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
|
||
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
|
||
End If
|
||
|
||
'UI 化筛选器
|
||
PanFilter.Children.Clear()
|
||
If VersionFilters.Count < 2 Then
|
||
CardFilter.Visibility = Visibility.Collapsed
|
||
VersionFilter = Nothing
|
||
Else
|
||
CardFilter.Visibility = Visibility.Visible
|
||
VersionFilters.Insert(0, "全部")
|
||
'转化为按钮
|
||
For Each Version As String In VersionFilters
|
||
Dim NewButton As New MyRadioButton With {
|
||
.Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight}
|
||
NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0)
|
||
AddHandler NewButton.Check,
|
||
Sub(sender As MyRadioButton, raiseByMouse As Boolean)
|
||
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
|
||
UpdateFilterResult()
|
||
End Sub
|
||
PanFilter.Children.Add(NewButton)
|
||
Next
|
||
'自动选择
|
||
Dim ToCheck As MyRadioButton = Nothing
|
||
If TargetVersion <> "" Then
|
||
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
|
||
If TargetFile IsNot Nothing Then
|
||
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True)
|
||
For Each Button As MyRadioButton In PanFilter.Children
|
||
If Button.Text <> TargetGroup Then Continue For
|
||
ToCheck = Button
|
||
Exit For
|
||
Next
|
||
End If
|
||
End If
|
||
If ToCheck Is Nothing Then ToCheck = PanFilter.Children(0)
|
||
ToCheck.Checked = True
|
||
End If
|
||
|
||
'更新筛选结果（文件列表 UI 化）
|
||
UpdateFilterResult()
|
||
End Sub
|
||
Private Sub UpdateFilterResult()
|
||
Dim Results = GetResults()
|
||
|
||
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompLoaderType.Any,
|
||
$"所选版本：{If(TargetLoader <> CompLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
|
||
'归类到卡片下
|
||
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
|
||
Dict.Add("其他版本", New List(Of CompFile))
|
||
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompLoaderType)))
|
||
For Each Version As CompFile In Results
|
||
For Each GameVersion In Version.GameVersions
|
||
'检查是否符合版本筛选器
|
||
If VersionFilter IsNot Nothing AndAlso
|
||
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
|
||
'决定添加到哪个卡片
|
||
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
|
||
'遍历加入的加载器列表
|
||
Dim Loaders As New List(Of String)
|
||
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
|
||
Version.Type = CompType.Mod AndAlso '是 Mod
|
||
VerName.StartsWith("1.") Then '不是 “快照版本” 之类的
|
||
For Each Loader In Version.ModLoaders
|
||
If Loader = CompLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
|
||
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
|
||
Next
|
||
End If
|
||
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的，确保它在一张卡片里
|
||
'实际添加
|
||
For Each Loader In Loaders
|
||
Dim TargetCard As String = Loader & VerName
|
||
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
|
||
Next
|
||
'添加筛选的版本的卡片
|
||
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True).StartsWithF(VersionFilter)) Then
|
||
Dict.Add(TargetCardName, New List(Of CompFile))
|
||
For Each Version As CompFile In Results
|
||
If Version.GameVersions.Contains(TargetVersion) AndAlso
|
||
(TargetLoader = CompLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
|
||
'检查是否符合版本筛选器
|
||
If VersionFilter IsNot Nothing AndAlso
|
||
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = VersionFilter) Then Continue For
|
||
If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
|
||
End If
|
||
Next
|
||
End If
|
||
'转化为 UI
|
||
Try
|
||
PanResults.Children.Clear()
|
||
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
|
||
If Not Pair.Value.Any() Then Continue For
|
||
'增加卡片
|
||
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15)} '9 是安装，8 是另存为
|
||
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.InstallMethod = Sub(Stack As StackPanel)
|
||
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.ReleaseDate > b.ReleaseDate)
|
||
Dim BadDisplayName = CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <> CType(Stack.Tag, List(Of CompFile)).Count
|
||
If Project.Type = CompType.ModPack Then
|
||
For Each item In Stack.Tag
|
||
Stack.Children.Add(CType(item, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=BadDisplayName))
|
||
Next
|
||
ElseIf Project.Type = CompType.World Then
|
||
For Each item In Stack.Tag
|
||
Stack.Children.Add(CType(item, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.InstallWorld_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=BadDisplayName))
|
||
Next
|
||
Else
|
||
CompFilesCardPreload(Stack, Stack.Tag)
|
||
|
||
For Each item In Stack.Tag
|
||
Stack.Children.Add(CType(item, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=BadDisplayName))
|
||
Next
|
||
End If
|
||
End Sub
|
||
NewCard.SwapControl = NewStack
|
||
PanResults.Children.Add(NewCard)
|
||
'确定卡片是否展开
|
||
If Pair.Key = TargetCardName OrElse
|
||
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
|
||
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
|
||
NewCard.StackInstall() '9 是安装，8 是另存为
|
||
Else
|
||
NewCard.IsSwapped = True
|
||
End If
|
||
'增加提示
|
||
If Pair.Key = "其他版本" Then
|
||
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢，可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)})
|
||
End If
|
||
Next
|
||
'如果只有一张卡片，展开第一张卡片
|
||
If PanResults.Children.Count = 1 Then
|
||
CType(PanResults.Children(0), MyCard).IsSwapped = False
|
||
End If
|
||
Catch ex As Exception
|
||
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
|
||
End Try
|
||
End Sub
|
||
Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String
|
||
If Name Is Nothing Then
|
||
Return "其他版本"
|
||
ElseIf Name.Contains("w") Then
|
||
Return "快照版本"
|
||
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then
|
||
Return "远古版本"
|
||
Else
|
||
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name)
|
||
End If
|
||
End Function
|
||
|
||
#End Region
|
||
Private IsFirstInit As Boolean = True
|
||
Public Sub Init() Handles Me.PageEnter
|
||
AniControlEnabled += 1
|
||
Project = FrmMain.PageCurrent.Additional(0)
|
||
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.CanInteraction = False
|
||
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)
|
||
|
||
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 InstanceName As String = MyMsgBoxInput("输入实例名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
|
||
If String.IsNullOrEmpty(InstanceName) Then Return
|
||
|
||
'构造步骤加载器
|
||
Dim Loaders As New List(Of LoaderBase)
|
||
Dim Target As String = $"{PathMcFolder}versions\{InstanceName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
|
||
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
|
||
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() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) 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
|
||
Return '不重新加载版本列表
|
||
End Select
|
||
McInstallFailedClearFolder(MyLoader)
|
||
End Sub}
|
||
Loader.Start(PathMcFolder & "versions\" & InstanceName & "\")
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
FrmMain.BtnExtraDownload.Ribble()
|
||
|
||
Catch ex As Exception
|
||
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
|
||
End Try
|
||
End Sub
|
||
'世界下载
|
||
Public Sub InstallWorld_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 DefaultFolder As String = Nothing
|
||
Dim SubFolder As String = "saves\"
|
||
Dim IsVersionSuitable As Func(Of McInstance, Boolean) = Nothing
|
||
'获取资源所需的加载器
|
||
Dim AllowedLoaders As New List(Of CompLoaderType)
|
||
If File.ModLoaders.Any Then
|
||
AllowedLoaders = File.ModLoaders
|
||
ElseIf Project.ModLoaders.Any Then
|
||
AllowedLoaders = Project.ModLoaders
|
||
End If
|
||
Log($"[Comp] 世界要求的加载器种类：" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
|
||
'判断某个版本是否符合资源要求
|
||
IsVersionSuitable =
|
||
Function(Version)
|
||
If Version Is Nothing Then Return False
|
||
If Not Version.IsLoaded Then Version.Load()
|
||
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
|
||
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
|
||
'加载器
|
||
If Not AllowedLoaders.Any() Then Return True '无要求
|
||
Return False
|
||
End Function
|
||
'获取常规资源默认下载位置
|
||
If CachedFolder.ContainsKey(Project.Type) AndAlso Not String.IsNullOrEmpty(CachedFolder(Project.Type)) Then
|
||
DefaultFolder = CachedFolder.GetOrDefault(Project.Type, If(McInstanceCurrent?.PathIndie, Path))
|
||
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置：{DefaultFolder}")
|
||
ElseIf McInstanceCurrent IsNot Nothing AndAlso IsVersionSuitable(McInstanceCurrent) Then
|
||
DefaultFolder = $"{McInstanceCurrent.PathIndie}{SubFolder}"
|
||
Directory.CreateDirectory(DefaultFolder)
|
||
Log($"[Comp] 使用当前实例作为默认下载位置：{DefaultFolder}")
|
||
Else
|
||
'查找所有可能的实例
|
||
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
|
||
If NeedLoad Then
|
||
Hint("正在查找适合的游戏实例……")
|
||
LoaderFolderRun(McInstanceListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
|
||
End If
|
||
Dim SuitableVersions = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsVersionSuitable(v)).
|
||
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
|
||
If SuitableVersions.Any Then
|
||
Dim SelectedVersion = SuitableVersions.
|
||
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
|
||
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
|
||
First()
|
||
DefaultFolder = SelectedVersion.FullName
|
||
Directory.CreateDirectory(DefaultFolder)
|
||
Log($"[Comp] 使用适合的游戏实例作为默认下载位置：{DefaultFolder}")
|
||
Else
|
||
DefaultFolder = PathMcFolder
|
||
If NeedLoad Then
|
||
Hint("当前 MC 文件夹中没有找到适合此资源文件的实例！")
|
||
Else
|
||
Log("[Comp] 由于当前实例不兼容，使用当前的 MC 文件夹作为默认下载位置")
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
Dim Target As String = SelectSaveFile("选择世界安装位置 (saves 文件夹)", File.FileName, "世界文件|" & "*.zip", DefaultFolder)
|
||
If String.IsNullOrEmpty(Target) Then Return
|
||
|
||
'构造步骤加载器
|
||
Dim Loaders As New List(Of LoaderBase)
|
||
Dim TargetPath As String = Target.BeforeLast("\")
|
||
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
|
||
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() ExtractFile(Target, TargetPath, Encoding.UTF8)) With {.ProgressWeight = 0.1, .Block = True})
|
||
Loaders.Add(New LoaderTask(Of Integer, Integer)("清理缓存", Sub() IO.File.Delete(Target)))
|
||
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
|
||
Loader.Start()
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
FrmMain.BtnExtraDownload.Ribble()
|
||
|
||
Catch ex As Exception
|
||
Log(ex, "下载世界资源失败", LogLevel.Feedback)
|
||
End Try
|
||
End Sub
|
||
'资源下载；整合包另存为
|
||
Public Shared CachedFolder As New Dictionary(Of CompType, String) '仅在本次缓存的下载文件夹
|
||
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 = Nothing
|
||
Select Case File.Type
|
||
Case CompType.ModPack : Desc = "整合包"
|
||
Case CompType.Mod : Desc = "Mod "
|
||
Case CompType.ResourcePack : Desc = "资源包"
|
||
Case CompType.Shader : Desc = "光影包"
|
||
Case CompType.DataPack : Desc = "数据包"
|
||
Case CompType.World : Desc = "世界"
|
||
End Select
|
||
'确认默认保存位置
|
||
Dim DefaultFolder As String = Nothing
|
||
If File.Type <> CompType.ModPack Then
|
||
Dim SubFolder As String = Nothing
|
||
Select Case Project.Type
|
||
Case CompType.Mod : SubFolder = "mods\"
|
||
Case CompType.ResourcePack : SubFolder = "resourcepacks\"
|
||
Case CompType.Shader : SubFolder = "shaderpacks\"
|
||
Case CompType.World : SubFolder = "saves\"
|
||
Case CompType.DataPack : SubFolder = "" '导航到版本根目录
|
||
End Select
|
||
Dim IsVersionSuitable As Func(Of McInstance, Boolean) = Nothing
|
||
'获取资源所需的加载器
|
||
Dim AllowedLoaders As New List(Of CompLoaderType)
|
||
If File.ModLoaders.Any Then
|
||
AllowedLoaders = File.ModLoaders
|
||
ElseIf Project.ModLoaders.Any Then
|
||
AllowedLoaders = Project.ModLoaders
|
||
End If
|
||
Log($"[Comp] {Desc}要求的加载器种类：" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
|
||
'判断某个版本是否符合资源要求
|
||
IsVersionSuitable =
|
||
Function(Version)
|
||
If Version Is Nothing Then Return False
|
||
If Not Version.IsLoaded Then Version.Load()
|
||
'只对 Mod 和数据包进行版本检测
|
||
If Project.Type = CompType.Mod OrElse Project.Type = CompType.DataPack Then
|
||
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
|
||
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
|
||
End If
|
||
'加载器
|
||
If Not AllowedLoaders.Any() Then Return True '无要求
|
||
If AllowedLoaders.Contains(CompLoaderType.Forge) AndAlso Version.Version.HasForge Then Return True
|
||
If AllowedLoaders.Contains(CompLoaderType.Fabric) AndAlso Version.Version.HasFabric OrElse Version.Version.HasLegacyFabric Then Return True
|
||
If AllowedLoaders.Contains(CompLoaderType.NeoForge) AndAlso Version.Version.HasNeoForge Then Return True
|
||
If AllowedLoaders.Contains(CompLoaderType.LiteLoader) AndAlso Version.Version.HasLiteLoader Then Return True
|
||
Return False
|
||
End Function
|
||
'获取常规资源默认下载位置
|
||
If CachedFolder.ContainsKey(Project.Type) AndAlso Not String.IsNullOrEmpty(CachedFolder(Project.Type)) Then
|
||
DefaultFolder = CachedFolder.GetOrDefault(Project.Type, If(McInstanceCurrent?.PathIndie, Path))
|
||
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置：{DefaultFolder}")
|
||
ElseIf McInstanceCurrent IsNot Nothing AndAlso IsVersionSuitable(McInstanceCurrent) Then
|
||
DefaultFolder = $"{McInstanceCurrent.PathIndie}{SubFolder}"
|
||
Directory.CreateDirectory(DefaultFolder)
|
||
Log($"[Comp] 使用当前实例作为默认下载位置：{DefaultFolder}")
|
||
Else
|
||
'查找所有可能的实例
|
||
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
|
||
If NeedLoad Then
|
||
Hint("正在查找适合的游戏实例……")
|
||
LoaderFolderRun(McInstanceListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
|
||
End If
|
||
Dim SuitableVersions = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsVersionSuitable(v)).
|
||
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
|
||
If SuitableVersions.Any Then
|
||
Dim SelectedVersion = SuitableVersions.
|
||
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
|
||
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
|
||
First()
|
||
DefaultFolder = SelectedVersion.FullName
|
||
Directory.CreateDirectory(DefaultFolder)
|
||
Log($"[Comp] 使用适合的游戏实例作为默认下载位置：{DefaultFolder}")
|
||
Else
|
||
DefaultFolder = PathMcFolder
|
||
If NeedLoad Then
|
||
Hint("当前 MC 文件夹中没有找到适合此资源文件的实例！")
|
||
Else
|
||
Log("[Comp] 由于当前实例不兼容，使用当前的 MC 文件夹作为默认下载位置")
|
||
End If
|
||
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.BeforeFirst(" (").BeforeFirst(" - ").
|
||
Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
|
||
Select Case Setup.Get("ToolDownloadTranslateV2")
|
||
Case 0
|
||
FileName = $"【{ChineseName}】{File.FileName}"
|
||
Case 1
|
||
FileName = $"[{ChineseName}] {File.FileName}"
|
||
Case 2
|
||
FileName = $"{ChineseName}-{File.FileName}"
|
||
Case 3
|
||
FileName = $"{File.FileName}-{ChineseName}"
|
||
Case Else
|
||
FileName = File.FileName
|
||
End Select
|
||
End If
|
||
RunInUi(
|
||
Sub()
|
||
'弹窗要求选择保存位置
|
||
Dim Target As String
|
||
Target = SelectSaveFile("选择保存位置", FileName,
|
||
Desc & "文件|" &
|
||
If(File.Type = CompType.Mod,
|
||
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
|
||
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
|
||
If Not Target.Contains("\") Then Return
|
||
'构造步骤加载器
|
||
Dim LoaderName As String = Desc & "下载：" & GetFileNameWithoutExtentionFromPath(Target) & " "
|
||
If Target <> DefaultFolder Then
|
||
If CachedFolder.ContainsKey(Project.Type) Then
|
||
CachedFolder(Project.Type) = GetPathFromFullPath(Target)
|
||
Else
|
||
CachedFolder.Add(Project.Type, GetPathFromFullPath(Target))
|
||
End If
|
||
End If
|
||
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 LoaderStateChangedHintOnly}
|
||
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 BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
|
||
ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
|
||
End Sub
|
||
Private Sub BtnFavorites_Click(sender As Object, e As EventArgs) Handles BtnFavorites.Click
|
||
CompFavorites.ShowMenu(Project, sender)
|
||
End Sub
|
||
Private Sub BtnIntroLinkCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroLinkCopy.Click
|
||
CompClipboard.CurrentText = Project.Website
|
||
ClipboardSet(Project.Website)
|
||
End Sub
|
||
'翻译简介
|
||
Private Async Sub BtnTranslate_Click(sender As Object, e As EventArgs) Handles BtnTranslate.Click
|
||
Hint($"正在获取 {Project.TranslatedName} 的简介译文……")
|
||
Dim ChineseDescription = Await Project.ChineseDescription
|
||
If ChineseDescription Is Nothing Then Return
|
||
MyMsgBox($"原文：{Project.Description}{Environment.NewLine}译文：{ChineseDescription}")
|
||
End Sub
|
||
End Class
|