ModLaunch.vb 103 KB

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