| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261 |
- Public Class PageDownloadCfDetail
- Private CfItem As MyCfItem = Nothing
- Private Project As DlCfProject
- #Region "加载器"
- '初始化加载器信息
- Private Sub PageDownloadCfDetail_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)
- 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
- Case LoadState.Failed
- Dim ErrorMessage As String = ""
- If DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message
- If ErrorMessage.Contains("不是有效的 Json 文件") Then
- Log("[Download] 下载的 Mod 列表 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()
- '初始化字典,并将当前版本排在最上面
- Dim TopVersion As String
- If Project.IsModPack Then
- TopVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
- Else
- 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 的问题,但实在找不到,就瞎加点检测
- Try
- Dict.Add("未知版本", New List(Of DlCfFile))
- If DlCfFileLoader.Output Is Nothing Then
- Log("[Download] 列表加载输出为 Nothing,请反馈此问题", LogLevel.Feedback)
- Exit Try
- End If
- For Each Version As DlCfFile In DlCfFileLoader.Output
- If Version Is Nothing Then
- Log("[Download] 列表中的一个版本为 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
- '决定添加到哪个版本
- Dim TargetVersion As String
- If GameVersion Is Nothing OrElse GameVersion.Split(".").Count < 2 Then
- TargetVersion = "未知版本"
- Else
- TargetVersion = GameVersion
- End If
- '实际进行添加
- If Not Dict.ContainsKey(TargetVersion) Then Dict.Add(TargetVersion, New List(Of DlCfFile))
- If Not Dict(TargetVersion).Contains(Version) Then Dict(TargetVersion).Add(Version)
- Next
- Next
- Catch ex As Exception
- Log(ex, "准备工程下载列表出错", LogLevel.Feedback)
- End Try
- #Region "转化为 UI"
- Try
- '清空当前
- PanMain.Children.Clear()
- '转化为 UI
- For Each Pair As KeyValuePair(Of String, List(Of DlCfFile)) 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 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, 8, Pair.Key)
- 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 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)
- '决定按钮显示
- BtnIntroWiki.Visibility = If(Project.McWikiId = 0, Visibility.Collapsed, Visibility.Visible)
- BtnIntroMCBBS.Visibility = If(Project.MCBBS Is Nothing, Visibility.Collapsed, Visibility.Visible)
- AniControlEnabled -= 1
- End Sub
- '整合包下载(安装)
- Public Sub Install_Click(sender As MyListItem, e As EventArgs)
- Try
- '获取基本信息
- Dim File As DlCfFile = sender.Tag
- Dim LoaderName As String = "CurseForge 整合包下载:" & Project.ChineseName & " "
- '获取版本名
- Dim PackName As String = Project.ChineseName.Replace(".zip", "").Replace(".rar", "").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},
- Title:="输入版本名", Button2:="取消")
- If String.IsNullOrEmpty(VersionName) Then Exit Sub
- '构造步骤加载器
- Dim Loaders As New List(Of LoaderBase)
- Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
- Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True})
- Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Sub() ModpackInstall(Target, VersionName)) 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 & "失败:" & GetString(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, "下载 CurseForge 整合包失败", LogLevel.Feedback)
- End Try
- End Sub
- 'Mod 下载;整合包另存为
- Public Shared DownloadFolder = Nothing '仅在本次缓存的下载文件夹
- Public Sub Save_Click(sender As Object, e As EventArgs)
- Try
- Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ")
- '确认默认保存位置
- Dim DefaultFolder As String = Nothing
- If Not Project.IsModPack Then
- DefaultFolder = DownloadFolder
- If McVersionCurrent IsNot Nothing Then
- If Not McVersionCurrent.IsLoaded Then McVersionCurrent.Load()
- If McVersionCurrent.Modable Then
- DefaultFolder = McVersionCurrent.PathIndie & "mods\"
- Directory.CreateDirectory(DefaultFolder)
- End If
- End If
- If String.IsNullOrEmpty(DefaultFolder) Then DefaultFolder = Nothing
- End If
- '获取基本信息
- Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
- Dim ChineseName As String = If(Project.ChineseName = Project.Name, "",
- Project.ChineseName.Replace(" (", "Å").Split("Å").First.Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":"))
- Dim FileName As String
- Select Case Setup.Get("ToolDownloadTranslate")
- Case 0
- FileName = If(ChineseName = "", "", "[" & ChineseName & "] ") & File.FileName
- Case 1
- FileName = If(ChineseName = "", "", ChineseName & "-") & File.FileName
- Case 2
- FileName = File.FileName & If(ChineseName = "", "", "-" & ChineseName)
- Case Else
- FileName = File.FileName
- End Select
- Dim Target As String
- If File.FileName.EndsWith(".litemod") Then
- Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.litemod"), DefaultFolder)
- Else
- Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.jar"), DefaultFolder)
- End If
- If Not Target.Contains("\") Then Exit Sub
- Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " "
- If Target <> DefaultFolder AndAlso Not Project.IsModPack Then DownloadFolder = GetPathFromFullPath(Target)
- '构造步骤加载器
- Dim Loaders As New List(Of LoaderBase)
- Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 6, .Block = True})
- '启动
- Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
- Loader.Start(1)
- LoaderTaskbarAdd(Loader)
- FrmMain.BtnExtraDownload.ShowRefresh()
- FrmMain.BtnExtraDownload.Ribble()
- Catch ex As Exception
- Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback)
- End Try
- End Sub
- Private Sub BtnIntroCf_Click(sender As Object, e As EventArgs) Handles BtnIntroCf.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.McWikiId & ".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
- End Class
|