ModLaunch.vb 128 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368
  1. Public Module ModLaunch
  2. #Region "开始"
  3. Public CurrentLaunchOptions As McLaunchOptions = Nothing
  4. Public Class McLaunchOptions
  5. ''' <summary>
  6. ''' 强制指定在启动后进入的服务器 IP。
  7. ''' 默认值:Nothing。使用版本设置的值。
  8. ''' </summary>
  9. Public ServerIp As String = Nothing
  10. ''' <summary>
  11. ''' 将启动脚本保存到该地址,然后取消启动。这同时会改变启动时的提示等。
  12. ''' 默认值:Nothing。不保存。
  13. ''' </summary>
  14. Public SaveBatch As String = Nothing
  15. ''' <summary>
  16. ''' 强行指定启动的 MC 版本。
  17. ''' 默认值:Nothing。使用 McInstanceCurrent。
  18. ''' </summary>
  19. Public Instance As McInstance = Nothing
  20. ''' <summary>
  21. ''' 额外的启动参数。
  22. ''' </summary>
  23. Public ExtraGameArgs As New List(Of String)
  24. End Class
  25. ''' <summary>
  26. ''' 尝试启动 Minecraft。必须在 UI 线程调用。
  27. ''' 返回是否实际开始了启动(如果没有,则一定弹出了错误提示)。
  28. ''' </summary>
  29. Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
  30. CurrentLaunchOptions = If(Options, New McLaunchOptions)
  31. '预检查
  32. If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
  33. If McLaunchLoader.State = LoadState.Loading Then
  34. Hint("已有游戏正在启动中!", HintType.Red)
  35. Return False
  36. End If
  37. '强制切换需要启动的版本
  38. If CurrentLaunchOptions.Instance IsNot Nothing AndAlso McInstanceSelected <> CurrentLaunchOptions.Instance Then
  39. McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Instance.Name)
  40. '检查版本是否存在
  41. Try
  42. CurrentLaunchOptions.Instance.GetJsonPath()
  43. Catch
  44. Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}:当前 Minecraft 文件夹中尚未安装该版本!", HintType.Red)
  45. Return False
  46. End Try
  47. '检查版本
  48. CurrentLaunchOptions.Instance.Load()
  49. If CurrentLaunchOptions.Instance.State = McInstanceState.Error Then
  50. Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}:{CurrentLaunchOptions.Instance.Info}", HintType.Red)
  51. Return False
  52. End If
  53. '切换版本
  54. McInstanceSelected = CurrentLaunchOptions.Instance
  55. FrmLaunchLeft.RefreshButtonsUI()
  56. FrmLaunchLeft.RefreshPage(False, False)
  57. End If
  58. FrmMain.AprilGiveup()
  59. '禁止进入版本选择页面(否则就可以在启动中切换 McInstanceSelected 了)
  60. FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.InstanceSelect).ToList
  61. '实际启动加载器
  62. McLaunchLoader.Start(Options, IsForceRestart:=True)
  63. Return True
  64. End Function
  65. ''' <summary>
  66. ''' 记录启动日志。
  67. ''' </summary>
  68. Public Sub McLaunchLog(Text As String, Optional Level As LogLevel = LogLevel.Info)
  69. Text = FilterUserName(FilterAccessToken(Text, "*"), "*")
  70. If ModeDebug Then RunInUi(Sub() FrmLaunchRight.LabLog.Text += $"{vbCrLf}[{Date.Now:HH':'mm':'ss'.'fff}] {Text}")
  71. Logger.Log(Text, Level)
  72. End Sub
  73. '启动状态切换
  74. Public McLaunchLoader As New LoaderTask(Of McLaunchOptions, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState}
  75. Public McLaunchLoaderReal As LoaderCombo(Of Object)
  76. Public McLaunchProcess As Process
  77. Public McLaunchWatcher As Watcher
  78. Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
  79. Select Case McLaunchLoader.State
  80. Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Interrupted
  81. FrmLaunchLeft.PageChangeToLogin()
  82. Case LoadState.Loading
  83. '在预检测结束后再触发动画
  84. FrmLaunchRight.LabLog.Text = ""
  85. End Select
  86. End Sub
  87. ''' <summary>
  88. ''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
  89. ''' </summary>
  90. Private InterruptHint As String = Nothing
  91. '实际的启动方法
  92. Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
  93. '开始动画
  94. RunInUiWait(AddressOf FrmLaunchLeft.PageChangeToLaunching)
  95. '预检测(预检测的错误将直接抛出)
  96. Try
  97. McLaunchPrecheck()
  98. McLaunchLog("预检测已通过")
  99. Catch ex As Exception
  100. If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Red)
  101. Throw
  102. End Try
  103. Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
  104. '正式加载
  105. Try
  106. '构造主加载器
  107. Dim Loaders As New List(Of LoaderBase) From {
  108. New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
  109. McLoginLoader, '.ProgressWeight = 15, .Block = False
  110. New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
  111. New LoaderTask(Of String, Integer)("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
  112. New LoaderTask(Of Integer, Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
  113. New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
  114. New LoaderTask(Of Integer, Integer)("执行自定义命令", AddressOf McLaunchCustom) With {.ProgressWeight = 1},
  115. New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2},
  116. New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
  117. New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
  118. }
  119. '内存优化
  120. Select Case Settings.Get(Of Integer)("VersionRamOptimize", Instance:=McInstanceSelected)
  121. Case 0 '全局
  122. If Settings.Get(Of Boolean)("LaunchArgumentRam") Then '使用全局设置
  123. CType(Loaders(2), LoaderCombo(Of String)).Block = False
  124. Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
  125. End If
  126. Case 1 '开启
  127. CType(Loaders(2), LoaderCombo(Of String)).Block = False
  128. Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
  129. Case 2 '关闭
  130. End Select
  131. Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
  132. If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
  133. '等待加载器执行并更新 UI
  134. McLaunchLoaderReal = LaunchLoader
  135. InterruptHint = Nothing
  136. LaunchLoader.Start()
  137. '任务栏进度条
  138. LoaderTaskbarAdd(LaunchLoader)
  139. Do While LaunchLoader.State = LoadState.Loading
  140. FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
  141. Thread.Sleep(100)
  142. Loop
  143. FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
  144. '成功与失败处理
  145. Select Case LaunchLoader.State
  146. Case LoadState.Finished
  147. Hint(McInstanceSelected.Name & " 启动成功!", HintType.Green)
  148. '上报
  149. If Not IsSavingBatch Then
  150. Telemetry("Minecraft 启动成功",
  151. "Version", McInstanceSelected.VersionDisplayName,
  152. "LoginType", Settings.Get(Of McLoginType)("LoginType").ToString)
  153. End If
  154. Case LoadState.Interrupted
  155. If InterruptHint Is Nothing Then
  156. Hint(If(IsSavingBatch, "已取消导出启动脚本!", "已取消启动!"), HintType.Blue)
  157. Else
  158. Hint(InterruptHint, HintType.Green)
  159. End If
  160. Case LoadState.Failed
  161. Throw LaunchLoader.Error
  162. Case Else
  163. Throw New Exception("错误的状态改变:" & LaunchLoader.State.ToString())
  164. End Select
  165. Catch ex As Exception
  166. Dim CurrentEx = ex
  167. NextInner:
  168. If CurrentEx.Message.StartsWithF("$") Then
  169. '若有以 $ 开头的错误信息,则以此为准显示提示
  170. '若错误信息为 $$,则不提示
  171. If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
  172. Throw
  173. ElseIf CurrentEx.InnerException IsNot Nothing Then
  174. '检查下一级错误
  175. CurrentEx = CurrentEx.InnerException
  176. GoTo NextInner
  177. Else
  178. '没有特殊处理过的错误信息
  179. McLaunchLog("错误:" & ex.GetDisplay(True))
  180. Logger.Error(ex, If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogBehavior.Alert)
  181. '上报
  182. If Not IsSavingBatch Then
  183. Telemetry("Minecraft 启动失败",
  184. "Version", McInstanceSelected.VersionDisplayName,
  185. "LoginType", Settings.Get(Of McLoginType)("LoginType").ToString,
  186. "Exception", FilterUserName(FilterAccessToken(ex.GetDisplay(True), "*"), "*"))
  187. End If
  188. Throw
  189. End If
  190. End Try
  191. End Sub
  192. #End Region
  193. #Region "内存优化"
  194. Private Sub McLaunchMemoryOptimize(Loader As LoaderTask(Of Integer, Integer))
  195. McLaunchLog("内存优化开始")
  196. Dim Finished As Boolean = False
  197. RunInNewThread(
  198. Sub()
  199. PageOtherTest.MemoryOptimize(False)
  200. Finished = True
  201. End Sub, "Launch Memory Optimize")
  202. Do While Not Finished AndAlso Not Loader.IsInterrupted
  203. If Loader.Progress < 0.7 Then
  204. Loader.Progress += 0.007 '10s
  205. Else
  206. Loader.Progress += (0.95 - Loader.Progress) * 0.02 '最快 += 0.005
  207. End If
  208. Thread.Sleep(100)
  209. Loop
  210. End Sub
  211. #End Region
  212. #Region "预检测"
  213. Private Sub McLaunchPrecheck()
  214. If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
  215. '检查路径
  216. If McInstanceSelected.PathIndie.Contains("!") OrElse McInstanceSelected.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McInstanceSelected.PathIndie & ")")
  217. If McInstanceSelected.PathVersion.Contains("!") OrElse McInstanceSelected.PathVersion.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McInstanceSelected.PathVersion & ")")
  218. '检查版本
  219. If McInstanceSelected Is Nothing Then Throw New Exception("未选择 Minecraft 版本!")
  220. McInstanceSelected.Load()
  221. If McInstanceSelected.State = McInstanceState.Error Then Throw New Exception("Minecraft 存在问题:" & McInstanceSelected.Info)
  222. '检查输入信息
  223. Dim CheckResult As String = ""
  224. RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
  225. If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
  226. '求赞助
  227. If BuildType = BuildTypes.Release AndAlso CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
  228. RunInNewThread(
  229. Sub()
  230. Select Case Settings.Get(Of Integer)("SystemLaunchCount")
  231. Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
  232. If MyMsgBox("PCL 已经为你启动了 " & Settings.Get(Of Integer)("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
  233. "如果 PCL 还算好用的话,能不能考虑赞助一下 PCL……" & vbCrLf &
  234. "如果没有大家的支持,PCL 很难在免费、无任何广告的情况下维持数年的更新(磕头)……!",
  235. Settings.Get(Of Integer)("SystemLaunchCount") & " 次启动!", "支持 PCL!", "但是我拒绝") = 1 Then
  236. OpenWebsite("https://meloong.com/afd/a/LTCat")
  237. End If
  238. End Select
  239. End Sub, "Donate")
  240. End If
  241. '正版购买提示
  242. If CurrentLaunchOptions?.SaveBatch Is Nothing AndAlso '保存脚本时不提示
  243. Not Settings.Get(Of Boolean)("HintBuy") AndAlso Settings.Get(Of McLoginType)("LoginType") <> McLoginType.Ms Then
  244. If Globalization.CultureInfo.CurrentCulture.Name.StartsWithF("zh") OrElse Globalization.CultureInfo.CurrentUICulture.Name.StartsWithF("zh") Then '中文?
  245. RunInNewThread(
  246. Sub()
  247. Select Case Settings.Get(Of Integer)("SystemLaunchCount")
  248. Case 3, 8, 15, 30, 50, 70, 90, 110, 130, 180, 220, 280, 330, 380, 450, 550, 660, 750, 880, 950, 1100, 1300, 1500, 1700, 1900
  249. If MyMsgBox("你已经启动了 " & Settings.Get(Of Integer)("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
  250. "如果觉得 Minecraft 还不错,可以购买正版支持一下,毕竟开发游戏也真的很不容易……不要一直白嫖啦。" & vbCrLf & vbCrLf &
  251. "在登录一次正版账号后,就不会再出现这个提示了!",
  252. "考虑一下正版?", "支持正版游戏!", "下次一定") = 1 Then
  253. OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
  254. End If
  255. End Select
  256. End Sub, "Buy Minecraft")
  257. ElseIf Settings.Get(Of McLoginType)("LoginType") = McLoginType.Legacy Then
  258. Select Case MyMsgBox("你必须先登录正版账号,才能进行离线登录!", "正版验证", "购买正版", "试玩", "返回",
  259. Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
  260. Case 2
  261. Hint("游戏将以试玩模式启动!", HintType.Red)
  262. CurrentLaunchOptions.ExtraGameArgs.Add("--demo")
  263. Case 3
  264. Throw New Exception("$$")
  265. End Select
  266. End If
  267. End If
  268. End Sub
  269. #End Region
  270. #Region "主登录模块"
  271. '登录方式
  272. Public Enum McLoginType
  273. Legacy = 0
  274. Nide = 2
  275. Auth = 3
  276. Ms = 5
  277. End Enum
  278. '各个登录方式的对应数据
  279. Public MustInherit Class McLoginData
  280. ''' <summary>
  281. ''' 登录方式。
  282. ''' </summary>
  283. Public Type As McLoginType
  284. Public Overrides Function Equals(obj As Object) As Boolean
  285. Return obj IsNot Nothing AndAlso obj.GetHashCode() = GetHashCode()
  286. End Function
  287. End Class
  288. Public Class McLoginServer
  289. Inherits McLoginData
  290. ''' <summary>
  291. ''' 登录用户名。
  292. ''' </summary>
  293. Public UserName As String
  294. ''' <summary>
  295. ''' 登录密码。
  296. ''' </summary>
  297. Public Password As String
  298. ''' <summary>
  299. ''' 登录服务器基础地址。
  300. ''' </summary>
  301. Public BaseUrl As String
  302. ''' <summary>
  303. ''' 登录所使用的标识符,目前只可能为 “Auth” 或 “Nide”,用于存储缓存等。
  304. ''' </summary>
  305. Public Token As String
  306. ''' <summary>
  307. ''' 登录方式的描述字符串,如 “正版”、“统一通行证”。
  308. ''' </summary>
  309. Public Description As String
  310. ''' <summary>
  311. ''' 是否在本次登录中强制要求玩家重新选择角色,目前仅对 Authlib-Injector 生效。
  312. ''' </summary>
  313. Public ForceReselectProfile As Boolean = False
  314. Public Sub New(Type As McLoginType)
  315. Me.Type = Type
  316. End Sub
  317. Public Overrides Function GetHashCode() As Integer
  318. Return (UserName & Password & BaseUrl & Token & Type).GetStableHashCode() Mod Integer.MaxValue
  319. End Function
  320. End Class
  321. Public Class McLoginMs
  322. Inherits McLoginData
  323. ''' <summary>
  324. ''' 缓存的 OAuth Refresh Token。若没有则为空字符串。
  325. ''' </summary>
  326. Public OAuthRefreshToken As String = ""
  327. Public AccessToken As String = ""
  328. Public Uuid As String = ""
  329. Public UserName As String = ""
  330. Public ProfileJson As String = ""
  331. Public Sub New()
  332. Type = McLoginType.Ms
  333. End Sub
  334. Public Overrides Function GetHashCode() As Integer
  335. Return (OAuthRefreshToken & AccessToken & Uuid & UserName & ProfileJson).GetStableHashCode() Mod Integer.MaxValue
  336. End Function
  337. End Class
  338. Public Class McLoginLegacy
  339. Inherits McLoginData
  340. ''' <summary>
  341. ''' 登录用户名。
  342. ''' </summary>
  343. Public UserName As String
  344. ''' <summary>
  345. ''' 皮肤种类。
  346. ''' </summary>
  347. Public SkinType As Integer
  348. ''' <summary>
  349. ''' 若采用正版皮肤,则为该皮肤名。
  350. ''' </summary>
  351. Public SkinName As String
  352. Public Sub New()
  353. Type = McLoginType.Legacy
  354. End Sub
  355. Public Overrides Function GetHashCode() As Integer
  356. Return (UserName & SkinType & SkinName & Type).GetStableHashCode() Mod Integer.MaxValue
  357. End Function
  358. End Class
  359. '登录返回结果
  360. Public Structure McLoginResult
  361. Public Name As String
  362. Public Uuid As String
  363. Public AccessToken As String
  364. Public Type As String
  365. Public ClientToken As String
  366. ''' <summary>
  367. ''' 进行微软登录时返回的 profile 信息。
  368. ''' </summary>
  369. Public ProfileJson As String
  370. End Structure
  371. ''' <summary>
  372. ''' 根据登录信息获取玩家的 MC 用户名。如果无法获取则返回 Nothing。
  373. ''' </summary>
  374. Public Function McLoginName() As String
  375. '根据当前登录方式优先返回
  376. Select Case Settings.Get(Of McLoginType)("LoginType")
  377. Case McLoginType.Ms
  378. If Settings.Get(Of String)("CacheMsV2Name") <> "" Then Return Settings.Get(Of String)("CacheMsV2Name")
  379. Case McLoginType.Legacy
  380. If Settings.Get(Of String)("LoginLegacyName") <> "" Then Return Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨")
  381. Case McLoginType.Nide
  382. If Settings.Get(Of String)("CacheNideName") <> "" Then Return Settings.Get(Of String)("CacheNideName")
  383. Case McLoginType.Auth
  384. If Settings.Get(Of String)("CacheAuthName") <> "" Then Return Settings.Get(Of String)("CacheAuthName")
  385. End Select
  386. '查找所有可能的项
  387. If Settings.Get(Of String)("CacheMsV2Name") <> "" Then Return Settings.Get(Of String)("CacheMsV2Name")
  388. If Settings.Get(Of String)("CacheNideName") <> "" Then Return Settings.Get(Of String)("CacheNideName")
  389. If Settings.Get(Of String)("CacheAuthName") <> "" Then Return Settings.Get(Of String)("CacheAuthName")
  390. If Settings.Get(Of String)("LoginLegacyName") <> "" Then Return Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨")
  391. Return Nothing
  392. End Function
  393. ''' <summary>
  394. ''' 当前是否可以进行登录。若不可以则会返回错误原因。
  395. ''' </summary>
  396. Public Function McLoginAble() As String
  397. Select Case Settings.Get(Of McLoginType)("LoginType")
  398. Case McLoginType.Ms
  399. If Settings.Get(Of String)("CacheMsV2OAuthRefresh") = "" Then
  400. Return FrmLoginMs.IsVaild()
  401. Else
  402. Return ""
  403. End If
  404. Case McLoginType.Legacy
  405. Return FrmLoginLegacy.IsVaild()
  406. Case McLoginType.Nide
  407. If Settings.Get(Of String)("CacheNideAccess") = "" Then
  408. Return FrmLoginNide.IsVaild()
  409. Else
  410. Return ""
  411. End If
  412. Case McLoginType.Auth
  413. If Settings.Get(Of String)("CacheAuthAccess") = "" Then
  414. Return FrmLoginAuth.IsVaild()
  415. Else
  416. Return ""
  417. End If
  418. Case Else
  419. Return "未知的登录方式"
  420. End Select
  421. End Function
  422. ''' <summary>
  423. ''' 登录输入是否可以进行登录。若不可以则会返回错误原因。
  424. ''' </summary>
  425. Public Function McLoginAble(LoginData As McLoginData) As String
  426. Select Case LoginData.Type
  427. Case McLoginType.Ms
  428. Return PageLoginMs.IsVaild(LoginData)
  429. Case McLoginType.Legacy
  430. Return PageLoginLegacy.IsVaild(LoginData)
  431. Case McLoginType.Nide
  432. Return PageLoginNide.IsVaild(LoginData)
  433. Case McLoginType.Auth
  434. Return PageLoginAuth.IsVaild(LoginData)
  435. Case Else
  436. Return "未知的登录方式"
  437. End Select
  438. End Function
  439. '登录主模块加载器
  440. Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
  441. Public Function McLoginInput() As McLoginData
  442. Dim LoginData As McLoginData = Nothing
  443. Dim LoginType As McLoginType = Settings.Get(Of McLoginType)("LoginType")
  444. Try
  445. Select Case LoginType
  446. Case McLoginType.Legacy
  447. LoginData = PageLoginLegacy.GetLoginData()
  448. Case McLoginType.Ms
  449. If Settings.Get(Of String)("CacheMsV2OAuthRefresh") = "" Then
  450. LoginData = PageLoginMs.GetLoginData()
  451. Else
  452. LoginData = PageLoginMsSkin.GetLoginData()
  453. End If
  454. Case McLoginType.Nide
  455. If Settings.Get(Of String)("CacheNideAccess") = "" Then
  456. LoginData = PageLoginNide.GetLoginData()
  457. Else
  458. LoginData = PageLoginNideSkin.GetLoginData()
  459. End If
  460. Case McLoginType.Auth
  461. If Settings.Get(Of String)("CacheAuthAccess") = "" Then
  462. LoginData = PageLoginAuth.GetLoginData()
  463. Else
  464. LoginData = PageLoginAuthSkin.GetLoginData()
  465. End If
  466. End Select
  467. Catch ex As Exception
  468. Logger.Error(ex, $"获取登录输入信息失败({LoginType})")
  469. End Try
  470. Return LoginData
  471. End Function
  472. Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
  473. McLaunchLog("登录加载已开始")
  474. '校验登录信息
  475. Dim CheckResult As String = McLoginAble(Data.Input)
  476. If Not CheckResult = "" Then Throw New ArgumentException(CheckResult)
  477. '获取对应加载器
  478. Dim Loader As LoaderBase = Nothing
  479. Select Case Data.Input.Type
  480. Case McLoginType.Ms
  481. Loader = McLoginMsLoader
  482. Case McLoginType.Legacy
  483. Loader = McLoginLegacyLoader
  484. Case McLoginType.Nide
  485. Loader = McLoginNideLoader
  486. Case McLoginType.Auth
  487. Loader = McLoginAuthLoader
  488. End Select
  489. '尝试加载
  490. Loader.WaitForExit(Data.Input, McLoginLoader, Data.IsForceRestarting)
  491. Data.Output = CType(Loader, Object).Output
  492. RunInUi(Sub() FrmLaunchLeft.RefreshPage(True, False)) '刷新自动填充列表
  493. McLaunchLog("登录加载已结束")
  494. End Sub
  495. #End Region
  496. #Region "分方式登录模块"
  497. '各个登录方式的主对象与输入构造
  498. Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 1}
  499. Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
  500. Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
  501. Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
  502. '主加载函数,返回所有需要的登录信息
  503. Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
  504. Dim Input As McLoginMs = Data.Input
  505. Dim LogUsername As String = Input.UserName
  506. McLaunchLog("登录方式:正版(" & If(LogUsername = "", "尚未登录", LogUsername) & ")")
  507. Data.Progress = 0.05
  508. '检查是否已经登录完成
  509. Dim ExpiresAt = Settings.Get(Of Long)("CacheMsV2Expires")
  510. If Not Data.IsForceRestarting AndAlso '不要求强行重启
  511. ExpiresAt > 0 AndAlso ExpiresAt > GetUnixTimestampUtc() AndAlso 'AccessToken 尚未过期
  512. Input.UserName = Settings.Get(Of String)("CacheMsV2Name") Then
  513. Data.Output = New McLoginResult With {
  514. .Name = Input.UserName, .Type = "Microsoft",
  515. .AccessToken = Settings.Get(Of String)("CacheMsV2Access"),
  516. .Uuid = Settings.Get(Of String)("CacheMsV2Uuid"),
  517. .ClientToken = Settings.Get(Of String)("CacheMsV2Uuid"),
  518. .ProfileJson = Settings.Get(Of String)("CacheMsV2ProfileJson")
  519. }
  520. McLaunchLog("无需登录,AccessToken 尚未过期")
  521. GoTo SkipLogin
  522. End If
  523. '尝试登录
  524. Dim OAuthTokens As (OAuthAccessToken As String, OAuthRefreshToken As String)
  525. If Input.OAuthRefreshToken = "" Then
  526. '无 RefreshToken
  527. Relogin:
  528. OAuthTokens = MsLoginStep1New(Data)
  529. Else
  530. '有 RefreshToken
  531. OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
  532. If OAuthTokens.OAuthAccessToken = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
  533. End If
  534. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  535. Data.Progress = 0.25
  536. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  537. Dim OAuthAccessToken As String = OAuthTokens.OAuthAccessToken
  538. Dim OAuthRefreshToken As String = OAuthTokens.OAuthRefreshToken
  539. Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
  540. Data.Progress = 0.4
  541. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  542. Dim Tokens = MsLoginStep3(XBLToken)
  543. Data.Progress = 0.55
  544. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  545. Dim LoginResult = MsLoginStep4(Tokens)
  546. ExpiresAt = LoginResult.ExpiresAt
  547. Data.Progress = 0.7
  548. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  549. MsLoginStep5(LoginResult.AccessToken)
  550. Data.Progress = 0.85
  551. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  552. Dim Result = MsLoginStep6(LoginResult.AccessToken)
  553. Data.Progress = 0.98
  554. '输出登录结果
  555. Settings.Set("CacheMsV2OAuthRefresh", OAuthRefreshToken)
  556. Settings.Set("CacheMsV2Access", LoginResult.AccessToken)
  557. Settings.Set("CacheMsV2Uuid", Result.UUID)
  558. Settings.Set("CacheMsV2Name", Result.UserName)
  559. Settings.Set("CacheMsV2ProfileJson", Result.ProfileJson)
  560. Settings.Set("CacheMsV2Expires", LoginResult.ExpiresAt)
  561. Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
  562. MsJson.Remove(Input.UserName) '如果更改了玩家名……
  563. MsJson(Result.UserName) = OAuthRefreshToken
  564. Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
  565. Data.Output = New McLoginResult With {.AccessToken = LoginResult.AccessToken, .Name = Result.UserName, .Uuid = Result.UUID, .Type = "Microsoft", .ClientToken = Result.UUID, .ProfileJson = Result.ProfileJson}
  566. '结束
  567. SkipLogin:
  568. McLaunchLog($"微软登录结束,AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).Date.ToLocalTime} 过期")
  569. Settings.Set("HintBuy", True) '关闭正版购买提示
  570. If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
  571. End Sub
  572. Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
  573. Dim Input As McLoginServer = Data.Input
  574. Dim NeedRefresh As Boolean = False, WasRefreshed As Boolean = False
  575. McLaunchLog("登录方式:" & Input.Description)
  576. Data.Progress = 0.05
  577. '尝试登录
  578. If (Not Data.Input.ForceReselectProfile) AndAlso
  579. Settings.Get(Of String)("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso
  580. Settings.Get(Of String)("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso
  581. Settings.Get(Of String)("Cache" & Input.Token & "Access") <> "" AndAlso
  582. Settings.Get(Of String)("Cache" & Input.Token & "Client") <> "" AndAlso
  583. Settings.Get(Of String)("Cache" & Input.Token & "Uuid") <> "" AndAlso
  584. Settings.Get(Of String)("Cache" & Input.Token & "Name") <> "" Then
  585. '尝试验证登录
  586. Try
  587. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  588. McLoginRequestValidate(Data)
  589. GoTo LoginFinish
  590. Catch ex As Exception
  591. Logger.Warn(ex, "验证登录失败")
  592. If ex.IsBadNetwork Then Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后再试,或使用加速器、VPN 改善网络环境。")
  593. End Try
  594. Data.Progress = 0.25
  595. '尝试刷新登录
  596. Refresh:
  597. Try
  598. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  599. McLoginRequestRefresh(Data, NeedRefresh)
  600. GoTo LoginFinish
  601. Catch ex As Exception
  602. McLaunchLog("刷新登录失败:" & ex.GetDisplay(True))
  603. If WasRefreshed Then Throw New Exception("二轮刷新登录失败", ex)
  604. End Try
  605. Data.Progress = If(NeedRefresh, 0.85, 0.45)
  606. End If
  607. '尝试普通登录
  608. Try
  609. If Data.IsInterrupted Then Throw New ThreadInterruptedException
  610. NeedRefresh = McLoginRequestLogin(Data)
  611. Catch ex As Exception
  612. McLaunchLog("登录失败:" & ex.GetDisplay(True))
  613. Throw
  614. End Try
  615. If NeedRefresh Then
  616. McLaunchLog("重新进行刷新登录")
  617. WasRefreshed = True
  618. Data.Progress = 0.65
  619. GoTo Refresh
  620. End If
  621. LoginFinish:
  622. Data.Progress = 0.95
  623. '保存启动记录
  624. Dim Dict As New Dictionary(Of String, String)
  625. Dim Emails As New List(Of String)
  626. Dim Passwords As New List(Of String)
  627. Try
  628. If Not Settings.Get(Of String)("Login" & Input.Token & "Email") = "" Then Emails.AddRange(Settings.Get(Of String)("Login" & Input.Token & "Email").Split("¨"))
  629. If Not Settings.Get(Of String)("Login" & Input.Token & "Pass") = "" Then Passwords.AddRange(Settings.Get(Of String)("Login" & Input.Token & "Pass").Split("¨"))
  630. For i = 0 To Emails.Count - 1
  631. Dict.Add(Emails(i), Passwords(i))
  632. Next
  633. Dict.Remove(Input.UserName)
  634. Emails = New List(Of String)(Dict.Keys)
  635. Emails.Insert(0, Input.UserName)
  636. Passwords = New List(Of String)(Dict.Values)
  637. Passwords.Insert(0, Input.Password)
  638. Settings.Set("Login" & Input.Token & "Email", Emails.Join("¨"c))
  639. Settings.Set("Login" & Input.Token & "Pass", Passwords.Join("¨"c))
  640. Catch ex As Exception
  641. Logger.Error(ex, "保存启动记录失败", LogBehavior.Toast)
  642. Settings.Set("Login" & Input.Token & "Email", "")
  643. Settings.Set("Login" & Input.Token & "Pass", "")
  644. End Try
  645. End Sub
  646. Private Sub McLoginLegacyStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult))
  647. Dim Input As McLoginLegacy = Data.Input
  648. McLaunchLog("登录方式:离线(" & Input.UserName & ")")
  649. Data.Progress = 0.1
  650. With Data.Output
  651. .Name = Input.UserName
  652. .Uuid = McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName)
  653. .Type = "Legacy"
  654. End With
  655. '将结果扩展到所有项目中
  656. Data.Output.AccessToken = Data.Output.Uuid
  657. Data.Output.ClientToken = Data.Output.Uuid
  658. '保存启动记录
  659. Dim Names As New List(Of String)
  660. If Not Settings.Get(Of String)("LoginLegacyName") = "" Then Names.AddRange(Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨"))
  661. Names.Remove(Input.UserName)
  662. Names.Insert(0, Input.UserName)
  663. Settings.Set("LoginLegacyName", Names.Join("¨"c))
  664. End Sub
  665. 'Server 登录:三种验证方式的请求
  666. Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult))
  667. McLaunchLog("验证登录开始(Validate, " & Data.Input.Token & ")")
  668. '提前缓存信息,否则如果在登录请求过程中退出登录,设置项目会被清空,导致输出存在空值
  669. Dim AccessToken As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Access")
  670. Dim ClientToken As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Client")
  671. Dim Uuid As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Uuid")
  672. Dim Name As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Name")
  673. '发送登录请求
  674. Dim RequestData As New JObject(
  675. New JProperty("accessToken", AccessToken), New JProperty("clientToken", ClientToken), New JProperty("requestUser", True))
  676. NetRequestByClientRetry(
  677. Data.Input.BaseUrl & "/validate", HttpMethod.Post,
  678. Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
  679. Headers:={{"Accept-Language", "zh-CN"}},
  680. ContentType:="application/json; charset=utf-8") '没有返回值的
  681. '将登录结果输出
  682. Data.Output.AccessToken = AccessToken
  683. Data.Output.ClientToken = ClientToken
  684. Data.Output.Uuid = Uuid
  685. Data.Output.Name = Name
  686. Data.Output.Type = Data.Input.Token
  687. '不更改缓存,直接结束
  688. McLaunchLog("验证登录成功(Validate, " & Data.Input.Token & ")")
  689. End Sub
  690. Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
  691. McLaunchLog("刷新登录开始(Refresh, " & Data.Input.Token & ")")
  692. Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
  693. Data.Input.BaseUrl & "/refresh", HttpMethod.Post,
  694. Content:=New JObject(
  695. New JProperty("selectedProfile", New JObject(
  696. New JProperty("name", Settings.Get(Of String)($"Cache{Data.Input.Token}Name")),
  697. New JProperty("id", Settings.Get(Of String)($"Cache{Data.Input.Token}Uuid"))
  698. )),
  699. New JProperty("accessToken", Settings.Get(Of String)($"Cache{Data.Input.Token}Access")),
  700. New JProperty("requestUser", True)
  701. ).ToString(Newtonsoft.Json.Formatting.None),
  702. Headers:={{"Accept-Language", "zh-CN"}},
  703. ContentType:="application/json; charset=utf-8", RequireJson:=True))
  704. '将登录结果输出
  705. If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Settings.Get(Of String)("Cache" & Data.Input.Token & "Name") & " 无效!")
  706. Data.Output.AccessToken = LoginJson("accessToken").ToString
  707. Data.Output.ClientToken = LoginJson("clientToken").ToString
  708. Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString
  709. Data.Output.Name = LoginJson("selectedProfile")("name").ToString
  710. Data.Output.Type = Data.Input.Token
  711. '保存缓存
  712. Settings.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
  713. Settings.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
  714. Settings.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
  715. Settings.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
  716. Settings.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
  717. Settings.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
  718. McLaunchLog("刷新登录成功(Refresh, " & Data.Input.Token & ")")
  719. End Sub
  720. Private Function McLoginRequestLogin(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) As Boolean
  721. Try
  722. Dim NeedRefresh As Boolean = False
  723. McLaunchLog("登录开始(Login, " & Data.Input.Token & ")")
  724. Dim RequestData As New JObject(
  725. New JProperty("agent", New JObject(New JProperty("name", "Minecraft"), New JProperty("version", 1))),
  726. New JProperty("username", Data.Input.UserName),
  727. New JProperty("password", Data.Input.Password),
  728. New JProperty("requestUser", True))
  729. Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
  730. Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
  731. Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
  732. Headers:={{"Accept-Language", "zh-CN"}},
  733. ContentType:="application/json; charset=utf-8", RequireJson:=True))
  734. '检查登录结果
  735. If LoginJson("availableProfiles").Count = 0 Then
  736. If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Red)
  737. Throw New Exception("$你还没有创建角色,请在创建角色后再试!")
  738. ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").IsSingle Then
  739. Hint("你的账户中只有一个角色,无法更换!", HintType.Red)
  740. End If
  741. Dim SelectedName As String = Nothing
  742. Dim SelectedId As String = Nothing
  743. If (LoginJson("selectedProfile") Is Nothing OrElse Data.Input.ForceReselectProfile) AndAlso LoginJson("availableProfiles").Count > 1 Then
  744. '要求选择档案;优先从缓存读取
  745. NeedRefresh = True
  746. Dim CacheId As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Uuid")
  747. For Each Profile In LoginJson("availableProfiles")
  748. If Profile("id").ToString = CacheId Then
  749. SelectedName = Profile("name").ToString
  750. SelectedId = Profile("id").ToString
  751. McLaunchLog("根据缓存选择的角色:" & SelectedName)
  752. End If
  753. Next
  754. '缓存无效,要求玩家选择
  755. If SelectedName Is Nothing Then
  756. McLaunchLog("要求玩家选择角色")
  757. RunInUiWait(
  758. Sub()
  759. Dim SelectionControl As New List(Of IMyRadio)
  760. Dim SelectionJson As New List(Of JToken)
  761. For Each Profile In LoginJson("availableProfiles")
  762. SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString})
  763. SelectionJson.Add(Profile)
  764. Next
  765. Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色")
  766. SelectedName = SelectionJson(SelectedIndex)("name").ToString
  767. SelectedId = SelectionJson(SelectedIndex)("id").ToString
  768. End Sub)
  769. McLaunchLog("玩家选择的角色:" & SelectedName)
  770. End If
  771. Else
  772. SelectedName = LoginJson("selectedProfile")("name").ToString
  773. SelectedId = LoginJson("selectedProfile")("id").ToString
  774. End If
  775. '将登录结果输出
  776. Data.Output.AccessToken = LoginJson("accessToken").ToString
  777. Data.Output.ClientToken = LoginJson("clientToken").ToString
  778. Data.Output.Name = SelectedName
  779. Data.Output.Uuid = SelectedId
  780. Data.Output.Type = Data.Input.Token
  781. '保存缓存
  782. Settings.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
  783. Settings.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
  784. Settings.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
  785. Settings.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
  786. Settings.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
  787. Settings.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
  788. McLaunchLog("登录成功(Login, " & Data.Input.Token & ")")
  789. Return NeedRefresh
  790. Catch ex As Exception
  791. Dim AllMessage As String = ex.GetDisplay(False)
  792. Logger.Info(ex, "登录失败原始错误信息")
  793. '读取服务器返回的错误
  794. If TypeOf ex Is HttpRequestCodeException Then
  795. Dim ErrorMessage As String = Nothing
  796. Try
  797. Dim Response = DirectCast(ex, HttpRequestCodeException).Response
  798. If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
  799. Catch
  800. End Try
  801. If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
  802. If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsIgnoreCase("Incorrect username or password") Then
  803. '密码错误,退出登录 (#5090)
  804. McLaunchLog("密码错误,退出登录")
  805. Select Case Data.Input.Type
  806. Case McLoginType.Auth
  807. RunInUi(AddressOf PageLoginAuthSkin.ExitLogin)
  808. Case McLoginType.Nide
  809. RunInUi(AddressOf PageLoginNideSkin.ExitLogin)
  810. End Select
  811. End If
  812. Throw New Exception("$登录失败:" & ErrorMessage)
  813. End If
  814. End If
  815. '通用关键字检测
  816. If AllMessage.Contains("(403)") Then
  817. Select Case Data.Input.Type
  818. Case McLoginType.Auth
  819. Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
  820. " - 输入的账号或密码错误。" & vbCrLf &
  821. " - 登录尝试过于频繁,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
  822. " - 只注册了账号,但没有在皮肤站新建角色。")
  823. Case McLoginType.Nide
  824. Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
  825. " - 输入的账号或密码错误。" & vbCrLf &
  826. " - 密码错误次数过多,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
  827. If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号,而非游戏角色 ID。" & vbCrLf) &
  828. " - 只注册了账号,但没有加入对应服务器。")
  829. End Select
  830. ElseIf ex.IsBadNetwork() Then
  831. Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后再试,或使用加速器、VPN 改善网络环境。")
  832. ElseIf ex.Message.StartsWithF("$") Then
  833. Throw
  834. Else
  835. Throw New Exception("登录失败:" & ex.Message, ex)
  836. End If
  837. Return False
  838. End Try
  839. End Function
  840. '微软登录步骤 1,原始登录:获取 DeviceCode 并开启登录网页
  841. Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As (OAuthAccessToken As String, OAuthRefreshToken As String)
  842. '参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
  843. '初始请求
  844. Retry:
  845. McLaunchLog("开始微软登录步骤 1/6(原始登录)")
  846. Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
  847. Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
  848. ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
  849. McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
  850. '弹窗
  851. Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
  852. WaitingMyMsgBox.Add(Converter)
  853. While Converter.Result Is Nothing
  854. Thread.Sleep(100)
  855. End While
  856. If TypeOf Converter.Result Is RestartException Then
  857. If MyMsgBox($"请在登录时选择 {vbLQ}其他登录方法{vbRQ},然后选择 {vbLQ}使用我的密码{vbRQ}。{vbCrLf}如果没有该选项,请选择 {vbLQ}设置密码{vbRQ},设置完毕后再登录。",
  858. "需要使用密码登录", "重新登录", "设置密码", "取消",
  859. Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
  860. GoTo Retry
  861. Else
  862. Throw New Exception("$$")
  863. End If
  864. ElseIf TypeOf Converter.Result Is Exception Then
  865. Throw CType(Converter.Result, Exception)
  866. Else
  867. Return (Converter.Result(0), Converter.Result(1))
  868. End If
  869. End Function
  870. '微软登录步骤 1,刷新登录:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
  871. Private Function MsLoginStep1Refresh(Code As String) As (OAuthAccessToken As String, OAuthRefreshToken As String)
  872. McLaunchLog("开始微软登录步骤 1/6(刷新登录)")
  873. Dim Result As String
  874. Try
  875. Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post,
  876. Content:=$"client_id={OAuthClientId}&refresh_token={EscapeUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
  877. ContentType:="application/x-www-form-urlencoded",
  878. Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
  879. ThreadCount:=2)
  880. Catch ex As HttpRequestCodeException
  881. '修改错误列表时,同时检查 MyMsgLogin.xaml.vb 中的对应代码
  882. Dim Response = ex.Response
  883. If Response.ContainsIgnoreCase("must sign in again") OrElse Response.ContainsIgnoreCase("password expired") OrElse
  884. (Response.Contains("refresh_token") AndAlso Response.ContainsIgnoreCase("is not valid")) OrElse '#269
  885. Response.ContainsIgnoreCase("expired") Then '#8611
  886. Return ("Relogin", "")
  887. ElseIf Response.Contains("Account security interrupt") Then
  888. MyMsgBox("该账号由于安全问题无法登陆,请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
  889. Throw New Exception("$$")
  890. ElseIf Response.Contains("service abuse") Then
  891. MyMsgBox("非常抱歉,该账号已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
  892. Throw New Exception("$$")
  893. Else
  894. Throw
  895. End If
  896. End Try
  897. Dim ResultJson As JObject = GetJson(Result)
  898. Dim AccessToken As String = ResultJson("access_token").ToString
  899. Dim RefreshToken As String = ResultJson("refresh_token").ToString
  900. Return (AccessToken, RefreshToken)
  901. End Function
  902. '微软登录步骤 2:从 OAuth AccessToken 获取 XBLToken
  903. Private Function MsLoginStep2(AccessToken As String) As String
  904. McLaunchLog("开始微软登录步骤 2/6")
  905. Dim Request As String = "{
  906. ""Properties"": {
  907. ""AuthMethod"": ""RPS"",
  908. ""SiteName"": ""user.auth.xboxlive.com"",
  909. ""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """
  910. },
  911. ""RelyingParty"": ""http://auth.xboxlive.com"",
  912. ""TokenType"": ""JWT""
  913. }"
  914. Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
  915. Content:=Request, ContentType:="application/json", RequireJson:=True)
  916. Return GetJson(Result)("Token").ToString
  917. End Function
  918. '微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS}
  919. Private Function MsLoginStep3(XBLToken As String) As (XSTSToken As String, UHS As String)
  920. McLaunchLog("开始微软登录步骤 3/6")
  921. Dim Request As String = "{
  922. ""Properties"": {
  923. ""SandboxId"": ""RETAIL"",
  924. ""UserTokens"": [""" & XBLToken & """]
  925. },
  926. ""RelyingParty"": ""rp://api.minecraftservices.com/"",
  927. ""TokenType"": ""JWT""
  928. }"
  929. Dim Result As String
  930. Try
  931. Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post,
  932. Content:=Request, ContentType:="application/json", RequireJson:=True)
  933. Catch ex As HttpRequestCodeException
  934. '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
  935. If ex.Response.Contains("2148916227") Then
  936. MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
  937. Throw New Exception("$$")
  938. ElseIf ex.Response.Contains("2148916233") Then
  939. If MyMsgBox("你尚未注册 Xbox 账户,请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
  940. OpenWebsite("https://signup.live.com/signup")
  941. End If
  942. Throw New Exception("$$")
  943. ElseIf ex.Response.Contains("2148916235") Then
  944. MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN,然后再试。", "登录失败", "我知道了")
  945. Throw New Exception("$$")
  946. ElseIf ex.Response.Contains("2148916238") Then
  947. If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
  948. "该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
  949. OpenWebsite("https://account.live.com/editprof.aspx")
  950. MyMsgBox("请在打开的网页中修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
  951. "在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示")
  952. Else
  953. OpenWebsite("https://support.microsoft.com/zh-cn/account-billing/如何更改-microsoft-帐户上的出生日期-837badbc-999e-54d2-2617-d19206b9540a")
  954. MyMsgBox("请根据打开的网页的说明,修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
  955. "在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示")
  956. End If
  957. Throw New Exception("$$")
  958. Else
  959. Throw
  960. End If
  961. End Try
  962. Dim ResultJson As JObject = GetJson(Result)
  963. Return (
  964. ResultJson("Token").ToString(), 'XSTSToken
  965. ResultJson("DisplayClaims")("xui")(0)("uhs").ToString() 'UHS
  966. )
  967. End Function
  968. '微软登录步骤 4:从 {XSTSToken, UHS} 获取 {Minecraft AccessToken, 过期于 (Unix 时间戳)}
  969. Private Function MsLoginStep4(Tokens As (XSTSToken As String, UHS As String)) As (AccessToken As String, ExpiresAt As Integer)
  970. McLaunchLog("开始微软登录步骤 4/6")
  971. Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens.UHS};{Tokens.XSTSToken}")).ToString(0)
  972. Dim Result As String
  973. Try
  974. Result = NetRequestByClientRetry("https://api.minecraftservices.com/authentication/login_with_xbox", HttpMethod.Post,
  975. Content:=Request, ContentType:="application/json", RequireJson:=True)
  976. Catch ex As HttpRequestCodeException
  977. If ex.StatusCode = 429 Then
  978. Logger.Warn(ex, "微软登录第 4 步汇报 429")
  979. Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
  980. ElseIf ex.StatusCode = HttpStatusCode.Forbidden Then
  981. Logger.Warn(ex, "微软登录第 4 步汇报 403")
  982. Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器,请把它们关掉或更换节点后再试!")
  983. ElseIf ex.Response?.Contains("ACCOUNT_SUSPENDED") Then '#8655
  984. MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
  985. Throw New Exception("$$")
  986. Else
  987. Throw
  988. End If
  989. End Try
  990. Dim ResultJson As JObject = GetJson(Result)
  991. Return (
  992. ResultJson("access_token").ToString,
  993. ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 1200) '提前 20 分钟视作过期
  994. End Function
  995. '微软登录步骤 5:验证微软账号是否持有 MC,这也会刷新 XGP
  996. Private Sub MsLoginStep5(AccessToken As String)
  997. McLaunchLog("开始微软登录步骤 5/6")
  998. Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
  999. ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
  1000. Try
  1001. Dim ResultJson As JObject = GetJson(Result)
  1002. If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
  1003. Select Case MyMsgBox("你尚未购买正版 Minecraft,或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
  1004. Case 1
  1005. OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
  1006. End Select
  1007. Throw New Exception("$$")
  1008. End If
  1009. Catch ex As Exception
  1010. Logger.Warn(ex, $"微软登录第 5 步异常:{Result}")
  1011. Throw
  1012. End Try
  1013. End Sub
  1014. '微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
  1015. Private Function MsLoginStep6(AccessToken As String) As (UUID As String, UserName As String, ProfileJson As String)
  1016. McLaunchLog("开始微软登录步骤 6/6")
  1017. Dim Result As String
  1018. Try
  1019. Result = NetRequestByClientMultiple("https://api.minecraftservices.com/minecraft/profile",
  1020. ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
  1021. Catch ex As HttpRequestCodeException
  1022. Select Case ex.StatusCode
  1023. Case 429
  1024. Logger.Warn(ex, "微软登录第 6 步汇报 429")
  1025. Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
  1026. Case HttpStatusCode.NotFound
  1027. Logger.Warn(ex, "微软登录第 6 步汇报 404")
  1028. RunInNewThread(
  1029. Sub()
  1030. Select Case MyMsgBox("请先创建 Minecraft 玩家档案,然后再重新登录。", "登录失败", "创建档案", "取消")
  1031. Case 1
  1032. OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
  1033. End Select
  1034. End Sub, "Login Failed: Create Profile")
  1035. Throw New Exception("$$")
  1036. Case Else
  1037. Throw
  1038. End Select
  1039. End Try
  1040. Dim ResultJson As JObject = GetJson(Result)
  1041. Dim UUID As String = ResultJson("id").ToString
  1042. Dim UserName As String = ResultJson("name").ToString
  1043. Return (UUID, UserName, Result)
  1044. End Function
  1045. '返回符合离线皮肤设置的 UUID
  1046. Private Function McLoginLegacyUuidWithCustomSkin(UserName As String, SkinType As Integer, SkinName As String) As String
  1047. Dim Uuid As String = McLoginLegacyUuid(UserName)
  1048. '根据离线皮肤获取实际使用的 Uuid
  1049. Select Case SkinType
  1050. Case 0
  1051. '默认,不需要处理
  1052. Case 1
  1053. 'Steve
  1054. Do Until McSkinSex(Uuid) = "Steve"
  1055. If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
  1056. Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
  1057. Loop
  1058. Case 2
  1059. 'Alex
  1060. Do Until McSkinSex(Uuid) = "Alex"
  1061. If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
  1062. Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
  1063. Loop
  1064. Case 3
  1065. '使用正版用户名
  1066. Try
  1067. If SkinName <> "" AndAlso
  1068. McInstanceSelected IsNot Nothing AndAlso McInstanceSelected.Version.Vanilla.Major < 20 Then '1.20+ 或快照版不能使用该项(#3746)
  1069. Logger.Info($"由于离线皮肤设置,使用正版 UUID:{SkinName}")
  1070. Uuid = McLoginMojangUuid(SkinName, False)
  1071. End If
  1072. Catch ex As Exception
  1073. Logger.Error(ex, "皮肤信息获取失败,游戏将以无皮肤的方式启动", LogBehavior.Toast)
  1074. End Try
  1075. Case 4
  1076. '自定义
  1077. Do Until McSkinSex(Uuid) = If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "Alex", "Steve")
  1078. If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
  1079. Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
  1080. Loop
  1081. End Select
  1082. Return Uuid
  1083. End Function
  1084. '根据用户名返回对应 UUID,需要多线程
  1085. Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean)
  1086. If Name.Trim.Length = 0 Then Return New String("0"c, 32)
  1087. '从缓存获取
  1088. Dim Uuid As String = ReadIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, "")
  1089. If Len(Uuid) = 32 Then Return Uuid
  1090. '从官网获取
  1091. Try
  1092. Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True))
  1093. If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在(" & Name & ")")
  1094. Uuid = If(GotJson("id"), "")
  1095. Catch ex As Exception
  1096. Logger.Warn(ex, $"从官网获取正版 Uuid 失败({Name})")
  1097. If Not ThrowOnNotFound AndAlso ex.GetType.Name = "FileNotFoundException" Then
  1098. Uuid = McLoginLegacyUuid(Name) '玩家档案不存在
  1099. Else
  1100. Throw New Exception("从官网获取正版 Uuid 失败", ex)
  1101. End If
  1102. End Try
  1103. '写入缓存
  1104. If Not Len(Uuid) = 32 Then Throw New Exception("获取的正版 Uuid 长度不足(" & Uuid & ")")
  1105. WriteIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, Uuid)
  1106. Return Uuid
  1107. End Function
  1108. Public Function McLoginLegacyUuid(Name As String)
  1109. Dim FullUuid As String = Name.Length.ToString("X").EnsureLength("0", 16) & Name.GetStableHashCode().ToString("X").EnsureLength("0", 16)
  1110. Return FullUuid.Substring(0, 12) & "3" & FullUuid.Substring(13, 3) & "9" & FullUuid.Substring(17, 15)
  1111. End Function
  1112. #End Region
  1113. #Region "Java 处理"
  1114. Public McLaunchJavaSelected As JavaEntry = Nothing
  1115. Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer))
  1116. Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
  1117. '原版 26-:通过版本号判断
  1118. If (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2024, 4, 2)) OrElse
  1119. (McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 5)) Then
  1120. '1.20.5+(24w14a+):至少 Java 21
  1121. MinVer = New Version(1, 21, 0, 0)
  1122. ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 11, 16)) OrElse
  1123. (McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 18) Then
  1124. '1.18 pre2+:至少 Java 17
  1125. MinVer = New Version(1, 17, 0, 0)
  1126. ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 5, 11)) OrElse
  1127. (McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 17) Then
  1128. '1.17+ (21w19a+):至少 Java 16
  1129. MinVer = New Version(1, 16, 0, 0)
  1130. ElseIf McInstanceSelected.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了
  1131. '1.12+:至少 Java 8
  1132. MinVer = New Version(1, 8, 0, 0)
  1133. ElseIf McInstanceSelected.ReleaseTime <= New Date(2013, 5, 1) AndAlso McInstanceSelected.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
  1134. '1.5.2-:最高 Java 8
  1135. MaxVer = New Version(1, 8, 999, 999)
  1136. End If
  1137. '原版 26+:获取 Mojang 要求的 Java 版本
  1138. Dim RecommendedComponent As String = Nothing
  1139. Dim RecommendedCode As Integer =
  1140. If(McInstanceSelected.JsonObject?("javaVersion")?("majorVersion")?.ToObject(Of Integer),
  1141. If(McInstanceSelected.JsonVersion?("java_version")?.ToObject(Of Integer), 0))
  1142. If RecommendedCode >= 22 Then
  1143. McLaunchLog("Mojang 要求至少使用 Java " & RecommendedCode)
  1144. MinVer = New Version(1, RecommendedCode, 0, 0)
  1145. RecommendedComponent =
  1146. If(McInstanceSelected.JsonObject?("javaVersion")?("component")?.ToString,
  1147. McInstanceSelected.JsonVersion?("java_component")?.ToString)
  1148. If RecommendedComponent = "" Then RecommendedComponent = Nothing
  1149. End If
  1150. 'OptiFine 检测
  1151. If McInstanceSelected.Version.HasOptiFine AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
  1152. If McInstanceSelected.Version.Vanilla.Major < 7 Then
  1153. '<1.7:至多 Java 8
  1154. MaxVer = New Version(1, 8, 999, 999)
  1155. ElseIf McInstanceSelected.Version.Vanilla.Major >= 8 AndAlso McInstanceSelected.Version.Vanilla.Major < 12 Then
  1156. '1.8 - 1.11:必须恰好 Java 8
  1157. MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
  1158. ElseIf McInstanceSelected.Version.Vanilla.Major = 12 Then
  1159. '1.12:最高 Java 8
  1160. MaxVer = New Version(1, 8, 999, 999)
  1161. End If
  1162. End If
  1163. 'Forge 检测(部分测试结果见 #8432)
  1164. If McInstanceSelected.Version.HasForge Then
  1165. If McInstanceSelected.Version.Vanilla >= New Version(6, 0, 1) AndAlso McInstanceSelected.Version.Vanilla <= New Version(7, 0, 2) Then
  1166. '1.6.1 - 1.7.2:必须 Java 7
  1167. MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
  1168. MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
  1169. ElseIf McInstanceSelected.Version.Vanilla.Major <= 12 OrElse Not McInstanceSelected.Version.Vaild Then '非标准版本
  1170. '<=1.12:Java 8
  1171. MaxVer = New Version(1, 8, 999, 999)
  1172. ElseIf McInstanceSelected.Version.Vanilla.Major <= 14 Then
  1173. '1.13 - 1.14:Java 8 - 10
  1174. MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
  1175. MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
  1176. ElseIf McInstanceSelected.Version.Vanilla.Major = 15 Then
  1177. '1.15:Java 8 - 15
  1178. MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
  1179. MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer)
  1180. ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", McInstanceSelected.Version.Forge) Then
  1181. '1.16.3~5,Forge 34.0.0 ~ 36.2.25:最高 Java 8u320
  1182. MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
  1183. ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "36.2.26") AndAlso CompareVersionGE("36.999.999", McInstanceSelected.Version.Forge) Then
  1184. '1.16.5,Forge 36.2.26+,<37.0.0:最高 Java 23
  1185. MaxVer = If(New Version(1, 23, 999, 999) < MaxVer, New Version(1, 23, 999, 999), MaxVer)
  1186. ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "37.0.0") AndAlso CompareVersionGE("37.0.79", McInstanceSelected.Version.Forge) Then
  1187. '1.17.1,Forge 37.0.0 ~ 37.0.79:最高 Java 16
  1188. MaxVer = If(New Version(1, 16, 999, 999) < MaxVer, New Version(1, 16, 999, 999), MaxVer)
  1189. ElseIf McInstanceSelected.Version.Vanilla.Major = 18 AndAlso McInstanceSelected.Version.HasOptiFine Then '#305
  1190. '1.18:若安装了 OptiFine,最高 Java 18
  1191. MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
  1192. ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.21") AndAlso CompareVersionGE("45.0.65", McInstanceSelected.Version.Forge) Then
  1193. '1.19.4,Forge 45.0.21 ~ 45.0.65:最高 Java 19
  1194. MaxVer = If(New Version(1, 19, 999, 999) < MaxVer, New Version(1, 19, 999, 999), MaxVer)
  1195. ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.66") AndAlso CompareVersionGE("47.4.8", McInstanceSelected.Version.Forge) Then
  1196. '1.19.4~1.20.1,Forge 45.0.66 ~ 47.4.8:最高 Java 21
  1197. MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
  1198. End If
  1199. End If
  1200. 'NeoForge 检测
  1201. If McInstanceSelected.Version.HasNeoForge Then
  1202. If McInstanceSelected.Version.Vanilla = New Version(20, 0, 1) OrElse
  1203. (CompareVersionGE("20.2.62-beta", McInstanceSelected.Version.NeoForge) AndAlso Not McInstanceSelected.Version.NeoForge.Contains("25w14craftmine")) Then
  1204. '1.20.1,以及 1.20.2 的 20.2.62-beta 之前:最高 Java 21
  1205. MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
  1206. End If
  1207. End If
  1208. 'Fabric 检测
  1209. If McInstanceSelected.Version.HasFabric AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
  1210. If McInstanceSelected.Version.Vanilla.Major >= 15 AndAlso McInstanceSelected.Version.Vanilla.Major <= 16 Then
  1211. '1.15 - 1.16:Java 8+
  1212. MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
  1213. ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 Then
  1214. '1.18+:Java 17+
  1215. MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
  1216. End If
  1217. End If
  1218. 'LiteLoader 检测
  1219. If McInstanceSelected.Version.HasLiteLoader AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
  1220. '最高 Java 8
  1221. MaxVer = If(New Version(1, 8, 999, 999) < MaxVer, New Version(1, 8, 999, 999), MaxVer)
  1222. End If
  1223. '统一通行证检测
  1224. If Settings.Get(Of McLoginType)("LoginType") = McLoginType.Nide Then
  1225. '至少 Java 8u101
  1226. MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
  1227. End If
  1228. SyncLock JavaLock
  1229. '选择 Java
  1230. McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
  1231. McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
  1232. If Task.IsInterrupted Then Return
  1233. If McLaunchJavaSelected IsNot Nothing Then
  1234. McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
  1235. Return
  1236. End If
  1237. '无合适的 Java
  1238. If Task.IsInterrupted Then Return '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
  1239. McLaunchLog("无合适的 Java,准备自动下载")
  1240. Dim JavaCode As String
  1241. If MinVer >= New Version(1, 9) Then
  1242. JavaCode = MinVer.Minor
  1243. ElseIf MaxVer < New Version(1, 8) Then
  1244. MyMsgBox($"你需要安装 Java 7 才能启动该版本。{vbCrLf}请自行搜索并安装 Java 7,安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
  1245. Throw New Exception("$$")
  1246. ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
  1247. MyMsgBox($"你需要安装 Java 8u141 ~ 8u320 才能启动该版本。{vbCrLf}请自行搜索并安装,安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
  1248. Throw New Exception("$$")
  1249. ElseIf MinVer > New Version(1, 8, 0, 140) Then
  1250. MyMsgBox($"你需要安装 Java 8u141 或更高版本的 Java 8 才能启动该版本。{vbCrLf}请自行搜索并安装,安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
  1251. Throw New Exception("$$")
  1252. Else
  1253. JavaCode = 8
  1254. End If
  1255. '开始自动下载
  1256. Dim JavaLoader = GetJavaDownloadLoader()
  1257. Try
  1258. JavaLoader.Start(If(RecommendedComponent, JavaCode), IsForceRestart:=True) '在 Java 22+ 时优先使用 Mojang 提供的 Component 字段
  1259. Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
  1260. Task.Progress = JavaLoader.Progress
  1261. Thread.Sleep(10)
  1262. Loop
  1263. Finally
  1264. JavaLoader.Interrupt() '确保取消时中止 Java 下载
  1265. End Try
  1266. '检查下载结果
  1267. If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
  1268. McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
  1269. If Task.IsInterrupted Then Return
  1270. If McLaunchJavaSelected IsNot Nothing Then
  1271. McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
  1272. Else
  1273. Hint("没有可用的 Java,已取消启动!", HintType.Red)
  1274. Throw New Exception("$$")
  1275. End If
  1276. End SyncLock
  1277. End Sub
  1278. #End Region
  1279. #Region "启动参数"
  1280. Private McLaunchArgument As String
  1281. '主方法
  1282. Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, Integer))
  1283. '获取基础参数
  1284. Dim Arguments As New List(Of String)
  1285. McLaunchLog("参数获取开始")
  1286. Arguments.AddRange(McLaunchArgumentsJVM()) 'JVM 参数
  1287. Arguments.Add(McInstanceSelected.JsonObject("mainClass")) 'mainClass
  1288. Arguments.AddRange(McLaunchArgumentsGame()) '游戏参数
  1289. '替换
  1290. McLaunchLog("=================== 启动参数开始 ===================")
  1291. Dim Replacements = McLaunchArgumentsReplace(Arguments).ToList
  1292. Dim Argument As String = ""
  1293. For Each Arg In Arguments
  1294. '应用替换标记
  1295. For Each Replacement In Replacements
  1296. Arg = Arg.Replace(Replacement.Key, Replacement.Value)
  1297. Next
  1298. '为带特殊字符的参数添加双引号
  1299. If Arg.IndexOfAny({"&"c, "|"c, "<"c, ">"c, "^"c, " "c}) >= 0 AndAlso Not Arg.StartsWithF("""") AndAlso Not Arg.EndsWithF("""") Then
  1300. Arg = $"""{Arg.Replace("""", "\""")}""" '转义在原本参数中间的双引号
  1301. End If
  1302. '输出
  1303. McLaunchLog(Arg)
  1304. Argument &= Arg & " "
  1305. Next
  1306. McLaunchLog("=================== 启动参数结束 ===================")
  1307. '输出
  1308. McLaunchArgument = Argument.TrimEnd
  1309. End Sub
  1310. 'JVM 部分
  1311. Private Function McLaunchArgumentsJVM() As List(Of String)
  1312. Dim Args As New List(Of String)
  1313. 'Minecraft 参数
  1314. If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("jvm") IsNot Nothing Then
  1315. '新版 MC:从版本 JSON 获取参数
  1316. Dim CurrentInstance As McInstance = McInstanceSelected
  1317. NextInstance:
  1318. McLaunchLog($"新版 JVM 参数:从版本 JSON 获取({CurrentInstance.Name})")
  1319. If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("jvm") IsNot Nothing Then
  1320. For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("jvm")
  1321. Select Case SubJson.Type
  1322. Case JTokenType.String
  1323. Args.Add(SubJson.ToString.Trim)
  1324. Case JTokenType.Object
  1325. Dim Argument As JObject = CType(SubJson, JObject)
  1326. If Argument.ContainsKey("rules") AndAlso Not McJsonRuleCheck(Argument("rules")) Then Continue For '不满足准则
  1327. If Not Argument.ContainsKey("value") Then Continue For '没有 value 字段
  1328. If Argument("value").Type = JTokenType.String Then
  1329. Args.Add(Argument("value").ToString.Trim)
  1330. Else
  1331. For Each value As JToken In Argument("value")
  1332. Args.Add(value.ToString.Trim)
  1333. Next
  1334. End If
  1335. End Select
  1336. Next
  1337. End If
  1338. If CurrentInstance.InheritName <> "" Then
  1339. CurrentInstance = New McInstance(CurrentInstance.InheritName)
  1340. GoTo NextInstance
  1341. End If
  1342. '1.17.1 中有个 "-Dos.name=Windows 10",不立即加双引号会导致 10 被隔开
  1343. Args = Args.Select(Function(a) If(a.Contains(" ") AndAlso Not a.StartsWithF("""") AndAlso Not a.EndsWithF(""""), $"""{a.Replace("""", "\""")}""", a)).ToList
  1344. Else
  1345. '旧版 MC:直接添加参数
  1346. McLaunchLog($"旧版 JVM 参数")
  1347. Args.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump")
  1348. Args.Add("-Djava.library.path=${natives_directory}")
  1349. Args.Add("-cp") : Args.Add("${classpath}")
  1350. End If
  1351. '设置里自定义的参数
  1352. Dim CustomArg As String = Settings.Get(Of String)("VersionAdvanceJvm", Instance:=McInstanceSelected)
  1353. If CustomArg = "" Then CustomArg = Settings.Get(Of String)("LaunchAdvanceJvm")
  1354. If CustomArg <> "" Then CustomArg = ArgumentReplace(CustomArg)
  1355. '重新分割字符串并去重
  1356. Args = DeduplicateJavaArguments(SplitJavaArguments(Args.Join(" "c).Replace("McEmu= ", "McEmu=") & " " & CustomArg).ToList, True)
  1357. '统一通行证
  1358. If McLoginLoader.Output.Type = "Nide" Then
  1359. Args.Add("-javaagent:""${pure_directory}\nide8auth.jar""=""" & Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected) & """")
  1360. End If
  1361. 'Authlib-Injector
  1362. If McLoginLoader.Output.Type = "Auth" Then
  1363. If McLaunchJavaSelected.MajorVersion >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#)
  1364. Dim Server As String = Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)
  1365. Try
  1366. McLaunchLog($"开始 Authlib Injector Prefetch")
  1367. Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
  1368. Args.Add("-javaagent:""${pure_directory}\authlib-injector.jar""=""" & Server & """")
  1369. Args.Add("-Dauthlibinjector.side=client")
  1370. Args.Add("-Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
  1371. Catch ex As Exception
  1372. Throw New Exception("无法连接到第三方登录服务器(" & If(Server, Nothing) & ")", ex)
  1373. End Try
  1374. End If
  1375. 'JLW
  1376. '非 GBK 编码下命令行参数乱码的问题(JDK-8272352)
  1377. Dim UseJLW As Boolean =
  1378. Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableJLW", McInstanceSelected) AndAlso
  1379. Not IsGBKEncoding AndAlso Not McFolderSelected.IsAsciiOnly() '仅在该环境下才会触发该 Bug
  1380. If UseJLW AndAlso CustomArg.Contains("-javaagent") Then
  1381. UseJLW = False
  1382. McLaunchLog("由于使用了自定义 javaagent,已禁用 JLW,这可能导致游戏崩溃!", LogLevel.Warn)
  1383. End If
  1384. If UseJLW Then
  1385. If McLaunchJavaSelected.MajorVersion >= 9 Then
  1386. Args.Add("--add-exports") : Args.Add("cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
  1387. End If
  1388. Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾
  1389. End If
  1390. McLaunchLog("使用 JLW:" & UseJLW)
  1391. 'LUA
  1392. Dim UseLUA As Boolean =
  1393. Not Settings.Get(Of Boolean)("LaunchAdvanceDisableLUA") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableLUA", McInstanceSelected) AndAlso
  1394. McLibListGet(McInstanceSelected, False).Any(Function(e) e.OriginalName = "org.lwjgl:lwjgl:3.4.1")
  1395. If UseLUA Then Args.Add($"-javaagent:""{ExtractPatch("LUA")}""")
  1396. McLaunchLog("使用 LUA:" & UseLUA)
  1397. #Region "内存管理"
  1398. McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
  1399. Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024)
  1400. Args.Add("-Xmx" & TargetRam & "m")
  1401. '获取设置的管理方式
  1402. '0:在 Java 21+ 使用分代 ZGC,20~15 使用非分代的 ZGC,14- 使用 G1GC
  1403. '1:在 Java 21+ 使用分代 ZGC,20- 使用 G1GC
  1404. '2:仅 G1GC
  1405. '3:不指定,玩家自定义
  1406. Dim SetupType As Integer = Settings.Get(Of Integer)("LaunchAdvanceGC")
  1407. If McInstanceSelected IsNot Nothing AndAlso Settings.Get(Of Integer)("VersionAdvanceGC", McInstanceSelected) > 0 Then SetupType = Settings.Get(Of Integer)("VersionAdvanceGC", McInstanceSelected) - 1 '去掉默认
  1408. If SetupType <> 3 Then
  1409. '确定是使用 G1GC 还是 ZGC
  1410. Dim UseG1GC As Boolean = False
  1411. If (SetupType = 0 AndAlso McLaunchJavaSelected.MajorVersion < 15) OrElse
  1412. (SetupType = 1 AndAlso McLaunchJavaSelected.MajorVersion < 21) OrElse
  1413. (SetupType = 2 OrElse SetupType = 4) Then UseG1GC = True '检查 Java 版本,ZGC 在 Java 15+ 可用,分代 ZGC 在 Java 21+ 可用
  1414. If Is32BitSystem OrElse Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性,ZGC 需要 Windows 10 1809+
  1415. McLaunchLog($"GC 设置:{SetupType},选取 {If(UseG1GC, "G1GC", "ZGC")},Java 版本:{McLaunchJavaSelected.MajorVersion}")
  1416. '移除已有的 GC 参数
  1417. Args = Args.Where(Function(a) Not a.RegexCheck(
  1418. "( )*-XX:[+-]?(Use\w+GC|ZGenerational|UseCompactObjectHeaders|G1\w+Percent|G1\w+Size|(Max|Min)(GCPauseMillis|HeapFreeRatio))")).ToList
  1419. '添加 GC 参数
  1420. Args.Add("-XX:+UnlockExperimentalVMOptions")
  1421. If McLaunchJavaSelected.MajorVersion >= 24 AndAlso McLaunchJavaSelected.Is64Bit Then Args.Add("-XX:+UseCompactObjectHeaders")
  1422. If UseG1GC AndAlso SetupType = 4 Then
  1423. '优化的 G1GC
  1424. Args.Add("-XX:+UseG1GC")
  1425. Args.Add("-XX:G1NewSizePercent=20")
  1426. Args.Add("-XX:G1ReservePercent=20")
  1427. Args.Add("-XX:G1HeapRegionSize=32M")
  1428. Args.Add("-XX:MaxGCPauseMillis=50")
  1429. If Not ModeDebug Then Args.Add("-XX:+PerfDisableSharedMem")
  1430. If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
  1431. If McLaunchJavaSelected.MajorVersion = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
  1432. If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
  1433. If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
  1434. ElseIf UseG1GC Then
  1435. 'Mojang G1GC
  1436. Args.Add("-XX:+UseG1GC")
  1437. Args.Add("-XX:G1NewSizePercent=20")
  1438. Args.Add("-XX:G1ReservePercent=20")
  1439. Args.Add("-XX:G1HeapRegionSize=32M")
  1440. Args.Add("-XX:MaxGCPauseMillis=50")
  1441. If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
  1442. Else
  1443. 'ZGC
  1444. Args.Add("-XX:+UseZGC")
  1445. If McLaunchJavaSelected.MajorVersion = 21 OrElse McLaunchJavaSelected.MajorVersion = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC,不需要再添加参数
  1446. End If
  1447. End If
  1448. Args.Remove("-XX:MaxDirectMemorySize=256M") '#3511 的清理
  1449. #End Region
  1450. 'Log4j 漏洞防御参数
  1451. Args.Add("-Dlog4j2.formatMsgNoLookups=true")
  1452. '编码(#4700、#5892、#5909)
  1453. If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
  1454. If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
  1455. If McLaunchJavaSelected.MajorVersion >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面(#6934)
  1456. '为 JLW 添加 -jar,它必须放在最后
  1457. If UseJLW Then
  1458. Args.Add("-jar") : Args.Add(ExtractPatch("JavaWrapper"))
  1459. End If
  1460. '再次去重并输出
  1461. Return DeduplicateJavaArguments(Args, True)
  1462. End Function
  1463. '游戏参数部分
  1464. Private Function McLaunchArgumentsGame() As List(Of String)
  1465. Dim Arg As String = ""
  1466. 'Minecraft 参数
  1467. '旧版 MC:直接添加参数
  1468. If McInstanceSelected.JsonObject("minecraftArguments")?.ToString.Any Then
  1469. Dim BasicString As String = McInstanceSelected.JsonObject("minecraftArguments").ToString
  1470. McLaunchLog($"旧版游戏参数:" & BasicString)
  1471. BasicString += " --height ${resolution_height} --width ${resolution_width}" '总是添加宽高选项,之后去重的时候会覆盖 MC 自带的
  1472. Arg &= " " & BasicString
  1473. End If
  1474. '新版 MC:从版本 JSON 获取参数
  1475. If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("game") IsNot Nothing Then
  1476. Dim CurrentInstance As McInstance = McInstanceSelected
  1477. Dim AppendArg = Sub(a As String) Arg &= " " & If(a.Contains(" ") AndAlso Not a.StartsWithF("""") AndAlso Not a.EndsWithF(""""), $"""{a.Replace("""", "\""")}""", a)
  1478. NextInstance:
  1479. McLaunchLog($"新版游戏参数:从版本 JSON 获取({CurrentInstance.Name})")
  1480. If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("game") IsNot Nothing Then
  1481. For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("game")
  1482. Select Case SubJson.Type
  1483. Case JTokenType.String
  1484. AppendArg(SubJson.ToString)
  1485. Case JTokenType.Object
  1486. Dim Argument As JObject = CType(SubJson, JObject)
  1487. If Argument.ContainsKey("rules") AndAlso Not McJsonRuleCheck(Argument("rules")) Then Continue For '不满足准则
  1488. If Not Argument.ContainsKey("value") Then Continue For '没有 value 字段
  1489. If Argument("value").Type = JTokenType.String Then
  1490. AppendArg(Argument("value").ToString)
  1491. Else
  1492. For Each value As JToken In Argument("value")
  1493. AppendArg(value.ToString)
  1494. Next
  1495. End If
  1496. End Select
  1497. Next
  1498. End If
  1499. If CurrentInstance.InheritName <> "" Then
  1500. CurrentInstance = New McInstance(CurrentInstance.InheritName)
  1501. GoTo NextInstance
  1502. End If
  1503. End If
  1504. '设置里自定义的参数
  1505. Dim CustomArg As String = Settings.Get(Of String)("VersionAdvanceGame", Instance:=McInstanceSelected)
  1506. If CustomArg = "" Then CustomArg = Settings.Get(Of String)("LaunchAdvanceGame")
  1507. If CustomArg <> "" Then CustomArg = ArgumentReplace(CustomArg)
  1508. Arg &= " " & CustomArg
  1509. '把 OptiFineForgeTweaker 放在参数的末尾
  1510. If (McInstanceSelected.Version.HasForge OrElse McInstanceSelected.Version.HasLiteLoader) AndAlso McInstanceSelected.Version.HasOptiFine Then
  1511. If Arg.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
  1512. McLaunchLog("发现正确的 OptiFineForge TweakClass,目前的游戏参数:" & Arg)
  1513. Arg = Arg.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
  1514. End If
  1515. If Arg.Contains("--tweakClass optifine.OptiFineTweaker") Then
  1516. McLaunchLog("发现错误的 OptiFineForge TweakClass,目前的游戏参数:" & Arg)
  1517. Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
  1518. Try
  1519. FileUtils.Write(McInstanceSelected.GetJsonPath(), FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
  1520. Catch ex As Exception
  1521. Logger.Warn(ex, "替换 OptiFineForge TweakClass 失败")
  1522. End Try
  1523. End If
  1524. End If
  1525. '重新分割字符串并去重
  1526. Dim Args As List(Of String) = DeduplicateJavaArguments(SplitJavaArguments(Arg).ToList, False)
  1527. '额外传入的参数
  1528. Args.AddRange(CurrentLaunchOptions.ExtraGameArgs)
  1529. '全屏
  1530. If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 0 Then Args.Add("--fullscreen")
  1531. '自动进入服务器
  1532. Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Settings.Get(Of String)("VersionServerEnter", McInstanceSelected), CurrentLaunchOptions.ServerIp)
  1533. If Server.Any Then
  1534. If McInstanceSelected.ReleaseTime > New Date(2023, 4, 4) Then
  1535. 'QuickPlay
  1536. Args.Add($"--quickPlayMultiplayer") : Args.Add(Server)
  1537. Else
  1538. '老版本
  1539. If Server.Contains(":") Then
  1540. '包含端口号
  1541. Args.Add("--server") : Args.Add(Server.Split(":")(0))
  1542. Args.Add("--port") : Args.Add(Server.Split(":")(1))
  1543. Else
  1544. '不包含端口号
  1545. Args.Add("--server") : Args.Add(Server)
  1546. Args.Add("--port") : Args.Add("25565")
  1547. End If
  1548. If McInstanceSelected.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Red)
  1549. End If
  1550. End If
  1551. '再次去重并输出
  1552. Return DeduplicateJavaArguments(Args, False)
  1553. End Function
  1554. '获取替换标记
  1555. Private Iterator Function McLaunchArgumentsReplace(Arguments As List(Of String)) As IEnumerable(Of (Key As String, Value As String))
  1556. '基础参数
  1557. Yield ("${classpath_separator}", ";")
  1558. Yield ("${natives_directory}", GetNativesFolder().TrimEnd("\"c))
  1559. Yield ("${library_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
  1560. Yield ("${libraries_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
  1561. Yield ("${pure_directory}", PathPure.TrimEnd("\"c)) '由 PCL 添加,这会允许在分割参数并去重后再替换路径,防止路径中的特殊字符影响参数分割和去重
  1562. Yield ("${launcher_name}", "PCL")
  1563. Yield ("${launcher_version}", VersionCode)
  1564. Yield ("${version_name}", McInstanceSelected.Name)
  1565. Yield ("${game_directory}", PathUtils.ToShortPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
  1566. Yield ("${assets_root}", PathUtils.ToShortPath(McFolderSelected & "assets"))
  1567. Yield ("${user_properties}", "{}")
  1568. Yield ("${auth_player_name}", McLoginLoader.Output.Name)
  1569. Yield ("${auth_uuid}", McLoginLoader.Output.Uuid)
  1570. Yield ("${auth_access_token}", McLoginLoader.Output.AccessToken)
  1571. Yield ("${access_token}", McLoginLoader.Output.AccessToken)
  1572. Yield ("${auth_session}", McLoginLoader.Output.AccessToken)
  1573. Yield ("${user_type}", "msa") '#1221
  1574. Yield ("${primary_jar}", PathUtils.ToShortPath(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".jar")) '#6942
  1575. Yield ("${game_assets}", PathUtils.ToShortPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
  1576. Yield ("${assets_index_name}", McAssetsGetIndexName(McInstanceSelected))
  1577. '自定义信息
  1578. Dim ArgumentInfo As String
  1579. ArgumentInfo = Settings.Get(Of String)("VersionArgumentInfo", Instance:=McInstanceSelected)
  1580. If ArgumentInfo = "" Then ArgumentInfo = Settings.Get(Of String)("LaunchArgumentInfo")
  1581. If ArgumentInfo = "" Then '若自定义信息为空,则必须从参数中去掉该部分,不然 MC 会显示 ${version_type} 或者一个空字符串
  1582. If Arguments.Contains("--versionType") Then
  1583. Dim Index As Integer = Arguments.IndexOf("--versionType")
  1584. Arguments.RemoveAt(Index)
  1585. If Index < Arguments.Count Then Arguments.RemoveAt(Index)
  1586. End If
  1587. Yield ("${version_type}", """""")
  1588. Else
  1589. Yield ("${version_type}", ArgumentReplace(ArgumentInfo))
  1590. End If
  1591. '窗口尺寸
  1592. Dim TargetSize As Size
  1593. Select Case Settings.Get(Of Integer)("LaunchArgumentWindowType")
  1594. Case 2 '与启动器尺寸一致
  1595. Dim Result As Size
  1596. RunInUiWait(Sub() Result = New Size(GetPixelSize(FrmMain.PanForm.ActualWidth), GetPixelSize(FrmMain.PanForm.ActualHeight)))
  1597. TargetSize = Result
  1598. TargetSize.Height -= 29.5 * DPI / 96 '标题栏高度
  1599. Case 3 '自定义
  1600. TargetSize = New Size(Math.Max(100, Settings.Get(Of Integer)("LaunchArgumentWindowWidth")), Math.Max(100, Settings.Get(Of Integer)("LaunchArgumentWindowHeight")))
  1601. Case Else
  1602. TargetSize = New Size(854, 480)
  1603. End Select
  1604. If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
  1605. McLaunchJavaSelected.MajorVersion <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
  1606. Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍(#3463)
  1607. McLaunchLog($"已应用窗口大小过大修复({McLaunchJavaSelected.Version.Revision})")
  1608. TargetSize.Width /= DPI / 96
  1609. TargetSize.Height /= DPI / 96
  1610. End If
  1611. Yield ("${resolution_width}", Math.Round(TargetSize.Width))
  1612. Yield ("${resolution_height}", Math.Round(TargetSize.Height))
  1613. '支持库
  1614. Dim Cps As New List(Of String)
  1615. Dim OptiFineCp As String = Nothing
  1616. For Each Library As McLibEntry In McLibListGet(McInstanceSelected, True)
  1617. If Library.IsNatives Then Continue For
  1618. If Library.Name IsNot Nothing AndAlso Library.Name = "optifine:OptiFine" Then
  1619. OptiFineCp = Library.LocalPath
  1620. Else
  1621. Cps.Add(Library.LocalPath)
  1622. End If
  1623. Next
  1624. If OptiFineCp IsNot Nothing Then Cps.Insert(Cps.Count - 2, OptiFineCp) 'OptiFine 的总是需要放到倒数第二位
  1625. Yield ("${classpath}", Cps.Select(Function(c) PathUtils.ToShortPath(c)).Join(";"c))
  1626. End Function
  1627. ''' <summary>
  1628. ''' 分割 Java 参数字符串。
  1629. ''' </summary>
  1630. Private Iterator Function SplitJavaArguments(Arg As String) As IEnumerable(Of String)
  1631. Arg = Arg.ReplaceLineEndings(" ", mergeMultiple:=True).Trim '预处理换行符
  1632. If String.IsNullOrWhiteSpace(Arg) Then Return
  1633. Dim Current As New StringBuilder
  1634. Dim InQuotes As Boolean = False
  1635. Dim i As Integer = 0
  1636. While i < Arg.Length
  1637. Dim c As Char = Arg(i)
  1638. If c = "\"c AndAlso i + 1 < Arg.Length AndAlso Arg(i + 1) = """"c Then '检测 \"
  1639. '转义的双引号:保留反斜杠和引号,不切换 InQuotes
  1640. Current.Append("\""")
  1641. i += 1 '额外跳过下一个字符(双引号)
  1642. ElseIf c = """"c Then
  1643. '未转义的双引号:切换 InQuotes
  1644. InQuotes = Not InQuotes
  1645. Current.Append(c)
  1646. ElseIf c = " "c AndAlso Not InQuotes Then
  1647. '不在双引号内的空格:一个参数结束
  1648. If Current.Length > 0 Then
  1649. Yield Current.ToString()
  1650. Current.Clear()
  1651. End If
  1652. Else
  1653. '普通字符,直接添加
  1654. Current.Append(c)
  1655. End If
  1656. i += 1
  1657. End While
  1658. If Current.Length > 0 Then Yield Current.ToString '添加剩余的
  1659. End Function
  1660. ''' <summary>
  1661. ''' 对 Java 参数进行去重。
  1662. ''' </summary>
  1663. Private Function DeduplicateJavaArguments(Args As List(Of String), IsJVMArgs As Boolean) As List(Of String)
  1664. Dim Result As New List(Of String)
  1665. Dim i As Integer = 0
  1666. While i < Args.Count
  1667. Dim Key As String = Args(i)
  1668. If Not Key.StartsWithF("-") OrElse
  1669. (i + 1 >= Args.Count OrElse (Args(i + 1).StartsWithF("-") AndAlso Val(Args(i + 1).AfterFirst("-")) = 0)) Then '避免 -xPos 23 -xPos -50 中后面的 -50 被识别为参数
  1670. '单参数
  1671. i += 1
  1672. If Result.Contains(Key) Then
  1673. McLaunchLog($"已去重单个{If(IsJVMArgs, " JVM ", "游戏")}参数:{Key}")
  1674. Continue While
  1675. End If
  1676. Result.Add(Key)
  1677. Else
  1678. '以空格间隔的键值对(例如 --width 233)
  1679. Dim Value As String = Args(i + 1)
  1680. i += 2
  1681. For j = 0 To Result.Count - 2 '向前寻找相同的键
  1682. If Result(j) <> Key Then Continue For
  1683. '仅当是游戏参数且不是 tweakClass 时,用新的值覆盖旧的值
  1684. '据测试,如果包含多个相同 --width 或 --uuid 等参数,两个都会直接失效,如果这发生在关键参数上会导致崩溃
  1685. If Not IsJVMArgs AndAlso Key <> "--tweakClass" Then
  1686. McLaunchLog($"已覆盖重复的{If(IsJVMArgs, " JVM ", "游戏")}参数:{Key} {Result(j + 1)} → {Key} {Value}")
  1687. Result(j + 1) = Value
  1688. Continue While
  1689. End If
  1690. '键和值完全相同,直接抛弃
  1691. If Result(j + 1) = Value Then
  1692. McLaunchLog($"已去重{If(IsJVMArgs, " JVM ", "游戏")}参数对:{Key} {Value}")
  1693. Continue While
  1694. End If
  1695. Next
  1696. Result.Add(Key)
  1697. Result.Add(Value)
  1698. End If
  1699. End While
  1700. Return Result
  1701. End Function
  1702. #End Region
  1703. #Region "解压 Natives"
  1704. Private Sub McLaunchNatives(Loader As LoaderTask(Of Integer, Integer))
  1705. '创建文件夹
  1706. Dim Target As String = GetNativesFolder()
  1707. DirectoryUtils.Create(Target)
  1708. '解压文件
  1709. McLaunchLog("正在解压 Natives 文件")
  1710. Dim ExistFiles As New List(Of String)
  1711. For Each Native As McLibEntry In McLibListGet(McInstanceSelected, True)
  1712. If Not Native.IsNatives Then Continue For
  1713. Dim Zip As ZipArchive
  1714. Try
  1715. Zip = FileUtils.OpenZip(Native.LocalPath)
  1716. Catch ex As InvalidDataException
  1717. Logger.Warn(ex, $"打开 Natives 文件失败({Native.LocalPath})")
  1718. FileUtils.Delete(Native.LocalPath)
  1719. Throw New Exception("无法打开 Natives 文件(" & Native.LocalPath & "),该文件可能已损坏,请重新尝试启动游戏")
  1720. End Try
  1721. For Each Entry In Zip.Entries
  1722. Dim FileName As String = Entry.FullName
  1723. If FileName.EndsWithF(".dll", True) Then
  1724. '实际解压文件的步骤
  1725. Dim FilePath As String = Target & FileName
  1726. ExistFiles.Add(FilePath)
  1727. Dim OriginalFile = FileUtils.GetInfo(FilePath)
  1728. If OriginalFile.Exists Then
  1729. If OriginalFile.Length = Entry.Length Then
  1730. If ModeDebug Then McLaunchLog("无需解压:" & FilePath)
  1731. Continue For
  1732. End If
  1733. '删除原文件
  1734. Try
  1735. FileUtils.Delete(FilePath)
  1736. Catch ex As UnauthorizedAccessException
  1737. McLaunchLog("删除原 dll 访问被拒绝,这通常代表有一个 MC 正在运行,跳过解压:" & FilePath)
  1738. McLaunchLog("实际的错误信息:" & ex.GetDisplay(True))
  1739. Exit For
  1740. End Try
  1741. End If
  1742. '解压新文件
  1743. FileUtils.Write(FilePath, Entry.Open)
  1744. McLaunchLog("已解压:" & FilePath)
  1745. End If
  1746. Next
  1747. If Zip IsNot Nothing Then Zip.Dispose()
  1748. Next
  1749. '删除多余文件
  1750. For Each FileName As String In DirectoryUtils.GetFiles(Target, True)
  1751. If ExistFiles.Contains(FileName) Then Continue For
  1752. Try
  1753. McLaunchLog("删除:" & FileName)
  1754. FileUtils.Delete(FileName)
  1755. Catch ex As UnauthorizedAccessException
  1756. McLaunchLog("删除多余文件访问被拒绝,跳过删除步骤")
  1757. McLaunchLog("实际的错误信息:" & ex.GetDisplay(True))
  1758. Return
  1759. End Try
  1760. Next
  1761. End Sub
  1762. ''' <summary>
  1763. ''' 获取 Natives 文件夹路径,以 \ 结尾。
  1764. ''' </summary>
  1765. Private Function GetNativesFolder() As String
  1766. Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\"
  1767. If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
  1768. Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives\"
  1769. If Not Result.IsAsciiOnly() Then
  1770. Result = OsDrive & "ProgramData\PCL\natives\"
  1771. End If
  1772. End If
  1773. DirectoryUtils.Create(Result) '提前创建,这样 DirectoryUtils.Shorten 才有结果(否则在长路径下首次启动 Forge 会崩溃)
  1774. Return PathUtils.AddSlashSuffix(PathUtils.ToShortPath(Result))
  1775. End Function
  1776. #End Region
  1777. #Region "启动与前后处理"
  1778. Private Sub McLaunchPrerun()
  1779. '使用高性能显卡
  1780. If Settings.Get(Of Boolean)("LaunchAdvanceGraphicCard") Then
  1781. Try
  1782. SetGPUPreference(McLaunchJavaSelected.PathJava)
  1783. SetGPUPreference(PathExe)
  1784. Catch ex As Exception
  1785. If SystemUtils.HasAdminRole() Then
  1786. Logger.Warn(ex, "直接调整显卡设置失败")
  1787. Else
  1788. Logger.Warn(ex, "直接调整显卡设置失败,将以管理员权限重启 PCL 再次尝试")
  1789. Try
  1790. If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then
  1791. McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
  1792. Else
  1793. Throw New Exception("调整过程中出现异常")
  1794. End If
  1795. Catch exx As Exception
  1796. Logger.Error(exx, "调整显卡设置失败,Minecraft 可能会使用默认显卡运行", LogBehavior.Toast)
  1797. End Try
  1798. End If
  1799. End Try
  1800. End If
  1801. '更新 launcher_profiles.json
  1802. Try
  1803. '确保可用
  1804. If Not McLoginLoader.Output.Type = "Microsoft" Then Exit Try
  1805. McFolderLauncherProfilesJsonCreate(McFolderSelected)
  1806. '构建需要替换的 Json 对象
  1807. Dim ReplaceJsonString As String = "
  1808. {
  1809. ""authenticationDatabase"": {
  1810. ""00000111112222233333444445555566"": {
  1811. ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
  1812. ""profiles"": {
  1813. ""66666555554444433333222221111100"": {
  1814. ""displayName"": """ & McLoginLoader.Output.Name & """
  1815. }
  1816. }
  1817. }
  1818. },
  1819. ""clientToken"": """ & McLoginLoader.Output.ClientToken & """,
  1820. ""selectedUser"": {
  1821. ""account"": ""00000111112222233333444445555566"",
  1822. ""profile"": ""66666555554444433333222221111100""
  1823. }
  1824. }"
  1825. Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
  1826. '更新文件
  1827. Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
  1828. Profiles.Merge(ReplaceJson)
  1829. FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
  1830. McLaunchLog("已更新 launcher_profiles.json")
  1831. Catch ex As Exception
  1832. Logger.Warn(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试")
  1833. Try
  1834. FileUtils.Delete(McFolderSelected & "launcher_profiles.json")
  1835. McFolderLauncherProfilesJsonCreate(McFolderSelected)
  1836. '构建需要替换的 Json 对象
  1837. Dim ReplaceJsonString As String = "
  1838. {
  1839. ""authenticationDatabase"": {
  1840. ""00000111112222233333444445555566"": {
  1841. ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
  1842. ""profiles"": {
  1843. ""66666555554444433333222221111100"": {
  1844. ""displayName"": """ & McLoginLoader.Output.Name & """
  1845. }
  1846. }
  1847. }
  1848. },
  1849. ""clientToken"": """ & McLoginLoader.Output.ClientToken & """,
  1850. ""selectedUser"": {
  1851. ""account"": ""00000111112222233333444445555566"",
  1852. ""profile"": ""66666555554444433333222221111100""
  1853. }
  1854. }"
  1855. Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
  1856. '更新文件
  1857. Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
  1858. Profiles.Merge(ReplaceJson)
  1859. FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
  1860. McLaunchLog("已在删除后更新 launcher_profiles.json")
  1861. Catch exx As Exception
  1862. Logger.Error(exx, "更新 launcher_profiles.json 失败")
  1863. End Try
  1864. End Try
  1865. '更新 options.txt
  1866. Dim SetupFileAddress As String = McInstanceSelected.PathIndie & "options.txt"
  1867. If Not FileUtils.Exists(SetupFileAddress) Then
  1868. 'Yosbr Mod 兼容(#2385):https://www.curseforge.com/minecraft/mc-mods/yosbr
  1869. Dim YosbrFileAddress As String = McInstanceSelected.PathIndie & "config\yosbr\options.txt"
  1870. If FileUtils.Exists(YosbrFileAddress) Then
  1871. McLaunchLog("将修改 Yosbr Mod 中的 options.txt")
  1872. SetupFileAddress = YosbrFileAddress
  1873. WriteIni(SetupFileAddress, "lang", "none") '忽略默认语言
  1874. End If
  1875. End If
  1876. Try
  1877. '语言
  1878. '1.0- :没有语言选项
  1879. '1.1 ~ 5 :zh_CN 时正常,zh_cn 时崩溃(最后两位字母必须大写,否则将会 NPE 崩溃)
  1880. '1.6 ~ 10 :zh_CN 时正常,zh_cn 时自动切换为英文
  1881. '1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
  1882. '1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文
  1883. Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
  1884. Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not DirectoryUtils.Exists(McInstanceSelected.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
  1885. If(Settings.Get(Of Boolean)("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.Lower)
  1886. If Not McInstanceSelected.Version.Vaild OrElse McInstanceSelected.Version.Vanilla.Major <= 10 Then
  1887. '将最后两位改为大写,前面的部分保留
  1888. RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).Upper
  1889. End If
  1890. If CurrentLang = RequiredLang Then
  1891. McLaunchLog($"需要的语言为 {RequiredLang},当前语言为 {CurrentLang},无需修改")
  1892. Else
  1893. WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改,避免删除后重新下载残留缓存
  1894. WriteIni(SetupFileAddress, "lang", RequiredLang)
  1895. McLaunchLog($"已将语言从 {CurrentLang} 修改为 {RequiredLang}")
  1896. End If
  1897. ''如果是初次设置,一并修改 forceUnicodeFont
  1898. 'If Settings.Get(Of Boolean)("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not DirectoryUtils.Exists(McInstanceSelected.PathIndie & "saves")) Then
  1899. ' WriteIni(SetupFileAddress, "forceUnicodeFont", "true")
  1900. ' McLaunchLog("已开启 forceUnicodeFont")
  1901. 'End If
  1902. '窗口
  1903. Select Case Settings.Get(Of Integer)("LaunchArgumentWindowType")
  1904. Case 0 '全屏
  1905. WriteIni(SetupFileAddress, "fullscreen", "true")
  1906. Case 1 '默认
  1907. Case Else '其他
  1908. WriteIni(SetupFileAddress, "fullscreen", "false")
  1909. End Select
  1910. Catch ex As Exception
  1911. Logger.Error(ex, "更新 options.txt 失败", LogBehavior.Toast)
  1912. End Try
  1913. '离线皮肤 Alex 警告
  1914. If McInstanceSelected.Version.Vanilla.Major <= 7 AndAlso McInstanceSelected.Version.Vanilla.Major >= 2 AndAlso '1.2 ~ 1.7
  1915. McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
  1916. (Settings.Get(Of Integer)("LaunchSkinType") = 2 OrElse '强制 Alex
  1917. (Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso Settings.Get(Of Boolean)("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
  1918. Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Red)
  1919. End If
  1920. '离线皮肤资源包
  1921. Try
  1922. Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
  1923. Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
  1924. If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
  1925. Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
  1926. Dim PackPicAddress As String = PathTemp & "pack.png"
  1927. Dim PackFormat As Integer
  1928. Select Case McInstanceSelected.Version.Vanilla.Major
  1929. Case 0, 1, 2, 3, 4, 5
  1930. '更早的版本没有资源包
  1931. McLaunchLog("Minecraft 版本过老,尚不支持自定义离线皮肤")
  1932. GoTo IgnoreCustomSkin
  1933. Case 6, 7, 8
  1934. PackFormat = 1
  1935. Case 9, 10
  1936. PackFormat = 2
  1937. Case 11, 12
  1938. PackFormat = 3
  1939. Case 13, 14
  1940. PackFormat = 4
  1941. Case 15
  1942. PackFormat = 5
  1943. Case 16
  1944. PackFormat = 6
  1945. Case 17
  1946. PackFormat = 7
  1947. Case 18
  1948. If McInstanceSelected.Version.Vanilla.Minor <= 2 Then
  1949. PackFormat = 8
  1950. Else
  1951. PackFormat = 9
  1952. End If
  1953. Case 19
  1954. If McInstanceSelected.Version.Vanilla.Minor <= 3 Then
  1955. PackFormat = 9
  1956. Else
  1957. PackFormat = 12
  1958. End If
  1959. Case 20
  1960. If McInstanceSelected.Version.Vanilla.Minor <= 1 Then
  1961. PackFormat = 15
  1962. Else
  1963. PackFormat = 17
  1964. End If
  1965. Case Else '快照版是 9999
  1966. PackFormat = 17
  1967. 'https://zh.minecraft.wiki/w/数据包#数据包版本
  1968. End Select
  1969. McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat)
  1970. '准备文件
  1971. Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
  1972. Bit.Save(PackPicAddress)
  1973. FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
  1974. Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
  1975. If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
  1976. McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
  1977. Skin = Skin.Clip(0, 0, 64, 32)
  1978. End If
  1979. Skin.Save(PathExeFolder & "PCL\CustomSkin_Cliped.png")
  1980. '构建压缩文件
  1981. Dim FilesToCompress As New Dictionary(Of String, String) From {
  1982. {"pack.mcmeta", MetaFileAddress}, {"pack.png", PackPicAddress}}
  1983. If McInstanceSelected.Version.Vanilla >= New Version(19, 0, 3) Then
  1984. '1.19.3+ 使用复杂版本的替换
  1985. For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
  1986. FilesToCompress.Add(
  1987. $"assets/minecraft/textures/entity/player/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png",
  1988. PathExeFolder & "PCL\CustomSkin_Cliped.png")
  1989. Next
  1990. Else
  1991. FilesToCompress.Add(
  1992. $"assets/minecraft/textures/entity/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "alex.png", "steve.png")}",
  1993. PathExeFolder & "PCL\CustomSkin_Cliped.png")
  1994. End If
  1995. FileUtils.CreateZipFromFiles(ZipFileAddress, FilesToCompress)
  1996. FileUtils.Delete(PathExeFolder & "PCL\CustomSkin_Cliped.png")
  1997. '更改设置文件
  1998. IniClearCache(SetupFileAddress)
  1999. Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
  2000. If NewTypeSetup Then
  2001. If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla"""
  2002. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  2003. Dim NewResourcePacks As New List(Of String)
  2004. For Each Res In EnabledResourcePacks
  2005. If Res <> """file/PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res)
  2006. Next
  2007. NewResourcePacks.Add("""file/PCL2 Skin.zip""")
  2008. Dim Result As String = "[" & NewResourcePacks.Join(","c) & "]"
  2009. WriteIni(SetupFileAddress, "resourcePacks", Result)
  2010. Else
  2011. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  2012. Dim NewResourcePacks As New List(Of String)
  2013. For Each Res In EnabledResourcePacks
  2014. If Res <> """PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res)
  2015. Next
  2016. NewResourcePacks.Add("""PCL2 Skin.zip""")
  2017. Dim Result As String = "[" & NewResourcePacks.Join(","c) & "]"
  2018. WriteIni(SetupFileAddress, "resourcePacks", Result)
  2019. End If
  2020. IgnoreCustomSkin:
  2021. ElseIf FileUtils.Exists(ZipFileAddress) Then
  2022. McLaunchLog("正在清空自定义皮肤资源包")
  2023. '删除压缩文件
  2024. FileUtils.Delete(ZipFileAddress)
  2025. '更改设置文件
  2026. IniClearCache(SetupFileAddress)
  2027. Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
  2028. If NewTypeSetup Then
  2029. If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla"""
  2030. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  2031. EnabledResourcePacks.Remove("""file/PCL2 Skin.zip""")
  2032. Dim Result As String = "[" & EnabledResourcePacks.Join(","c) & "]"
  2033. WriteIni(SetupFileAddress, "resourcePacks", Result)
  2034. Else
  2035. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  2036. EnabledResourcePacks.Remove("""PCL2 Skin.zip""")
  2037. Dim Result As String = "[" & EnabledResourcePacks.Join(","c) & "]"
  2038. WriteIni(SetupFileAddress, "resourcePacks", Result)
  2039. End If
  2040. End If
  2041. Catch ex As Exception
  2042. Logger.Error(ex, "离线皮肤资源包设置失败", LogBehavior.Toast)
  2043. End Try
  2044. End Sub
  2045. Private Sub McLaunchCustom(Loader As LoaderTask(Of Integer, Integer))
  2046. '获取自定义命令
  2047. Dim CustomCommandGlobal As String = Settings.Get(Of String)("LaunchAdvanceRun")
  2048. If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
  2049. Dim CustomCommandVersion As String = Settings.Get(Of String)("VersionAdvanceRun", Instance:=McInstanceSelected)
  2050. If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
  2051. '输出 bat
  2052. Try
  2053. Dim CmdString As String =
  2054. $"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" &
  2055. "@echo off" & vbCrLf &
  2056. $"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
  2057. "echo 游戏正在启动,请稍候。" & vbCrLf &
  2058. $"cd /D ""{PathUtils.ToShortPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
  2059. CustomCommandGlobal & vbCrLf &
  2060. CustomCommandVersion & vbCrLf &
  2061. $"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
  2062. "echo 游戏已退出。" & vbCrLf &
  2063. "pause"
  2064. FileUtils.Write(
  2065. filePath:=If(CurrentLaunchOptions.SaveBatch, PathExeFolder & "PCL\LatestLaunch.bat"),
  2066. text:=FilterAccessToken(CmdString, "F").Replace("%", "%%"),
  2067. encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
  2068. If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
  2069. McLaunchLog("导出启动脚本完成,强制结束启动过程")
  2070. InterruptHint = "导出启动脚本成功!"
  2071. OpenExplorer(CurrentLaunchOptions.SaveBatch)
  2072. Loader.Parent.Interrupt()
  2073. Return '导出脚本完成
  2074. End If
  2075. Catch ex As Exception
  2076. Logger.Warn(ex, "输出启动脚本失败")
  2077. If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
  2078. End Try
  2079. '执行自定义命令
  2080. If CustomCommandGlobal <> "" Then
  2081. McLaunchLog("正在执行全局自定义命令:" & CustomCommandGlobal)
  2082. Dim CustomProcess As Process = Nothing
  2083. Try
  2084. CustomProcess = StartProcess(New ProcessStartInfo With {
  2085. .FileName = "cmd.exe",
  2086. .Arguments = $"/c ""{CustomCommandGlobal}""",
  2087. .WorkingDirectory = McFolderSelected,
  2088. .UseShellExecute = False,
  2089. .CreateNoWindow = True
  2090. })
  2091. If Settings.Get(Of Boolean)("LaunchAdvanceRunWait") Then
  2092. Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
  2093. Thread.Sleep(10)
  2094. Loop
  2095. End If
  2096. Catch ex As Exception
  2097. Logger.Error(ex, "执行全局自定义命令失败", LogBehavior.Toast)
  2098. Finally
  2099. If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
  2100. McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
  2101. CustomProcess.Kill()
  2102. End If
  2103. End Try
  2104. End If
  2105. If CustomCommandVersion <> "" Then
  2106. McLaunchLog("正在执行版本自定义命令:" & CustomCommandVersion)
  2107. Dim CustomProcess As Process = Nothing
  2108. Try
  2109. CustomProcess = StartProcess(New ProcessStartInfo With {
  2110. .FileName = "cmd.exe",
  2111. .Arguments = $"/c ""{CustomCommandVersion}""",
  2112. .WorkingDirectory = McFolderSelected,
  2113. .UseShellExecute = False,
  2114. .CreateNoWindow = True
  2115. })
  2116. If Settings.Get(Of Boolean)("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
  2117. Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
  2118. Thread.Sleep(10)
  2119. Loop
  2120. End If
  2121. Catch ex As Exception
  2122. Logger.Error(ex, "执行版本自定义命令失败", LogBehavior.Toast)
  2123. Finally
  2124. If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
  2125. McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
  2126. CustomProcess.Kill()
  2127. End If
  2128. End Try
  2129. End If
  2130. End Sub
  2131. Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
  2132. '启动信息
  2133. Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
  2134. '设置环境变量
  2135. Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
  2136. Dim Paths As New List(Of String)
  2137. If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
  2138. Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.PathFolder))
  2139. StartInfo.EnvironmentVariables("Path") = Paths.Distinct.Join(";"c)
  2140. StartInfo.EnvironmentVariables("appdata") = PathUtils.ToShortPath(McFolderSelected)
  2141. '设置其他参数
  2142. StartInfo.WorkingDirectory = McInstanceSelected.PathIndie
  2143. StartInfo.UseShellExecute = False
  2144. StartInfo.RedirectStandardOutput = True
  2145. StartInfo.RedirectStandardError = True
  2146. StartInfo.CreateNoWindow = True
  2147. StartInfo.Arguments = McLaunchArgument
  2148. '开始进程
  2149. Dim GameProcess = StartProcess(StartInfo)
  2150. McLaunchLog("已启动游戏进程:" & McLaunchJavaSelected.PathJava)
  2151. If Loader.IsInterrupted Then
  2152. McLaunchLog("由于取消启动,已强制结束游戏进程") '#1631
  2153. GameProcess.Kill()
  2154. Return
  2155. End If
  2156. Loader.Output = GameProcess
  2157. McLaunchProcess = GameProcess
  2158. '进程优先级处理
  2159. Try
  2160. GameProcess.PriorityBoostEnabled = True
  2161. Select Case Settings.Get(Of Integer)("LaunchArgumentPriority")
  2162. Case 0 '高
  2163. GameProcess.PriorityClass = ProcessPriorityClass.AboveNormal
  2164. Case 2 '低
  2165. GameProcess.PriorityClass = ProcessPriorityClass.BelowNormal
  2166. Case Else '中
  2167. End Select
  2168. Catch ex As Exception
  2169. Logger.Error(ex, "设置进程优先级失败")
  2170. End Try
  2171. End Sub
  2172. Private Sub McLaunchWait(Loader As LoaderTask(Of Process, Integer))
  2173. '输出信息
  2174. McLaunchLog("")
  2175. McLaunchLog("~ 基础参数 ~")
  2176. McLaunchLog("PCL 版本:" & VersionDisplay & " (" & VersionCode & ")")
  2177. McLaunchLog($"游戏版本:{McInstanceSelected.VersionDisplayName}({McInstanceSelected.Version.Vanilla},Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", ",无法完全确定")})")
  2178. McLaunchLog("资源版本:" & McAssetsGetIndexName(McInstanceSelected))
  2179. McLaunchLog("版本继承:" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
  2180. McLaunchLog("分配的内存:" & PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) & " GB(" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB)")
  2181. McLaunchLog("MC 文件夹:" & McFolderSelected)
  2182. McLaunchLog("版本文件夹:" & McInstanceSelected.PathVersion)
  2183. McLaunchLog("版本隔离:" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
  2184. McLaunchLog("HMCL 格式:" & McInstanceSelected.IsHmclFormatJson)
  2185. McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
  2186. McLaunchLog("环境变量:" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
  2187. McLaunchLog("Natives 文件夹:" & GetNativesFolder())
  2188. McLaunchLog("")
  2189. McLaunchLog("~ 登录参数 ~")
  2190. McLaunchLog("玩家用户名:" & McLoginLoader.Output.Name)
  2191. McLaunchLog("AccessToken:" & McLoginLoader.Output.AccessToken)
  2192. McLaunchLog("ClientToken:" & McLoginLoader.Output.ClientToken)
  2193. McLaunchLog("UUID:" & McLoginLoader.Output.Uuid)
  2194. McLaunchLog("登录方式:" & McLoginLoader.Output.Type)
  2195. McLaunchLog("")
  2196. '获取窗口标题
  2197. Dim WindowTitle As String = Settings.Get(Of String)("VersionArgumentTitle", Instance:=McInstanceSelected)
  2198. If WindowTitle = "" Then WindowTitle = Settings.Get(Of String)("LaunchArgumentTitle")
  2199. WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
  2200. '初始化等待
  2201. Dim Watcher As New Watcher(Loader, McInstanceSelected, WindowTitle)
  2202. McLaunchWatcher = Watcher
  2203. '等待
  2204. Do While Watcher.State = Watcher.MinecraftState.Loading
  2205. Thread.Sleep(100)
  2206. Loop
  2207. If Watcher.State = Watcher.MinecraftState.Crashed Then
  2208. Throw New Exception("$$")
  2209. End If
  2210. End Sub
  2211. Private Sub McLaunchEnd()
  2212. McLaunchLog("开始启动结束处理")
  2213. '暂停或开始音乐播放
  2214. If Settings.Get(Of Boolean)("UiMusicStop") Then
  2215. RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置,在启动后暂停音乐播放"))
  2216. ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then
  2217. RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置,在启动后开始音乐播放"))
  2218. End If
  2219. '启动器可见性
  2220. McLaunchLog("启动器可见性:" & Settings.Get(Of Integer)("LaunchArgumentVisible"))
  2221. Select Case Settings.Get(Of Integer)("LaunchArgumentVisible")
  2222. Case 0
  2223. '直接关闭
  2224. McLaunchLog("已根据设置,在启动后关闭启动器")
  2225. RunInUi(Sub() FrmMain.EndProgram(False))
  2226. Case 2, 3
  2227. '隐藏
  2228. McLaunchLog("已根据设置,在启动后隐藏启动器")
  2229. RunInUi(Sub() FrmMain.Hidden = True)
  2230. Case 4
  2231. '最小化
  2232. McLaunchLog("已根据设置,在启动后最小化启动器")
  2233. RunInUi(Sub() FrmMain.WindowState = WindowState.Minimized)
  2234. Case 5
  2235. '啥都不干
  2236. End Select
  2237. '启动计数
  2238. Settings.Set("SystemLaunchCount", Settings.Get(Of Integer)("SystemLaunchCount") + 1)
  2239. End Sub
  2240. #End Region
  2241. End Module