| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767 |
- Public Module ModDownload
- #Region "DlClient* | Minecraft 客户端"
- ''' <summary>
- ''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息,要求对应依赖版本已存在。
- ''' 失败则抛出异常,不需要下载则返回 Nothing。
- ''' </summary>
- Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
- '获取底层继承版本
- Do While Not String.IsNullOrEmpty(Version.InheritVersion)
- Version = New McVersion(Version.InheritVersion)
- Loop
- '检查 Json 是否标准
- If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
- Throw New Exception("底层版本 " & Version.Name & " 中无 Jar 文件下载信息")
- End If
- '检查文件
- Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
- If ReturnNothingOnFileUseable Then
- '是否跳过
- Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets")
- Select Case Setup.Get("VersionAdvanceAssets", Version:=Version)
- Case 0 '使用全局设置
- Case 1 '开启
- IsSetupSkip = False
- Case 2 '关闭
- IsSetupSkip = True
- End Select
- If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
- If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
- End If
- '返回下载信息
- Dim JarUrl As String = Version.JsonObject("downloads")("client")("url")
- Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
- End Function
- ''' <summary>
- ''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息,要求对应依赖版本已存在。
- ''' 若未找到,则会返回 Legacy 资源文件或 Nothing。
- ''' </summary>
- Public Function DlClientAssetIndexGet(Version As McVersion) As NetFile
- '获取底层继承版本
- Do While Not String.IsNullOrEmpty(Version.InheritVersion)
- Version = New McVersion(Version.InheritVersion)
- Loop
- '获取信息
- Dim IndexInfo = McAssetsGetIndex(Version, True, True)
- Dim IndexAddress As String = PathMcFolder & "assets\indexes\" & IndexInfo("id").ToString & ".json"
- Log("[Download] 版本 " & Version.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
- Dim IndexUrl As String = If(IndexInfo("url"), "")
- If IndexUrl = "" Then
- Return Nothing
- Else
- Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl, False), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
- End If
- End Function
- ''' <summary>
- ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
- ''' </summary>
- Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase)
- Dim Loaders As New List(Of LoaderBase)
- #Region "下载支持库文件"
- Dim LoadersLib As New List(Of LoaderBase) From {
- New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
- New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
- }
- '构造加载器
- Loaders.Add(New LoaderCombo(Of String)("下载支持库文件(主加载器)", LoadersLib) With {.Block = False, .Show = False, .ProgressWeight = 16})
- #End Region
- #Region "下载资源文件"
- Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets")
- Select Case Setup.Get("VersionAdvanceAssets", Version:=Version)
- Case 0
- '使用全局设置
- Case 1
- '开启
- IsSetupSkip = False
- Case 2
- '关闭
- IsSetupSkip = True
- End Select
- If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
- If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
- Dim LoadersAssets As New List(Of LoaderBase)
- '获取资源文件索引地址
- LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
- Sub(Task As LoaderTask(Of String, List(Of NetFile)))
- Try
- Dim IndexFile = DlClientAssetIndexGet(Version)
- Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
- If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
- Task.Output = New List(Of NetFile)
- Else
- Task.Output = New List(Of NetFile) From {IndexFile}
- End If
- Catch ex As Exception
- Throw New Exception("分析资源文件索引地址失败", ex)
- End Try
- End Sub) With {.ProgressWeight = 0.5, .Show = False})
- '下载资源文件索引
- LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
- '要求独立更新索引
- If AssetsIndexBehaviour = AssetsIndexExistsBehaviour.DownloadInBackground Then
- Dim LoadersAssetsUpdate As New List(Of LoaderBase)
- Dim TempAddress As String = Nothing
- Dim RealAddress As String = Nothing
- LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", Sub(Task As LoaderTask(Of String, List(Of NetFile)))
- Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
- RealAddress = BackAssetsFile.LocalPath
- TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
- BackAssetsFile.LocalPath = TempAddress
- Task.Output = New List(Of NetFile) From {BackAssetsFile}
- End Sub))
- LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
- LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
- CopyFile(TempAddress, RealAddress)
- McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
- End Sub))
- Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
- Log("[Download] 开始后台更新资源文件索引")
- Updater.Start()
- End If
- '获取资源文件地址
- LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
- Sub(Task As LoaderTask(Of String, List(Of NetFile)))
- Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
- End Sub) With {.ProgressWeight = 3})
- '下载资源文件
- LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
- '构造加载器
- Loaders.Add(New LoaderCombo(Of String)("下载资源文件(主加载器)", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 30.5})
- End If
- #End Region
- Return Loaders
- End Function
- Public Enum AssetsIndexExistsBehaviour
- ''' <summary>
- ''' 如果文件存在,则不进行下载。
- ''' </summary>
- DontDownload
- ''' <summary>
- ''' 如果文件存在,则启动新的下载加载器进行独立的更新。
- ''' </summary>
- DownloadInBackground
- ''' <summary>
- ''' 如果文件存在,也同样进行下载。
- ''' </summary>
- AlwaysDownload
- End Enum
- #End Region
- #Region "DlClientList | Minecraft 客户端 版本列表"
- '主加载器
- Public Structure DlClientListResult
- ''' <summary>
- ''' 数据来源名称,如“Mojang”,“BMCLAPI”。
- ''' </summary>
- Public SourceName As String
- ''' <summary>
- ''' 是否为官方的实时数据。
- ''' </summary>
- Public IsOfficial As Boolean
- ''' <summary>
- ''' 获取到的 Json 数据。
- ''' </summary>
- Public Value As JObject
- '''' <summary>
- '''' 官方源的失败原因。若没有则为 Nothing。
- '''' </summary>
- 'Public OfficialError As Exception
- End Structure
- ''' <summary>
- ''' Minecraft 客户端 版本列表,主加载器。
- ''' </summary>
- Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
- Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult))
- Select Case Setup.Get("ToolDownloadVersion")
- Case 0
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
- New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60)
- }, Loader.IsForceRestarting)
- Case 1
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
- New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35)
- }, Loader.IsForceRestarting)
- Case Else
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
- New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60)
- }, Loader.IsForceRestarting)
- End Select
- End Sub
- '各个下载源的分加载器
- ''' <summary>
- ''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
- ''' </summary>
- Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
- Private IsNewClientVersionHinted As Boolean = False
- Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult))
- Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
- Try
- Dim Versions As JArray = Json("versions")
- If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
- '添加 PCL2 特供项
- If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
- '返回
- Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
- '解析更新提示(Release)
- Dim Version As String = Json("latest")("release")
- If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateReleaseLast") = Version Then
- McDownloadClientUpdateHint(Version, Json)
- IsNewClientVersionHinted = True
- End If
- McVersionHighest = Version.Split(".")(1)
- Setup.Set("ToolUpdateReleaseLast", Version)
- '解析更新提示(Snapshot)
- Version = Json("latest")("snapshot")
- If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = Version AndAlso Not IsNewClientVersionHinted Then
- McDownloadClientUpdateHint(Version, Json)
- End If
- Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
- Catch ex As Exception
- Throw New Exception("版本列表解析失败", ex)
- End Try
- End Sub
- ''' <summary>
- ''' Minecraft 客户端 版本列表,BMCLAPI 源加载器。
- ''' </summary>
- Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
- Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
- Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json",
- BackupUrl:="https://download.mcbbs.net/mc/game/version_manifest.json",
- IsJson:=True)
- Try
- Dim Versions As JArray = Json("versions")
- If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
- '添加 PCL2 特供项
- If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
- '返回
- Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
- Catch ex As Exception
- Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
- End Try
- End Sub
- ''' <summary>
- ''' 获取某个版本的 Json 下载地址,若失败则返回 Nothing。必须在工作线程执行。
- ''' </summary>
- Public Function DlClientListGet(Id As String)
- Try
- '确认 Minecraft 版本列表已完成获取
- Select Case DlClientListLoader.State
- Case LoadState.Loading
- DlClientListLoader.WaitForExit()
- Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
- DlClientListLoader.WaitForExit(IsForceRestart:=True)
- End Select
- '确认版本格式标准
- Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
- If Id <> "1.0" AndAlso Id.EndsWith(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
- '查找版本并开始
- For Each Version As JObject In DlClientListLoader.Output.Value("versions")
- If Version("id") = Id Then
- Return Version("url").ToString
- End If
- Next
- Log("未发现版本 " & Id & " 的 Json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug)
- Return Nothing
- Catch ex As Exception
- Log(ex, "获取版本 " & Id & " 的 Json 下载地址失败")
- Return Nothing
- End Try
- End Function
- #End Region
- #Region "DlOptiFineList | OptiFine 版本列表"
- Public Structure DlOptiFineListResult
- ''' <summary>
- ''' 数据来源名称,如“Official”,“BMCLAPI”。
- ''' </summary>
- Public SourceName As String
- ''' <summary>
- ''' 是否为官方的实时数据。
- ''' </summary>
- Public IsOfficial As Boolean
- ''' <summary>
- ''' 获取到的数据。
- ''' </summary>
- Public Value As List(Of DlOptiFineListEntry)
- End Structure
- Public Class DlOptiFineListEntry
- ''' <summary>
- ''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
- ''' </summary>
- Public NameDisplay As String
- ''' <summary>
- ''' 原始文件名称,如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。
- ''' </summary>
- Public NameFile As String
- ''' <summary>
- ''' 对应的版本名称,如“1.13.2-OptiFine_HD_U_E6”。
- ''' </summary>
- Public NameVersion As String
- ''' <summary>
- ''' 是否为测试版。
- ''' </summary>
- Public IsPreview As Boolean
- ''' <summary>
- ''' 对应的 Minecraft 版本,如“1.12.2”。
- ''' </summary>
- Public Property Inherit As String
- Get
- Return _inherit
- End Get
- Set(value As String)
- If value.EndsWith(".0") Then value = Left(value, value.Length - 2)
- _inherit = value
- End Set
- End Property
- Private _inherit As String
- ''' <summary>
- ''' 发布时间,格式为“yyyy/mm/dd”。OptiFine 源无此数据。
- ''' </summary>
- Public ReleaseTime As String
- ''' <summary>
- ''' 需要的最低 Forge 版本。空字符串为无限制,“28.1.56” 表示版本号,“1161” 表示版本号的最后一位。
- ''' </summary>
- Public RequiredForgeVersion As String
- End Class
- ''' <summary>
- ''' OptiFine 版本列表,主加载器。
- ''' </summary>
- Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
- Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
- Select Case Setup.Get("ToolDownloadVersion")
- Case 0
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
- New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60)
- }, Loader.IsForceRestarting)
- Case 1
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5),
- New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35)
- }, Loader.IsForceRestarting)
- Case Else
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60),
- New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60)
- }, Loader.IsForceRestarting)
- End Select
- End Sub
- ''' <summary>
- ''' OptiFine 版本列表,官方源。
- ''' </summary>
- Public DlOptiFineListOfficialLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Official", AddressOf DlOptiFineListOfficialMain)
- Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
- Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
- If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
- '获取所有版本信息
- Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
- Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
- Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
- If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
- If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
- If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
- '转化为列表输出
- Dim Versions As New List(Of DlOptiFineListEntry)
- For i = 0 To ReleaseTime.Count - 1
- Name(i) = Name(i).Replace("_", " ")
- Dim Entry As New DlOptiFineListEntry With {
- .NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
- .ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
- .IsPreview = Name(i).ToLower.Contains("pre"),
- .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("#", "")}
- Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
- Versions.Add(Entry)
- Next
- Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
- End Sub
- ''' <summary>
- ''' OptiFine 版本列表,BMCLAPI。
- ''' </summary>
- Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
- Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
- Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList",
- BackupUrl:="https://download.mcbbs.net/optifine/versionList", IsJson:=True)
- Try
- Dim Versions As New List(Of DlOptiFineListEntry)
- For Each Token As JObject In Json
- Dim Entry As New DlOptiFineListEntry With {
- .NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
- .ReleaseTime = "",
- .IsPreview = Token("patch").ToString.ToLower.Contains("pre"),
- .Inherit = Token("mcversion").ToString,
- .NameFile = Token("filename").ToString,
- .RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
- }
- Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
- Versions.Add(Entry)
- Next
- Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
- Catch ex As Exception
- Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
- End Try
- End Sub
- #End Region
- #Region "DlForgeList | Forge Minecraft 版本列表"
- Public Structure DlForgeListResult
- ''' <summary>
- ''' 数据来源名称,如“Official”,“BMCLAPI”。
- ''' </summary>
- Public SourceName As String
- ''' <summary>
- ''' 是否为官方的实时数据。
- ''' </summary>
- Public IsOfficial As Boolean
- ''' <summary>
- ''' 获取到的数据。
- ''' </summary>
- Public Value As List(Of String)
- End Structure
- ''' <summary>
- ''' Forge 版本列表,主加载器。
- ''' </summary>
- Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
- Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
- Select Case Setup.Get("ToolDownloadVersion")
- Case 0
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
- New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60)
- }, Loader.IsForceRestarting)
- Case 1
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5),
- New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35)
- }, Loader.IsForceRestarting)
- Case Else
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60),
- New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60)
- }, Loader.IsForceRestarting)
- End Select
- End Sub
- ''' <summary>
- ''' Forge 版本列表,官方源。
- ''' </summary>
- Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
- Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
- Dim Result As String = NetGetCodeByRequestRetry("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html")
- If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
- '获取所有版本信息
- Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
- Names.Add("1.2.4") '1.2.4 不会被匹配上
- If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
- Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
- End Sub
- ''' <summary>
- ''' Forge 版本列表,BMCLAPI。
- ''' </summary>
- Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
- Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
- Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default,
- BackupUrl:="https://download.mcbbs.net/forge/minecraft")
- If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
- '获取所有版本信息
- Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
- If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
- Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
- End Sub
- #End Region
- #Region "DlForgeVersion | Forge 版本列表"
- Public Class DlForgeVersionEntry
- ''' <summary>
- ''' 完整的版本名,如 “14.22.1.2478”。
- ''' </summary>
- Public Version As String
- ''' <summary>
- ''' 对应的 Minecraft 版本,如“1.12.2”。
- ''' </summary>
- Public Inherit As String
- ''' <summary>
- ''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
- ''' </summary>
- Public ReleaseTime As String
- ''' <summary>
- ''' 文件的 MD5 或 SHA1(BMCLAPI 的老版本是 MD5,新版本是 SHA1;官方源总是 MD5)。
- ''' </summary>
- Public Hash As String = Nothing
- ''' <summary>
- ''' 是否为推荐版本。
- ''' </summary>
- Public IsRecommended As Boolean
- ''' <summary>
- ''' 安装类型。有 installer、client、universal 三种。
- ''' </summary>
- Public Category As String
- ''' <summary>
- ''' 版本分支。若无分支则为 Nothing。
- ''' </summary>
- Public Branch As String = Nothing
- ''' <summary>
- ''' 是否为新版 Forge。(即为 Minecraft 1.13+)
- ''' </summary>
- Public ReadOnly Property IsNewType As Boolean
- Get
- Return Version.Split(".")(0) >= 20
- End Get
- End Property
- ''' <summary>
- ''' 构建数。
- ''' </summary>
- Public ReadOnly Property Build As Integer
- Get
- Dim Version = Me.Version.Split(".")
- If Version(0) < 15 Then
- Return Version(Version.Count - 1)
- Else
- Return Version(Version.Count - 1) + 10000
- End If
- End Get
- End Property
- ''' <summary>
- ''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。
- ''' </summary>
- Public ReadOnly Property FileVersion As String
- Get
- Return Version & If(Branch Is Nothing, "", "-" & Branch)
- End Get
- End Property
- ''' <summary>
- ''' 即将下载的文件全名。
- ''' </summary>
- Public ReadOnly Property FileName As String
- Get
- Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix
- End Get
- End Property
- ''' <summary>
- ''' 文件扩展名。
- ''' </summary>
- Public ReadOnly Property FileSuffix As String
- Get
- If Category = "installer" Then
- Return "jar"
- Else
- Return "zip"
- End If
- End Get
- End Property
- End Class
- ''' <summary>
- ''' Forge 版本列表,主加载器。
- ''' </summary>
- Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
- Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain)
- Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain)
- Select Case Setup.Get("ToolDownloadVersion")
- Case 0
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
- New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60)
- }, Loader.IsForceRestarting)
- Case 1
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5),
- New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35)
- }, Loader.IsForceRestarting)
- Case Else
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60),
- New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60)
- }, Loader.IsForceRestarting)
- End Select
- End Sub
- ''' <summary>
- ''' Forge 版本列表,官方源。
- ''' </summary>
- Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
- Dim Result As String
- Try
- Result = NetGetCodeByDownload("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html")
- Catch ex As Exception
- If GetExceptionSummary(ex).Contains("(404)") Then
- Throw New Exception("没有可用版本")
- Else
- Throw
- End If
- End Try
- If Result.Length < 1000 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
- Dim Versions As New List(Of DlForgeVersionEntry)
- Try
- '分割版本信息
- Dim VersionCodes = Mid(Result, 1, Result.LastIndexOf("</table>")).Replace("<td class=""download-version", "¨").Split("¨")
- '获取所有版本信息
- For i = 1 To VersionCodes.Count - 1
- Dim VersionCode = VersionCodes(i)
- Try
- '基础信息获取
- Dim Name As String = RegexSeek(VersionCode, "(?<=[^(0-9)]+)[0-9\.]+")
- Dim IsRecommended As Boolean = VersionCode.Contains("fa promo-recommended")
- Dim Inherit As String = Loader.Input
- '分支获取
- Dim Branch As String = RegexSeek(VersionCode, "(?<=Branch:</strong>[\s]*)[^<]+")
- Branch = RegexSeek(If(Branch, ""), "[^\s]+")
- If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
- If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
- If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
- '发布时间获取
- Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+")
- Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式:"2021-02-15 03:24:02"
- Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日
- ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒
- 0, DateTimeKind.Utc) '以 UTC 时间作为标准
- Dim ReleaseTime As String = ReleaseDate.ToLocalTime.ToString("yyyy/MM/dd HH:mm") '时区与格式转换
- '分类与 MD5 获取
- Dim MD5 As String, Category As String
- If VersionCode.Contains("classifier-installer""") Then
- '类型为 installer.jar,支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
- VersionCode = VersionCode.Substring(VersionCode.IndexOf("installer.jar"))
- MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
- Category = "installer"
- ElseIf VersionCode.Contains("classifier-universal""") Then
- '类型为 universal.zip,支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
- VersionCode = VersionCode.Substring(VersionCode.IndexOf("universal.zip"))
- MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
- Category = "universal"
- ElseIf VersionCode.Contains("client.zip") Then
- '类型为 client.zip,支持范围 182~ (1.3.2 部分 ~)
- VersionCode = VersionCode.Substring(VersionCode.IndexOf("client.zip"))
- MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
- Category = "client"
- Else
- '没有任何下载(1.6.4 有一部分这种情况)
- Continue For
- End If
- '添加进列表
- Versions.Add(New DlForgeVersionEntry With {.Category = Category, .Version = Name, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch})
- Catch ex As Exception
- Throw New Exception("版本信息提取失败(" & VersionCode & ")", ex)
- End Try
- Next
- Catch ex As Exception
- Throw New Exception("版本列表解析失败(" & Result & ")", ex)
- End Try
- If Versions.Count = 0 Then Throw New Exception("没有可用版本")
- Loader.Output = Versions
- End Sub
- ''' <summary>
- ''' Forge 版本列表,BMCLAPI。
- ''' </summary>
- Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
- Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input,
- BackupUrl:="https://download.mcbbs.net/forge/minecraft/" & Loader.Input, IsJson:=True)
- Dim Versions As New List(Of DlForgeVersionEntry)
- Try
- Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
- For Each Token As JObject In Json
- '分类与 Hash 获取
- Dim Hash As String = Nothing, Category As String = "unknown", Proi As Integer = -1
- For Each File As JObject In Token("files")
- Select Case File("category").ToString
- Case "installer"
- If File("format").ToString = "jar" Then
- '类型为 installer.jar,支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
- Hash = File("hash")
- Category = "installer"
- Proi = 2
- End If
- Case "universal"
- If Proi <= 1 AndAlso File("format").ToString = "zip" Then
- '类型为 universal.zip,支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
- Hash = File("hash")
- Category = "universal"
- Proi = 1
- End If
- Case "client"
- If Proi <= 0 AndAlso File("format").ToString = "zip" Then
- '类型为 client.zip,支持范围 182~ (1.3.2 部分 ~)
- Hash = File("hash")
- Category = "client"
- Proi = 0
- End If
- End Select
- Next
- '获取 Entry
- Dim Inherit As String = Loader.Input
- Dim Branch As String = Token("branch")
- Dim Name As String = Token("version")
- If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
- If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
- '基础信息获取
- Dim Entry = New DlForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit, .IsRecommended = Recommended = Name}
- Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c)
- Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy/MM/dd HH:mm")
- '添加项
- Versions.Add(Entry)
- Next
- Catch ex As Exception
- Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
- End Try
- If Versions.Count = 0 Then Throw New Exception("没有可用版本")
- Loader.Output = Versions
- End Sub
- #End Region
- #Region "DlLiteLoaderList | LiteLoader 版本列表"
- Public Structure DlLiteLoaderListResult
- ''' <summary>
- ''' 数据来源名称,如“Official”,“BMCLAPI”。
- ''' </summary>
- Public SourceName As String
- ''' <summary>
- ''' 是否为官方的实时数据。
- ''' </summary>
- Public IsOfficial As Boolean
- ''' <summary>
- ''' 获取到的数据。
- ''' </summary>
- Public Value As List(Of DlLiteLoaderListEntry)
- ''' <summary>
- ''' 官方源的失败原因。若没有则为 Nothing。
- ''' </summary>
- Public OfficialError As Exception
- End Structure
- Public Class DlLiteLoaderListEntry
- ''' <summary>
- ''' 实际的文件名,如“liteloader-installer-1.12-00-SNAPSHOT.jar”。
- ''' </summary>
- Public FileName As String
- ''' <summary>
- ''' 是否为测试版。
- ''' </summary>
- Public IsPreview As Boolean
- ''' <summary>
- ''' 对应的 Minecraft 版本,如“1.12.2”。
- ''' </summary>
- Public Inherit As String
- ''' <summary>
- ''' 是否为 1.7 及更早的远古版。
- ''' </summary>
- Public IsLegacy As Boolean
- ''' <summary>
- ''' 发布时间,格式为“yyyy/mm/dd HH:mm”。
- ''' </summary>
- Public ReleaseTime As String
- ''' <summary>
- ''' 文件的 MD5。
- ''' </summary>
- Public MD5 As String
- ''' <summary>
- ''' 对应的 Json 项。
- ''' </summary>
- Public JsonToken As JToken
- End Class
- ''' <summary>
- ''' LiteLoader 版本列表,主加载器。
- ''' </summary>
- Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
- Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
- Select Case Setup.Get("ToolDownloadVersion")
- Case 0
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
- New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60)
- }, Loader.IsForceRestarting)
- Case 1
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5),
- New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35)
- }, Loader.IsForceRestarting)
- Case Else
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60),
- New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60)
- }, Loader.IsForceRestarting)
- End Select
- End Sub
- ''' <summary>
- ''' LiteLoader 版本列表,官方源。
- ''' </summary>
- Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
- Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
- Dim Result As JObject = NetGetCodeByRequestRetry("http://dl.liteloader.com/versions/versions.json", IsJson:=True)
- Try
- Dim Json As JObject = Result("versions")
- Dim Versions As New List(Of DlLiteLoaderListEntry)
- For Each Pair As KeyValuePair(Of String, JToken) In Json
- If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
- Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
- Versions.Add(New DlLiteLoaderListEntry With {
- .Inherit = Pair.Key,
- .IsLegacy = Pair.Key.Split(".")(1) < 8,
- .IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
- .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
- .MD5 = RealEntry("md5"),
- .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
- .JsonToken = RealEntry
- })
- Next
- Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = True, .SourceName = "LiteLoader 官方源", .Value = Versions}
- Catch ex As Exception
- Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
- End Try
- End Sub
- ''' <summary>
- ''' LiteLoader 版本列表,BMCLAPI。
- ''' </summary>
- Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
- Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
- Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json",
- BackupUrl:="https://download.mcbbs.net/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
- Try
- Dim Json As JObject = Result("versions")
- Dim Versions As New List(Of DlLiteLoaderListEntry)
- For Each Pair As KeyValuePair(Of String, JToken) In Json
- If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
- Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
- Versions.Add(New DlLiteLoaderListEntry With {
- .Inherit = Pair.Key,
- .IsLegacy = Pair.Key.Split(".")(1) < 8,
- .IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
- .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
- .MD5 = RealEntry("md5"),
- .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
- .JsonToken = RealEntry
- })
- Next
- Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
- Catch ex As Exception
- Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
- End Try
- End Sub
- #End Region
- #Region "DlFabricList | Fabric 列表"
- Public Structure DlFabricListResult
- ''' <summary>
- ''' 数据来源名称,如“Official”,“BMCLAPI”。
- ''' </summary>
- Public SourceName As String
- ''' <summary>
- ''' 是否为官方的实时数据。
- ''' </summary>
- Public IsOfficial As Boolean
- ''' <summary>
- ''' 获取到的数据。
- ''' </summary>
- Public Value As JObject
- End Structure
- ''' <summary>
- ''' Fabric 列表,主加载器。
- ''' </summary>
- Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
- Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
- Select Case Setup.Get("ToolDownloadVersion")
- Case 0
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
- New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60)
- }, Loader.IsForceRestarting)
- Case 1
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5),
- New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35)
- }, Loader.IsForceRestarting)
- Case Else
- DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
- New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60),
- New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60)
- }, Loader.IsForceRestarting)
- End Select
- End Sub
- ''' <summary>
- ''' Fabric 列表,官方源。
- ''' </summary>
- Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
- Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
- Dim Result As JObject = NetGetCodeByRequestRetry("https://meta.fabricmc.net/v2/versions", IsJson:=True)
- Try
- Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
- If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
- Loader.Output = Output
- Catch ex As Exception
- Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
- End Try
- End Sub
- ''' <summary>
- ''' Fabric 列表,BMCLAPI。
- ''' </summary>
- Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
- Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
- Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions",
- BackupUrl:="https://download.mcbbs.net/fabric-meta/v2/versions", IsJson:=True)
- Try
- Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
- If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
- Loader.Output = Output
- Catch ex As Exception
- Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
- End Try
- End Sub
- ''' <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))
- ''' <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 String = 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 String))
- For Each Entry In DlCfProjectDb.Values
- If If(Entry.ChineseName, "").Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
- SearchEntries.Add(New SearchEntry(Of String) With {
- .Item = Entry.ChineseName,
- .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 SearchResults.Count - 1
- If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
- SearchResult += SearchResults(i).Item.Replace(" - ", "§").Split("§").First.Replace(" (", "|").Split("|").Last.TrimEnd(")") & " "
- 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) Then Continue For
- If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
- RealFilter += Word & " "
- 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 Keyword = "forge" OrElse Keyword = "fabric" OrElse Keyword = "for" OrElse Keyword = "mod" 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)
- For Each Line In DecodeBytes(GetResources("ModData")).Split(vbLf)
- Dim Entry = New DlCfDbEntry
- Dim SplitedLine = Line.Split("|")
- Entry.CurseForgeId = SplitedLine(0)
- Entry.WikiId = SplitedLine(1)
- Entry.ChineseName = SplitedLine(2)
- Entry.MCBBS = If(SplitedLine.Count = 4, SplitedLine(3), 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
- DlCfProjectDb.Add(Entry.CurseForgeId, Entry)
- Next
- End Sub
- Public Class DlCfDbEntry
- ''' <summary>
- ''' McMod 的 ID。
- ''' </summary>
- Public WikiId As Integer
- ''' <summary>
- ''' 中文译名。若为 Nothing 或空字符串则使用英文名。
- ''' </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
- #End Region
- #Region "DlSource | 镜像下载源"
- Public Function DlSourceResourceGet(MojangBase As String) As String()
- Return {MojangBase.Replace("http://resources.download.minecraft.net", "https://download.mcbbs.net/assets"),
- MojangBase,
- MojangBase.Replace("http://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
- }
- End Function
- Public Function DlSourceLibraryGet(MojangBase As String) As String()
- Return {MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/maven"),
- MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/libraries"),
- MojangBase,
- MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
- MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
- }
- End Function
- Public Function DlSourceLauncherOrMetaGet(MojangBase As String, Optional IsStatic As Boolean = True) As String()
- If MojangBase Is Nothing Then Throw New Exception("无对应的 Json 下载地址")
- If IsStatic Then
- Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
- MojangBase,
- MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
- }
- Else
- Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
- MojangBase,
- MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
- }
- End If
- End Function
- Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
- LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)),
- Optional IsForceRestart As Boolean = False)
- Dim WaitCycle As Integer = 0
- Do While True
- '检查加载结束
- Dim IsAllFailed As Boolean = True
- For Each SubLoader In LoaderList
- If WaitCycle = 0 Then
- '如果要强制刷新,就不使用已经加载好的值
- If IsForceRestart Then Exit For
- '如果输入不一样,就不使用已经加载好的值
- If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse
- (SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For
- End If
- If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False
- If SubLoader.Key.State = LoadState.Finished Then
- MainLoader.Output = SubLoader.Key.Output
- DlSourceLoaderAbort(LoaderList)
- Exit Sub
- ElseIf IsAllFailed Then
- If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100
- End If
- '由于 Forge BMCLAPI 没有可用版本导致强制失败
- '在没有可用版本时,官方源会一直卡住,直接使用 BMCLAPI 判定失败即可
- If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then
- For Each SubLoader2 In LoaderList
- If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100
- Next
- End If
- Next
- '启动加载源
- If WaitCycle = 0 Then
- '启动第一个源
- LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart)
- '将其他源标记为未启动,以确保可以切换下载源(#184)
- For i = 1 To LoaderList.Count - 1
- LoaderList(i).Key.State = LoadState.Waiting
- Next
- End If
- For i = 0 To LoaderList.Count - 1
- If WaitCycle = LoaderList(i).Value * 100 Then
- If i < LoaderList.Count - 1 Then
- '启动下一个源
- LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
- Else
- '失败
- Dim ErrorInfo As Exception = Nothing
- For ii = 0 To LoaderList.Count - 1
- LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败
- If LoaderList(ii).Key.Error IsNot Nothing Then
- If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then
- ErrorInfo = LoaderList(ii).Key.Error
- End If
- End If
- Next
- If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
- DlSourceLoaderAbort(LoaderList)
- Throw ErrorInfo
- End If
- Exit For
- End If
- Next
- '计时
- If MainLoader.IsAborted Then
- DlSourceLoaderAbort(LoaderList)
- Exit Sub
- End If
- Thread.Sleep(10)
- WaitCycle += 1
- Loop
- End Sub
- Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
- For Each Loader In LoaderList
- If Loader.Key.State = LoadState.Loading Then Loader.Key.Abort()
- Next
- End Sub
- #End Region
- End Module
|