ModLaunch.vb 110 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134
  1. Imports System.IO.Compression
  2. Public Module ModLaunch
  3. #Region "开始"
  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。使用 McVersionCurrent。
  18. ''' </summary>
  19. Public Version As McVersion = Nothing
  20. End Class
  21. ''' <summary>
  22. ''' 尝试启动 Minecraft。必须在 UI 线程调用。
  23. ''' 返回是否实际开始了启动(如果没有,则一定弹出了错误提示)。
  24. ''' </summary>
  25. Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
  26. Options = If(Options, New McLaunchOptions)
  27. '预检查
  28. If Not RunInUi() Then
  29. Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
  30. End If
  31. If McLaunchLoader.State = LoadState.Loading Then
  32. Hint("已有游戏正在启动中!", HintType.Critical)
  33. Return False
  34. End If
  35. '强制切换需要启动的版本
  36. If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then
  37. McLaunchLog("在启动前切换到版本 " & Options.Version.Name)
  38. '检查版本
  39. Options.Version.Load()
  40. If Options.Version.State = McVersionState.Error Then
  41. Hint("无法启动 Minecraft:" & Options.Version.Info, HintType.Critical)
  42. Return False
  43. End If
  44. '切换版本
  45. McVersionCurrent = Options.Version
  46. Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
  47. FrmLaunchLeft.RefreshButtonsUI()
  48. FrmLaunchLeft.RefreshPage(False, False)
  49. End If
  50. FrmMain.AprilGiveup()
  51. '禁止进入版本选择页面(否则就可以在启动中切换 McVersionCurrent 了)
  52. FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.VersionSelect).ToList
  53. '实际启动加载器
  54. McLaunchLoader.Start(Options, IsForceRestart:=True)
  55. Return True
  56. End Function
  57. ''' <summary>
  58. ''' 记录启动日志。
  59. ''' </summary>
  60. Public Sub McLaunchLog(Text As String)
  61. RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
  62. Log("[Launch] " & Text)
  63. End Sub
  64. '启动状态切换
  65. Public McLaunchLoader As New LoaderTask(Of McLaunchOptions, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState}
  66. Public McLaunchLoaderReal As LoaderCombo(Of Object)
  67. Public McLaunchProcess As Process
  68. Public McLaunchWatcher As Watcher
  69. Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
  70. Select Case McLaunchLoader.State
  71. Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Aborted
  72. FrmLaunchLeft.PageChangeToLogin()
  73. Case LoadState.Loading
  74. '在预检测结束后再触发动画
  75. FrmLaunchRight.LabLog.Text = ""
  76. End Select
  77. End Sub
  78. ''' <summary>
  79. ''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
  80. ''' </summary>
  81. Private AbortHint As String = Nothing
  82. '实际的启动方法
  83. Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
  84. '开始动画
  85. RunInUiWait(AddressOf FrmLaunchLeft.PageChangeToLaunching)
  86. '预检测(预检测的错误将直接抛出)
  87. Try
  88. McLaunchPrecheck()
  89. McLaunchLog("预检测已通过")
  90. Catch ex As Exception
  91. Hint(ex.Message, HintType.Critical)
  92. Throw
  93. End Try
  94. '正式加载
  95. Try
  96. '构造主加载器
  97. Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", {
  98. New LoaderCombo(Of Integer)("Java 处理", {
  99. New LoaderTask(Of Integer, List(Of NetFile))("Java 验证", AddressOf McLaunchJavaValidate) With {.ProgressWeight = 2}
  100. }) With {.ProgressWeight = 2, .Show = False, .Block = False},
  101. McLoginLoader,
  102. New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True},
  103. New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
  104. New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
  105. New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
  106. New LoaderTask(Of Integer, Integer)("执行自定义命令", AddressOf McLaunchCustom) With {.ProgressWeight = 1},
  107. New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2},
  108. New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
  109. New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
  110. }) With {.Show = False}
  111. If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
  112. '等待加载器执行并更新 UI
  113. McLaunchLoaderReal = LaunchLoader
  114. AbortHint = Nothing
  115. LaunchLoader.Start()
  116. '任务栏进度条
  117. LoaderTaskbarAdd(LaunchLoader)
  118. Do While LaunchLoader.State = LoadState.Loading
  119. FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
  120. Thread.Sleep(200)
  121. Loop
  122. FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
  123. '成功与失败处理
  124. Select Case LaunchLoader.State
  125. Case LoadState.Finished
  126. Hint(McVersionCurrent.Name & " 启动成功!", HintType.Finish)
  127. Case LoadState.Aborted
  128. If AbortHint Is Nothing Then
  129. Hint(If(Loader.Input.SaveBatch Is Nothing, "已取消启动!", "已取消导出启动脚本!"), HintType.Info)
  130. Else
  131. Hint(AbortHint, HintType.Finish)
  132. End If
  133. Case LoadState.Failed
  134. Throw LaunchLoader.Error
  135. Case Else
  136. Throw New Exception("错误的状态改变:" & GetStringFromEnum(CType(LaunchLoader.State, [Enum])))
  137. End Select
  138. Catch ex As Exception
  139. Dim CurrentEx = ex
  140. NextInner:
  141. If CurrentEx.Message.StartsWith("$") Then
  142. '若有以 $ 开头的错误信息,则以此为准显示提示
  143. '若错误信息为 $$,则不提示
  144. If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
  145. Throw
  146. ElseIf CurrentEx.InnerException IsNot Nothing Then
  147. '检查下一级错误
  148. CurrentEx = CurrentEx.InnerException
  149. GoTo NextInner
  150. Else
  151. '没有特殊处理过的错误信息
  152. McLaunchLog("错误:" & GetExceptionDetail(ex))
  153. Log(ex, If(Loader.Input.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
  154. Throw
  155. End If
  156. End Try
  157. End Sub
  158. #End Region
  159. #Region "预检测"
  160. Private Sub McLaunchPrecheck()
  161. If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
  162. '检查路径
  163. If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McVersionCurrent.PathIndie & ")")
  164. If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McVersionCurrent.Path & ")")
  165. '检查版本
  166. If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本!")
  167. McVersionCurrent.Load()
  168. If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题:" & McVersionCurrent.Info)
  169. '检查输入信息
  170. Dim CheckResult As String = ""
  171. RunInUiWait(Sub()
  172. Dim LoginInput As McLoginData = McLoginInput()
  173. CheckResult = McLoginAble(LoginInput)
  174. If CheckResult = "" AndAlso
  175. LoginInput.Type = McLoginType.Legacy AndAlso '离线登录
  176. Not RegexCheck(CType(LoginInput, McLoginLegacy).UserName, "^[0-9A-Za-z_]+$") AndAlso
  177. McVersionCurrent.Version.McCodeMain >= 18 Then 'MC 1.18 以上
  178. CheckResult = "玩家名只能由数字、英文和下划线组成,不能包含中文或特殊字符!"
  179. End If
  180. End Sub)
  181. If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
  182. '求赞助
  183. If ThemeCheckGold() Then Exit Sub
  184. RunInNewThread(Sub()
  185. Select Case Setup.Get("SystemLaunchCount")
  186. Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000
  187. If MyMsgBox("PCL2 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
  188. "如果觉得 PCL2 还算好用的话,也可以考虑小小地赞助一下作者呢 qwq……" & vbCrLf &
  189. "毕竟一个人开发也不容易(小声)……",
  190. "求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
  191. OpenWebsite("https://afdian.net/@LTCat/plan")
  192. End If
  193. End Select
  194. End Sub, "Donate")
  195. End Sub
  196. #End Region
  197. #Region "主登录模块"
  198. '登录方式
  199. Public Enum McLoginType
  200. Legacy = 0
  201. Mojang = 1
  202. Nide = 2
  203. Auth = 3
  204. Ms = 5
  205. End Enum
  206. '各个登录方式的对应数据
  207. Public MustInherit Class McLoginData
  208. ''' <summary>
  209. ''' 登录方式。
  210. ''' </summary>
  211. Public Type As McLoginType
  212. Public Overrides Function Equals(obj As Object) As Boolean
  213. Return obj IsNot Nothing AndAlso obj.GetHashCode() = GetHashCode()
  214. End Function
  215. End Class
  216. Public Class McLoginServer
  217. Inherits McLoginData
  218. ''' <summary>
  219. ''' 登录用户名。
  220. ''' </summary>
  221. Public UserName As String
  222. ''' <summary>
  223. ''' 登录密码。
  224. ''' </summary>
  225. Public Password As String
  226. ''' <summary>
  227. ''' 登录服务器基础地址。
  228. ''' </summary>
  229. Public BaseUrl As String
  230. ''' <summary>
  231. ''' 登录所使用的标识符,如 “Mojang”、“Nide”,用于存储缓存等。
  232. ''' </summary>
  233. Public Token As String
  234. ''' <summary>
  235. ''' 登录方式的描述字符串,如 “正版”、“统一通行证”。
  236. ''' </summary>
  237. Public Description As String
  238. ''' <summary>
  239. ''' 是否在本次登录中强制要求玩家重新选择角色,目前仅对 Authlib-Injector 生效。
  240. ''' </summary>
  241. Public ForceReselectProfile As Boolean = False
  242. Public Sub New(Type As McLoginType)
  243. Me.Type = Type
  244. End Sub
  245. Public Overrides Function GetHashCode() As Integer
  246. Return GetHash(UserName & Password & BaseUrl & Token & Type) Mod Integer.MaxValue
  247. End Function
  248. End Class
  249. Public Class McLoginMs
  250. Inherits McLoginData
  251. ''' <summary>
  252. ''' 缓存的 OAuth Refresh Token。若没有则为空字符串。
  253. ''' </summary>
  254. Public OAuthRefreshToken As String = ""
  255. Public AccessToken As String = ""
  256. Public Uuid As String = ""
  257. Public UserName As String = ""
  258. Public ProfileJson As String = ""
  259. Public Sub New()
  260. Type = McLoginType.Ms
  261. End Sub
  262. Public Overrides Function GetHashCode() As Integer
  263. Return GetHash(OAuthRefreshToken & AccessToken & Uuid & UserName & ProfileJson) Mod Integer.MaxValue
  264. End Function
  265. End Class
  266. Public Class McLoginLegacy
  267. Inherits McLoginData
  268. ''' <summary>
  269. ''' 登录用户名。
  270. ''' </summary>
  271. Public UserName As String
  272. ''' <summary>
  273. ''' 皮肤种类。
  274. ''' </summary>
  275. Public SkinType As Integer
  276. ''' <summary>
  277. ''' 若采用正版皮肤,则为该皮肤名。
  278. ''' </summary>
  279. Public SkinName As String
  280. Public Sub New()
  281. Type = McLoginType.Legacy
  282. End Sub
  283. Public Overrides Function GetHashCode() As Integer
  284. Return GetHash(UserName & SkinType & SkinName & Type) Mod Integer.MaxValue
  285. End Function
  286. End Class
  287. '登录返回结果
  288. Public Structure McLoginResult
  289. Public Name As String
  290. Public Uuid As String
  291. Public AccessToken As String
  292. Public Type As String
  293. ''' <summary>
  294. ''' 仅用于登录方式为 Mojang 正版时的 Refresh Login,其余时间为一个无意义的 ID(一般为玩家的 UUID)。
  295. ''' </summary>
  296. Public ClientToken As String
  297. ''' <summary>
  298. ''' 用于登录的邮箱。仅用于登录方式为 Mojang 正版时的 launcher_profile 更新。
  299. ''' </summary>
  300. Public Email As String
  301. ''' <summary>
  302. ''' 进行微软登录时返回的 profile 信息。
  303. ''' </summary>
  304. Public ProfileJson As String
  305. End Structure
  306. ''' <summary>
  307. ''' 根据登录信息获取玩家的 MC 用户名。如果无法获取则返回 Nothing。
  308. ''' </summary>
  309. Public Function McLoginName() As String
  310. '根据当前登录方式优先返回
  311. Select Case Setup.Get("LoginType")
  312. Case McLoginType.Mojang
  313. If Setup.Get("CacheMojangName") <> "" Then Return Setup.Get("CacheMojangName")
  314. Case McLoginType.Ms
  315. If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
  316. Case McLoginType.Legacy
  317. If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0)
  318. Case McLoginType.Nide
  319. If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
  320. Case McLoginType.Auth
  321. If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
  322. End Select
  323. '查找所有可能的项
  324. If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
  325. If Setup.Get("CacheMojangName") <> "" Then Return Setup.Get("CacheMojangName")
  326. If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
  327. If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
  328. If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0)
  329. Return Nothing
  330. End Function
  331. ''' <summary>
  332. ''' 当前是否可以进行登录。若不可以则会返回错误原因。
  333. ''' </summary>
  334. Public Function McLoginAble() As String
  335. Select Case Setup.Get("LoginType")
  336. Case McLoginType.Mojang
  337. If Setup.Get("CacheMojangAccess") = "" Then
  338. Return FrmLoginMojang.IsVaild()
  339. Else
  340. Return ""
  341. End If
  342. Case McLoginType.Ms
  343. If Setup.Get("CacheMsOAuthRefresh") = "" Then
  344. Return FrmLoginMs.IsVaild()
  345. Else
  346. Return ""
  347. End If
  348. Case McLoginType.Legacy
  349. Return FrmLoginLegacy.IsVaild()
  350. Case McLoginType.Nide
  351. If Setup.Get("CacheNideAccess") = "" Then
  352. Return FrmLoginNide.IsVaild()
  353. Else
  354. Return ""
  355. End If
  356. Case McLoginType.Auth
  357. If Setup.Get("CacheAuthAccess") = "" Then
  358. Return FrmLoginAuth.IsVaild()
  359. Else
  360. Return ""
  361. End If
  362. Case Else
  363. Return "未知的登录方式"
  364. End Select
  365. End Function
  366. ''' <summary>
  367. ''' 登录输入是否可以进行登录。若不可以则会返回错误原因。
  368. ''' </summary>
  369. Public Function McLoginAble(LoginData As McLoginData) As String
  370. Select Case LoginData.Type
  371. Case McLoginType.Mojang
  372. Return PageLoginMojang.IsVaild(LoginData)
  373. Case McLoginType.Ms
  374. Return PageLoginMs.IsVaild(LoginData)
  375. Case McLoginType.Legacy
  376. Return PageLoginLegacy.IsVaild(LoginData)
  377. Case McLoginType.Nide
  378. Return PageLoginNide.IsVaild(LoginData)
  379. Case McLoginType.Auth
  380. Return PageLoginAuth.IsVaild(LoginData)
  381. Case Else
  382. Return "未知的登录方式"
  383. End Select
  384. End Function
  385. '登录主模块加载器
  386. Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
  387. Public Function McLoginInput() As McLoginData
  388. Dim LoginData As McLoginData = Nothing
  389. Dim LoginType As McLoginType = Setup.Get("LoginType")
  390. Try
  391. Select Case LoginType
  392. Case McLoginType.Legacy
  393. LoginData = PageLoginLegacy.GetLoginData()
  394. Case McLoginType.Mojang
  395. If Setup.Get("CacheMojangAccess") = "" Then
  396. LoginData = PageLoginMojang.GetLoginData()
  397. Else
  398. LoginData = PageLoginMojangSkin.GetLoginData()
  399. End If
  400. Case McLoginType.Ms
  401. If Setup.Get("CacheMsOAuthRefresh") = "" Then
  402. LoginData = PageLoginMs.GetLoginData()
  403. Else
  404. LoginData = PageLoginMsSkin.GetLoginData()
  405. End If
  406. Case McLoginType.Nide
  407. If Setup.Get("CacheNideAccess") = "" Then
  408. LoginData = PageLoginNide.GetLoginData()
  409. Else
  410. LoginData = PageLoginNideSkin.GetLoginData()
  411. End If
  412. Case McLoginType.Auth
  413. If Setup.Get("CacheAuthAccess") = "" Then
  414. LoginData = PageLoginAuth.GetLoginData()
  415. Else
  416. LoginData = PageLoginAuthSkin.GetLoginData()
  417. End If
  418. End Select
  419. Catch ex As Exception
  420. Log(ex, "获取登录输入信息失败(" & GetStringFromEnum(LoginType) & ")", LogLevel.Feedback)
  421. End Try
  422. Return LoginData
  423. End Function
  424. Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
  425. McLaunchLog("登录加载已开始")
  426. '校验登录信息
  427. Dim CheckResult As String = McLoginAble(Data.Input)
  428. If Not CheckResult = "" Then Throw New ArgumentException(CheckResult)
  429. '获取对应加载器
  430. Dim Loader As LoaderBase = Nothing
  431. Select Case Data.Input.Type
  432. Case McLoginType.Mojang
  433. Loader = McLoginMojangLoader
  434. Case McLoginType.Ms
  435. Loader = McLoginMsLoader
  436. Case McLoginType.Legacy
  437. If PageLinkHiper.HiperState = LoadState.Finished Then
  438. '使用 HiPer 内网验证
  439. Loader = McLoginHiperLoader
  440. Else
  441. '默认的离线验证
  442. Loader = McLoginLegacyLoader
  443. End If
  444. Case McLoginType.Nide
  445. Loader = McLoginNideLoader
  446. Case McLoginType.Auth
  447. Loader = McLoginAuthLoader
  448. End Select
  449. '尝试加载
  450. Loader.WaitForExit(Data.Input, McLoginLoader, Data.IsForceRestarting)
  451. Data.Output = CType(Loader, Object).Output
  452. RunInUi(Sub() FrmLaunchLeft.RefreshPage(True, False)) '刷新自动填充列表
  453. McLaunchLog("登录加载已结束")
  454. End Sub
  455. #End Region
  456. #Region "分方式登录模块"
  457. '各个登录方式的主对象与输入构造
  458. Public McLoginMojangLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Mojang", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
  459. Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000}
  460. Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
  461. Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
  462. Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
  463. Public McLoginHiperLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login HiPer", AddressOf McLoginHiperStart) With {.ReloadTimeout = 60000}
  464. '主加载函数,返回所有需要的登录信息
  465. Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
  466. Dim Input As McLoginMs = Data.Input
  467. Dim LogUsername As String = Input.UserName
  468. McLaunchLog("登录方式:微软正版(" & If(LogUsername = "", "尚未登录", LogUsername) & ")")
  469. Data.Progress = 0.05
  470. '检查是否已经登录完成
  471. If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then
  472. Data.Output = New McLoginResult With
  473. {.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
  474. GoTo SkipLogin
  475. End If
  476. '尝试登录
  477. Dim OAuthTokens As String()
  478. If Setup.Get("CacheMsOAuthRefresh") = "" Then
  479. '无 RefreshToken
  480. Relogin:
  481. Dim OAuthCode As String = MsLoginStep1(Data)
  482. If Data.IsAborted Then Throw New ThreadInterruptedException
  483. Data.Progress = 0.2
  484. OAuthTokens = MsLoginStep2(OAuthCode, False)
  485. Else
  486. '有 RefreshToken
  487. OAuthTokens = MsLoginStep2(Setup.Get("CacheMsOAuthRefresh"), True)
  488. End If
  489. '要求重新打开登录网页认证
  490. If OAuthTokens(0) = "Relogin" Then GoTo Relogin
  491. Data.Progress = 0.35
  492. If Data.IsAborted Then Throw New ThreadInterruptedException
  493. Dim OAuthAccessToken As String = OAuthTokens(0)
  494. Dim OAuthRefreshToken As String = OAuthTokens(1)
  495. Dim XBLToken As String = MsLoginStep3(OAuthAccessToken)
  496. Data.Progress = 0.5
  497. If Data.IsAborted Then Throw New ThreadInterruptedException
  498. Dim Tokens = MsLoginStep4(XBLToken)
  499. Data.Progress = 0.65
  500. If Data.IsAborted Then Throw New ThreadInterruptedException
  501. Dim AccessToken As String = MsLoginStep5(Tokens)
  502. Data.Progress = 0.8
  503. If Data.IsAborted Then Throw New ThreadInterruptedException
  504. Dim Result = MsLoginStep6(AccessToken)
  505. '输出登录结果
  506. Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
  507. Setup.Set("CacheMsAccess", AccessToken)
  508. Setup.Set("CacheMsUuid", Result(0))
  509. Setup.Set("CacheMsName", Result(1))
  510. Setup.Set("CacheMsProfileJson", Result(2))
  511. Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)}
  512. '解锁主题
  513. SkipLogin:
  514. McLaunchLog("微软登录完成")
  515. Data.Progress = 0.95
  516. If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
  517. End Sub
  518. Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
  519. Dim Input As McLoginServer = Data.Input
  520. Dim NeedRefresh As Boolean = False
  521. Dim LogUsername As String = Input.UserName
  522. If LogUsername.Contains("@") AndAlso Setup.Get("UiLauncherEmail") Then
  523. LogUsername = AccountFilter(LogUsername)
  524. End If
  525. McLaunchLog("登录方式:" & Input.Description & "(" & LogUsername & ")")
  526. Data.Progress = 0.05
  527. '尝试登录
  528. If (Not Data.Input.ForceReselectProfile) AndAlso Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso Not Setup.Get("Cache" & Input.Token & "Access") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Client") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Uuid") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Name") = "" Then
  529. '尝试验证登录
  530. Try
  531. If Data.IsAborted Then Throw New ThreadInterruptedException
  532. McLoginRequestValidate(Data)
  533. GoTo LoginFinish
  534. Catch ex As Exception
  535. Dim AllMessage = GetExceptionSummary(ex)
  536. McLaunchLog("验证登录失败:" & AllMessage)
  537. If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
  538. McLaunchLog("已触发超时登录失败")
  539. Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
  540. End If
  541. End Try
  542. Data.Progress = 0.25
  543. '尝试刷新登录
  544. Refresh:
  545. Try
  546. If Data.IsAborted Then Throw New ThreadInterruptedException
  547. McLoginRequestRefresh(Data, NeedRefresh)
  548. GoTo LoginFinish
  549. Catch ex As Exception
  550. McLaunchLog("刷新登录失败:" & GetExceptionSummary(ex))
  551. End Try
  552. Data.Progress = If(NeedRefresh, 0.85, 0.45)
  553. End If
  554. '尝试普通登录
  555. Try
  556. If Data.IsAborted Then Throw New ThreadInterruptedException
  557. NeedRefresh = McLoginRequestLogin(Data)
  558. Catch ex As Exception
  559. McLaunchLog("登录失败:" & GetExceptionSummary(ex))
  560. Throw
  561. End Try
  562. If NeedRefresh Then
  563. Data.Progress = 0.65
  564. GoTo Refresh
  565. End If
  566. LoginFinish:
  567. Data.Progress = 0.95
  568. '保存启动记录
  569. Dim Dict As New Dictionary(Of String, String)
  570. Dim Emails As New List(Of String)
  571. Dim Passwords As New List(Of String)
  572. Try
  573. If Not Setup.Get("Login" & Input.Token & "Email") = "" Then Emails.AddRange(Setup.Get("Login" & Input.Token & "Email").ToString.Split("¨"))
  574. If Not Setup.Get("Login" & Input.Token & "Pass") = "" Then Passwords.AddRange(Setup.Get("Login" & Input.Token & "Pass").ToString.Split("¨"))
  575. For i = 0 To Emails.Count - 1
  576. Dict.Add(Emails(i), Passwords(i))
  577. Next
  578. Dict.Remove(Input.UserName)
  579. Emails = New List(Of String)(Dict.Keys)
  580. Emails.Insert(0, Input.UserName)
  581. Passwords = New List(Of String)(Dict.Values)
  582. Passwords.Insert(0, Input.Password)
  583. Setup.Set("Login" & Input.Token & "Email", Join(Emails, "¨"))
  584. Setup.Set("Login" & Input.Token & "Pass", Join(Passwords, "¨"))
  585. Catch ex As Exception
  586. Log(ex, "保存启动记录失败", LogLevel.Hint)
  587. Setup.Set("Login" & Input.Token & "Email", "")
  588. Setup.Set("Login" & Input.Token & "Pass", "")
  589. End Try
  590. End Sub
  591. Private Sub McLoginLegacyStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult))
  592. Dim Input As McLoginLegacy = Data.Input
  593. McLaunchLog("登录方式:离线(" & Input.UserName & ")")
  594. Data.Progress = 0.1
  595. With Data.Output
  596. .Name = Input.UserName
  597. .Uuid = McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName)
  598. .Type = "Legacy"
  599. End With
  600. '将结果扩展到所有项目中
  601. 'Data.Output.AccessToken = Setup.Get("CacheMojangAccess") '不能优先使用缓存的 AccessToken,这会导致离线用户名设置失效
  602. 'If Data.Output.AccessToken.Length < 300 Then
  603. Data.Output.AccessToken = Data.Output.Uuid
  604. 'Data.Output.ClientToken = Setup.Get("CacheMojangClient")
  605. 'If Data.Output.AccessToken.Length <> 32 Then
  606. Data.Output.ClientToken = Data.Output.Uuid
  607. '保存启动记录
  608. Dim Names As New List(Of String)
  609. If Not Setup.Get("LoginLegacyName") = "" Then Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
  610. Names.Remove(Input.UserName)
  611. Names.Insert(0, Input.UserName)
  612. Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
  613. End Sub
  614. Private Sub McLoginHiperStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult))
  615. Dim Input As McLoginLegacy = Data.Input
  616. McLaunchLog("登录方式:联机离线(" & Input.UserName & ")")
  617. Data.Progress = 0.05
  618. '尝试登录
  619. Try
  620. McLaunchLog("登录开始(Login, HiPer)")
  621. Dim LoginJson As JObject = GetJson(NetRequestRetry(
  622. Url:="http://hiperauth.tech/api/yggdrasil-hiper/authserver/authenticate",
  623. Method:="POST",
  624. Data:="{""agent"": {""name"": ""Minecraft"",""version"": 1},""username"":""" & Data.Input.UserName & """,""password"":""" &
  625. McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName) & """,""requestUser"":true}",
  626. ContentType:="application/json; charset=utf-8"))
  627. '将登录结果输出
  628. Data.Output.AccessToken = LoginJson("accessToken").ToString
  629. Data.Output.ClientToken = LoginJson("clientToken").ToString
  630. Data.Output.Name = LoginJson("selectedProfile")("name").ToString
  631. Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString
  632. Data.Output.Type = "Auth"
  633. Data.Output.Email = Data.Input.UserName
  634. McLaunchLog("登录成功(Login, HiPer)")
  635. '保存启动记录
  636. Dim Names As New List(Of String)
  637. If Not Setup.Get("LoginLegacyName") = "" Then Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
  638. Names.Remove(Input.UserName)
  639. Names.Insert(0, Input.UserName)
  640. Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
  641. Catch ex As Exception
  642. Dim AllMessage As String = GetExceptionSummary(ex)
  643. Log(ex, "登录失败原始错误信息", LogLevel.Normal)
  644. Dim ThrowEx As Exception = ex
  645. If AllMessage.Contains("403") Then
  646. ThrowEx = New Exception("登录尝试过于频繁,导致被系统暂时屏蔽。请不要操作,等待 10 分钟后再试。", ex)
  647. ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
  648. ThrowEx = New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查 HiPer 联机模块的连接状况是否良好,或选择其他登录方式!")
  649. End If
  650. McLaunchLog("登录失败:" & GetExceptionSummary(ThrowEx))
  651. Throw ThrowEx
  652. End Try
  653. End Sub
  654. 'Server 登录:三种验证方式的请求
  655. Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult))
  656. McLaunchLog("验证登录开始(Validate, " & Data.Input.Token & ")")
  657. '提前缓存信息,否则如果在登录请求过程中退出登录,设置项目会被清空,导致输出存在空值
  658. Dim AccessToken As String = Setup.Get("Cache" & Data.Input.Token & "Access")
  659. Dim ClientToken As String = Setup.Get("Cache" & Data.Input.Token & "Client")
  660. Dim Uuid As String = Setup.Get("Cache" & Data.Input.Token & "Uuid")
  661. Dim Name As String = Setup.Get("Cache" & Data.Input.Token & "Name")
  662. '发送登录请求
  663. NetRequestRetry(
  664. Url:=Data.Input.BaseUrl & "/validate",
  665. Method:="POST",
  666. Data:="{""accessToken"":""" & AccessToken & """,""clientToken"":""" & ClientToken & """,""requestUser"":true}",
  667. ContentType:="application/json; charset=utf-8") '没有返回值的
  668. '将登录结果输出
  669. Data.Output.AccessToken = AccessToken
  670. Data.Output.ClientToken = ClientToken
  671. Data.Output.Uuid = Uuid
  672. Data.Output.Name = Name
  673. Data.Output.Type = Data.Input.Token
  674. Data.Output.Email = Data.Input.UserName
  675. '不更改缓存,直接结束
  676. McLaunchLog("验证登录成功(Validate, " & Data.Input.Token & ")")
  677. End Sub
  678. Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
  679. McLaunchLog("刷新登录开始(Refresh, " & Data.Input.Token & ")")
  680. Dim LoginJson As JObject = GetJson(NetRequestRetry(
  681. Url:=Data.Input.BaseUrl & "/refresh",
  682. Method:="POST",
  683. Data:="{" &
  684. If(RequestUser, "
  685. ""requestUser"": true,
  686. ""selectedProfile"": {
  687. ""id"":""" & Setup.Get("Cache" & Data.Input.Token & "Uuid") & """,
  688. ""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
  689. ""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
  690. ""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
  691. ContentType:="application/json; charset=utf-8"))
  692. '将登录结果输出
  693. If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!")
  694. Data.Output.AccessToken = LoginJson("accessToken").ToString
  695. Data.Output.ClientToken = LoginJson("clientToken").ToString
  696. Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString
  697. Data.Output.Name = LoginJson("selectedProfile")("name").ToString
  698. Data.Output.Type = Data.Input.Token
  699. Data.Output.Email = Data.Input.UserName
  700. '保存缓存
  701. Setup.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
  702. Setup.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
  703. Setup.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
  704. Setup.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
  705. Setup.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
  706. Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
  707. McLaunchLog("刷新登录成功(Refresh, " & Data.Input.Token & ")")
  708. End Sub
  709. Private Function McLoginRequestLogin(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) As Boolean
  710. Try
  711. Dim NeedRefresh As Boolean = False
  712. McLaunchLog("登录开始(Login, " & Data.Input.Token & ")")
  713. Dim LoginJson As JObject = GetJson(NetRequestRetry(
  714. Url:=Data.Input.BaseUrl & "/authenticate",
  715. Method:="POST",
  716. Data:="{""agent"": {""name"": ""Minecraft"",""version"": 1},""username"":""" & Data.Input.UserName & """,""password"":""" & Data.Input.Password & """,""requestUser"":true}",
  717. ContentType:="application/json; charset=utf-8"))
  718. '检查登录结果
  719. If LoginJson("availableProfiles").Count = 0 Then
  720. If Data.Input.Type = McLoginType.Auth Then
  721. If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Critical)
  722. Throw New Exception("$你还没有创建角色,请在创建角色后再试!")
  723. Else
  724. Throw New Exception("$你还没有购买 Minecraft 正版,请在购买后再试!")
  725. End If
  726. ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").Count = 1 Then
  727. Hint("你的账户中只有一个角色,无法更换!", HintType.Critical)
  728. End If
  729. Dim SelectedName As String = Nothing
  730. Dim SelectedId As String = Nothing
  731. If (LoginJson("selectedProfile") Is Nothing OrElse Data.Input.ForceReselectProfile) AndAlso LoginJson("availableProfiles").Count > 1 Then
  732. '要求选择档案;优先从缓存读取
  733. NeedRefresh = True
  734. Dim CacheId As String = Setup.Get("Cache" & Data.Input.Token & "Uuid")
  735. For Each Profile In LoginJson("availableProfiles")
  736. If Profile("id").ToString = CacheId Then
  737. SelectedName = Profile("name").ToString
  738. SelectedId = Profile("id").ToString
  739. McLaunchLog("根据缓存选择的角色:" & SelectedName)
  740. End If
  741. Next
  742. '缓存无效,要求玩家选择
  743. If SelectedName Is Nothing Then
  744. McLaunchLog("要求玩家选择角色")
  745. RunInUiWait(Sub()
  746. Dim SelectionControl As New List(Of IMyRadio)
  747. Dim SelectionJson As New List(Of JToken)
  748. For Each Profile In LoginJson("availableProfiles")
  749. SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString})
  750. SelectionJson.Add(Profile)
  751. Next
  752. Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色")
  753. SelectedName = SelectionJson(SelectedIndex)("name").ToString
  754. SelectedId = SelectionJson(SelectedIndex)("id").ToString
  755. End Sub)
  756. McLaunchLog("玩家选择的角色:" & SelectedName)
  757. End If
  758. Else
  759. SelectedName = LoginJson("selectedProfile")("name").ToString
  760. SelectedId = LoginJson("selectedProfile")("id").ToString
  761. End If
  762. '将登录结果输出
  763. Data.Output.AccessToken = LoginJson("accessToken").ToString
  764. Data.Output.ClientToken = LoginJson("clientToken").ToString
  765. Data.Output.Name = SelectedName
  766. Data.Output.Uuid = SelectedId
  767. Data.Output.Type = Data.Input.Token
  768. Data.Output.Email = Data.Input.UserName
  769. '保存缓存
  770. Setup.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
  771. Setup.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
  772. Setup.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
  773. Setup.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
  774. Setup.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
  775. Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
  776. McLaunchLog("登录成功(Login, " & Data.Input.Token & ")")
  777. Return NeedRefresh
  778. Catch ex As Exception
  779. Dim AllMessage As String = GetExceptionSummary(ex)
  780. Log(ex, "登录失败原始错误信息", LogLevel.Normal)
  781. If AllMessage.Contains("410") AndAlso AllMessage.Contains("Migrated") Then
  782. Throw New Exception("$登录失败:该 Mojang 账号已迁移至微软账号,请在上方的登录方式中选择 微软 并再次尝试登录!")
  783. ElseIf AllMessage.Contains("403") Then
  784. Select Case Data.Input.Type
  785. Case McLoginType.Auth
  786. Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
  787. " - 输入的账号或密码错误。" & vbCrLf &
  788. " - 登录尝试过于频繁,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
  789. " - 只注册了账号,但没有在皮肤站新建角色。")
  790. Case McLoginType.Legacy
  791. Throw
  792. Case McLoginType.Mojang
  793. If AllMessage.Contains("Invalid username or password") Then
  794. Throw New Exception("$登录失败:输入的账号或密码有误。")
  795. Else
  796. Throw New Exception("$登录尝试过于频繁,导致被 Mojang 暂时屏蔽。请不要操作,等待 10 分钟后再试。")
  797. End If
  798. Case McLoginType.Ms
  799. Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
  800. " - 登录尝试过于频繁,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
  801. " - 账号类别错误。如果你在使用 Mojang 账号,请将登录方式切换为 Mojang。")
  802. Case McLoginType.Nide
  803. Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
  804. " - 输入的账号或密码错误。" & vbCrLf &
  805. " - 密码错误次数过多,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
  806. If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号,而非游戏角色 ID。" & vbCrLf) &
  807. " - 只注册了账号,但没有加入对应服务器。")
  808. End Select
  809. ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
  810. Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
  811. ElseIf ex.Message.StartsWith("$") Then
  812. Throw
  813. Else
  814. Throw New Exception("登录失败:" & ex.Message, ex)
  815. End If
  816. Return False
  817. End Try
  818. End Function
  819. '微软登录步骤 1:打开网页认证,获取 OAuth Code
  820. Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
  821. McLaunchLog("开始微软登录步骤 1")
  822. If OsVersion <= New Version(10, 0, 17763, 0) Then
  823. SystemBrowser:
  824. 'Windows 7 或老版 Windows 10 登录
  825. OpenWebsite(FormLoginOAuth.LoginUrl1)
  826. Dim Result As String =
  827. MyMsgBoxInput("等待网页登录",
  828. "在登录成功后,网页会变成一片空白,请将该空白页面的网址复制到下面的框中。" & vbCrLf &
  829. "如果网络环境不佳,登录网页可能一直加载不出来,此时请尝试使用 VPN 或加速器,然后再试。",
  830. ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
  831. HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
  832. If Result Is Nothing Then
  833. McLaunchLog("微软登录已在步骤 1 被取消")
  834. Throw New ThreadInterruptedException("$$")
  835. Else
  836. Return RegexSeek(Result, "(?<=code\=)[^&]+")
  837. End If
  838. Hint("网页登录已完成,你现在可以关闭浏览器上的那个网页了", HintType.Finish)
  839. Else
  840. 'Windows 10 登录
  841. Dim ReturnCode As String = Nothing
  842. Dim ReturnEx As Exception = Nothing
  843. Dim IsFinished As LoadState = LoadState.Loading
  844. Dim LoginForm As FormLoginOAuth = Nothing
  845. Dim IsSwitchToSystemBrowser As Boolean = False
  846. RunInUi(Sub()
  847. Try
  848. LoginForm = New FormLoginOAuth
  849. LoginForm.Show()
  850. AddHandler LoginForm.OnLoginSuccess, Sub(Code As String)
  851. ReturnCode = Code
  852. IsFinished = LoadState.Finished
  853. End Sub
  854. AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean)
  855. IsFinished = LoadState.Aborted
  856. IsSwitchToSystemBrowser = IsSwitch
  857. End Sub
  858. Catch ex As Exception
  859. ReturnEx = ex
  860. IsFinished = LoadState.Failed
  861. End Try
  862. End Sub)
  863. Do While IsFinished = LoadState.Loading AndAlso Not Data.IsAborted
  864. Thread.Sleep(20)
  865. Loop
  866. RunInUi(Sub() If LoginForm IsNot Nothing Then LoginForm.Close())
  867. If IsFinished = LoadState.Finished Then
  868. Return ReturnCode
  869. ElseIf IsFinished = LoadState.Failed Then
  870. Throw ReturnEx
  871. ElseIf IsSwitchToSystemBrowser Then
  872. McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
  873. GoTo SystemBrowser
  874. Else
  875. McLaunchLog("微软登录已在步骤 1 被取消")
  876. Throw New ThreadInterruptedException("$$")
  877. End If
  878. End If
  879. End Function
  880. '微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
  881. Private Function MsLoginStep2(Code As String, IsRefresh As Boolean) As String()
  882. McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
  883. Dim Request As String
  884. If IsRefresh Then
  885. Request = "client_id=00000000402b5328" & "&" &
  886. "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
  887. "grant_type=refresh_token" & "&" &
  888. "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
  889. "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
  890. Else
  891. Request = "client_id=00000000402b5328" & "&" &
  892. "code=" & Uri.EscapeDataString(Code) & "&" &
  893. "grant_type=authorization_code" & "&" &
  894. "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
  895. "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
  896. End If
  897. Dim Result As String
  898. Try
  899. Result = NetRequestMuity("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1)
  900. Catch ex As Exception
  901. If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then 'Fix Hex-Dragon/PCL2#269
  902. Return {"Relogin", ""}
  903. Else
  904. Throw
  905. End If
  906. End Try
  907. Dim ResultJson As JObject = GetJson(Result)
  908. Dim AccessToken As String = ResultJson("access_token").ToString
  909. Dim RefreshToken As String = ResultJson("refresh_token").ToString
  910. Return {AccessToken, RefreshToken}
  911. End Function
  912. '微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken
  913. Private Function MsLoginStep3(AccessToken As String) As String
  914. McLaunchLog("开始微软登录步骤 3")
  915. Dim Request As String = "{
  916. ""Properties"": {
  917. ""AuthMethod"": ""RPS"",
  918. ""SiteName"": ""user.auth.xboxlive.com"",
  919. ""RpsTicket"": """ & AccessToken & """
  920. },
  921. ""RelyingParty"": ""http://auth.xboxlive.com"",
  922. ""TokenType"": ""JWT""
  923. }"
  924. Dim Result As String = NetRequestMuity("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
  925. Dim ResultJson As JObject = GetJson(Result)
  926. Dim XBLToken As String = ResultJson("Token").ToString
  927. Return XBLToken
  928. End Function
  929. '微软登录步骤 4:从 XBLToken 获取 {XSTSToken, UHS}
  930. Private Function MsLoginStep4(XBLToken As String) As String()
  931. McLaunchLog("开始微软登录步骤 4")
  932. Dim Request As String = "{
  933. ""Properties"": {
  934. ""SandboxId"": ""RETAIL"",
  935. ""UserTokens"": [
  936. """ & XBLToken & """
  937. ]
  938. },
  939. ""RelyingParty"": ""rp://api.minecraftservices.com/"",
  940. ""TokenType"": ""JWT""
  941. }"
  942. Dim Result As String
  943. Try
  944. Result = NetRequestMuity("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
  945. Catch ex As Net.WebException
  946. If ex.Message.Contains("2148916233") Then
  947. If MyMsgBox("该微软账号尚未购买 Minecraft Java 版,或尚未注册 XBox 账户。" & vbCrLf &
  948. "如果你确定该账号完成了上述步骤,请先在游戏官网登录一次,然后再在启动器登录。", "登录提示", "打开游戏官网", "取消") = 1 Then
  949. OpenWebsite("https://www.minecraft.net/")
  950. End If
  951. Throw New Exception("$$")
  952. ElseIf ex.Message.Contains("2148916238") Then
  953. If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
  954. "该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
  955. OpenWebsite("https://account.live.com/editprof.aspx")
  956. MyMsgBox("请在打开的网页中修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
  957. "在修改成功后等待一分钟,然后再回到 PCL2,就可以正常登录了!", "登录提示")
  958. Else
  959. OpenWebsite("https://support.microsoft.com/zh-cn/account-billing/如何更改-microsoft-帐户上的出生日期-837badbc-999e-54d2-2617-d19206b9540a")
  960. MyMsgBox("请根据打开的网页的说明,修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
  961. "在修改成功后等待一分钟,然后再回到 PCL2,就可以正常登录了!", "登录提示")
  962. End If
  963. Throw New Exception("$$")
  964. Else
  965. Throw
  966. End If
  967. End Try
  968. Dim ResultJson As JObject = GetJson(Result)
  969. Dim XSTSToken As String = ResultJson("Token").ToString
  970. Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
  971. Return {XSTSToken, UHS}
  972. End Function
  973. '微软登录步骤 5:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
  974. Private Function MsLoginStep5(Tokens As String()) As String
  975. McLaunchLog("开始微软登录步骤 5")
  976. Dim Request As String = "{""identityToken"": ""XBL3.0 x=" & Tokens(1) & ";" & Tokens(0) & """}"
  977. Dim Result As String
  978. Try
  979. Result = NetRequestMuity("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
  980. Catch ex As Net.WebException
  981. Dim Message As String = GetExceptionSummary(ex)
  982. If Message.Contains("(429)") Then
  983. Log(ex, "微软登录第 5 步汇报 429")
  984. Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
  985. ElseIf Message.Contains("(403)") Then
  986. Log(ex, "微软登录第 5 步汇报 403")
  987. Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器,请把它们关掉或更换节点后再试!")
  988. Else
  989. Throw
  990. End If
  991. End Try
  992. Dim ResultJson As JObject = GetJson(Result)
  993. Dim AccessToken As String = ResultJson("access_token").ToString
  994. Return AccessToken
  995. End Function
  996. '微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
  997. Private Function MsLoginStep6(AccessToken As String) As String()
  998. McLaunchLog("开始微软登录步骤 6")
  999. Dim Result As String
  1000. Try
  1001. Result = NetRequestMuity("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
  1002. Catch ex As Net.WebException
  1003. Dim Message As String = GetExceptionSummary(ex)
  1004. If Message.Contains("(429)") Then
  1005. Log(ex, "微软登录第 6 步汇报 429")
  1006. Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
  1007. ElseIf Message.Contains("(404)") Then
  1008. Log(ex, "微软登录第 6 步汇报 404")
  1009. RunInNewThread(Sub()
  1010. Select Case MyMsgBox("你可能没有在 Minecraft 官网创建档案,或者没有购买 Minecraft。" & vbCrLf &
  1011. "如果你已经购买了游戏,请在官网上创建档案后再试。", "登录失败", "创建档案", "购买 Minecraft", "取消")
  1012. Case 1
  1013. OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
  1014. Case 2
  1015. OpenWebsite("https://www.minecraft.net/store/checkout/minecraft-java-bedrock-edition-pc")
  1016. End Select
  1017. End Sub, "Login Failed: Create Profile")
  1018. Throw New Exception("$$")
  1019. Else
  1020. Throw
  1021. End If
  1022. End Try
  1023. Dim ResultJson As JObject = GetJson(Result)
  1024. Dim UUID As String = ResultJson("id").ToString
  1025. Dim UserName As String = ResultJson("name").ToString
  1026. Return {UUID, UserName, Result}
  1027. End Function
  1028. '返回符合离线皮肤设置的 UUID
  1029. Private Function McLoginLegacyUuidWithCustomSkin(UserName As String, SkinType As Integer, SkinName As String) As String
  1030. Dim Uuid As String = McLoginLegacyUuid(UserName)
  1031. '根据离线皮肤获取实际使用的 Uuid
  1032. Select Case SkinType
  1033. Case 0
  1034. '默认,不需要处理
  1035. Case 1
  1036. 'Steve
  1037. Do Until McSkinSex(Uuid) = "Steve"
  1038. If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
  1039. Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
  1040. Loop
  1041. Case 2
  1042. 'Alex
  1043. Do Until McSkinSex(Uuid) = "Alex"
  1044. If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
  1045. Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
  1046. Loop
  1047. Case 3
  1048. '使用正版用户名
  1049. Try
  1050. If Not SkinName = "" Then
  1051. Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
  1052. Uuid = McLoginMojangUuid(SkinName, False)
  1053. End If
  1054. Catch ex As Exception
  1055. Log(ex, "离线启动时使用的正版皮肤获取失败")
  1056. MyMsgBox("由于设置的离线启动时使用的正版皮肤获取失败,游戏将以无皮肤的方式启动。" & vbCrLf & "请检查你的网络是否通畅,或尝试使用 VPN!" & vbCrLf & vbCrLf & "详细的错误信息:" & ex.Message, "皮肤获取失败")
  1057. End Try
  1058. Case 4
  1059. '自定义
  1060. Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
  1061. If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
  1062. Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
  1063. Loop
  1064. End Select
  1065. Return Uuid
  1066. End Function
  1067. '根据用户名返回对应 UUID,需要多线程
  1068. Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean)
  1069. If Name.Trim.Length = 0 Then Return StrFill("", "0", 32)
  1070. '从缓存获取
  1071. Dim Uuid As String = ReadIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, "")
  1072. If Len(Uuid) = 32 Then Return Uuid
  1073. '从官网获取
  1074. Try
  1075. Dim GotJson As JObject = NetGetCodeByRequestRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, IsJson:=True)
  1076. If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在(" & Name & ")")
  1077. Uuid = If(GotJson("id"), "")
  1078. Catch ex As Exception
  1079. Log(ex, "从官网获取正版 Uuid 失败(" & Name & ")")
  1080. If Not ThrowOnNotFound AndAlso ex.GetType.Name = "FileNotFoundException" Then
  1081. Uuid = McLoginLegacyUuid(Name) '玩家档案不存在
  1082. Else
  1083. Throw New Exception("从官网获取正版 Uuid 失败", ex)
  1084. End If
  1085. End Try
  1086. '写入缓存
  1087. If Not Len(Uuid) = 32 Then Throw New Exception("获取的正版 Uuid 长度不足(" & Uuid & ")")
  1088. WriteIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, Uuid)
  1089. Return Uuid
  1090. End Function
  1091. Public Function McLoginLegacyUuid(Name As String)
  1092. Dim FullUuid As String = StrFill(Name.Length.ToString("X"), "0", 16) & StrFill(GetHash(Name).ToString("X"), "0", 16)
  1093. Return FullUuid.Substring(0, 12) & "3" & FullUuid.Substring(13, 3) & "9" & FullUuid.Substring(17, 15)
  1094. End Function
  1095. #End Region
  1096. #Region "Java 处理"
  1097. Private McLaunchJavaSelected As JavaEntry = Nothing
  1098. Private Sub McLaunchJavaValidate(Task As LoaderTask(Of Integer, List(Of NetFile)))
  1099. Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
  1100. 'MC 大版本检测
  1101. If (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
  1102. (McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
  1103. '1.18 pre2+:至少 Java 17
  1104. MinVer = New Version(1, 17, 0, 0)
  1105. ElseIf (McVersionCurrent.ReleaseTime >= New Date(2021, 5, 11) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
  1106. (McVersionCurrent.Version.McCodeMain >= 17 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
  1107. '1.17+ (21w19a+):至少 Java 16
  1108. MinVer = New Version(1, 16, 0, 0)
  1109. ElseIf McVersionCurrent.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了
  1110. '1.12+:至少 Java 8
  1111. MinVer = New Version(1, 8, 0, 0)
  1112. ElseIf McVersionCurrent.ReleaseTime <= New Date(2013, 5, 1) AndAlso McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本的 1960 癌
  1113. '1.5.2-:最高 Java 12
  1114. MaxVer = New Version(1, 12, 999, 999)
  1115. End If
  1116. 'OptiFine 检测
  1117. If McVersionCurrent.Version.HasOptiFine Then
  1118. If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
  1119. '<1.7:至多 Java 8(Java 9 - 10 未测试)
  1120. MaxVer = New Version(1, 8, 999, 999)
  1121. ElseIf McVersionCurrent.Version.McCodeMain >= 8 AndAlso McVersionCurrent.Version.McCodeMain <= 11 Then
  1122. '1.8 - 1.11:必须恰好 Java 8(Java 9 - 10 未测试)
  1123. MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
  1124. End If
  1125. End If
  1126. 'Forge 检测
  1127. If McVersionCurrent.Version.HasForge Then
  1128. If McVersionCurrent.Version.McName = "1.7.2" Then
  1129. '1.7.2:必须 Java 7
  1130. MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999)
  1131. ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then
  1132. '<1.12,Forge 14.23.5.2855 及更低:Java 8
  1133. MaxVer = New Version(1, 8, 999, 999)
  1134. ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then
  1135. '1.13 - 1.14,Forge 28.2.23 及更低:Java 8 - 10
  1136. MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
  1137. ElseIf McVersionCurrent.Version.McCodeMain <= 15 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
  1138. '1.15:Java 8 - 15
  1139. MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
  1140. ElseIf VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then
  1141. '1.16.X,Forge 34.X ~ 36.2.25:最高 Java 8u320
  1142. MaxVer = New Version(1, 8, 0, 320)
  1143. ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
  1144. '1.18+:若安装了 OptiFine,最高 Java 18
  1145. MaxVer = New Version(1, 18, 999, 999)
  1146. End If
  1147. End If
  1148. 'Fabric 检测
  1149. If McVersionCurrent.Version.HasFabric Then
  1150. If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
  1151. '1.15 - 1.16:Java 8 - 19
  1152. MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 19, 999, 999)
  1153. ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
  1154. '1.18+:Java 17 - 19
  1155. MinVer = New Version(1, 17, 0, 0) : MaxVer = New Version(1, 19, 999, 999)
  1156. End If
  1157. End If
  1158. '统一通行证检测
  1159. If Setup.Get("LoginType") = McLoginType.Nide Then
  1160. '至少 Java 8u101
  1161. MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer)
  1162. End If
  1163. '选择 Java
  1164. McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
  1165. McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
  1166. If Task.IsAborted Then Exit Sub
  1167. If McLaunchJavaSelected IsNot Nothing Then
  1168. McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
  1169. Exit Sub
  1170. End If
  1171. '无合适的 Java
  1172. If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
  1173. McLaunchLog("无合适的 Java,取消启动")
  1174. If MinVer >= New Version(1, 17, 0, 0) Then
  1175. '缺少 Java 17
  1176. JavaMissing(17)
  1177. ElseIf MinVer >= New Version(1, 16, 0, 0) Then
  1178. '缺少 Java 16
  1179. JavaMissing(16)
  1180. ElseIf MaxVer < New Version(1, 8, 0, 0) Then
  1181. '缺少 Java 7
  1182. JavaMissing(7)
  1183. Else
  1184. '缺少 Java 8 较新版
  1185. JavaMissing(8)
  1186. End If
  1187. Throw New Exception("$$")
  1188. End Sub
  1189. #End Region
  1190. #Region "启动参数"
  1191. Private McLaunchArgument As String
  1192. ''' <summary>
  1193. ''' 释放 Java Wrapper 并返回完整文件路径。
  1194. ''' </summary>
  1195. Public Function ExtractJavaWrapper() As String
  1196. Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
  1197. WriteFile(WrapperPath, GetResources("JavaWrapper"))
  1198. Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
  1199. Return WrapperPath
  1200. End Function
  1201. ''' <summary>
  1202. ''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
  1203. ''' </summary>
  1204. Public Function GetJavaWrapperDir() As String
  1205. If Encoding.UTF8.GetByteCount(PathAppdata) = PathAppdata.Length Then
  1206. Return PathAppdata.TrimEnd("\")
  1207. ElseIf Encoding.UTF8.GetByteCount(PathTemp) = PathTemp.Length Then
  1208. Log("[Java] Wrapper:AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
  1209. Return PathTemp.TrimEnd("\")
  1210. Else
  1211. Log("[Java] Wrapper:AppData 路径与 Temp 路径中均包含非 ASCII 字符,换用 ProgramData 目录")
  1212. Return OsDrive & "ProgramData\PCL"
  1213. End If
  1214. End Function
  1215. '主方法,合并 Jvm、Game、Replace 三部分的参数数据
  1216. Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, List(Of McLibToken)))
  1217. McLaunchLog("开始获取 Minecraft 启动参数")
  1218. '获取基准字符串与参数信息
  1219. Dim Arguments As String
  1220. If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("jvm") IsNot Nothing Then
  1221. McLaunchLog("获取新版 JVM 参数")
  1222. Arguments = McLaunchArgumentsJvmNew(McVersionCurrent)
  1223. McLaunchLog("新版 JVM 参数获取成功:")
  1224. McLaunchLog(Arguments)
  1225. Else
  1226. McLaunchLog("获取旧版 JVM 参数")
  1227. Arguments = McLaunchArgumentsJvmOld(McVersionCurrent)
  1228. McLaunchLog("旧版 JVM 参数获取成功:")
  1229. McLaunchLog(Arguments)
  1230. End If
  1231. If Not String.IsNullOrEmpty(McVersionCurrent.JsonObject("minecraftArguments")) Then '有的版本是空字符串
  1232. McLaunchLog("获取旧版 Game 参数")
  1233. Arguments += " " & McLaunchArgumentsGameOld(McVersionCurrent)
  1234. McLaunchLog("旧版 Game 参数获取成功")
  1235. End If
  1236. If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("game") IsNot Nothing Then
  1237. McLaunchLog("获取新版 Game 参数")
  1238. Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent)
  1239. McLaunchLog("新版 Game 参数获取成功")
  1240. End If
  1241. '替换参数
  1242. Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
  1243. If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
  1244. '若自定义信息为空,则去掉该部分
  1245. Arguments = Arguments.Replace(" --versionType ${version_type}", "")
  1246. ReplaceArguments("${version_type}") = """"""
  1247. End If
  1248. For Each entry As KeyValuePair(Of String, String) In ReplaceArguments
  1249. Arguments = Arguments.Replace(entry.Key, If(entry.Value.Contains(" ") OrElse entry.Value.Contains(":\"), """" & entry.Value & """", entry.Value))
  1250. Next
  1251. 'MJSB
  1252. Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""")
  1253. '全屏
  1254. If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
  1255. '进服
  1256. Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp)
  1257. If Server.Length > 0 Then
  1258. If Server.Contains(":") Then
  1259. '包含端口号
  1260. Arguments += " --server " & Server.Split(":")(0) & " --port " & Server.Split(":")(1)
  1261. Else
  1262. '不包含端口号
  1263. Arguments += " --server " & Server & " --port 25565"
  1264. End If
  1265. 'OptiFine 警告
  1266. If McVersionCurrent.Version.HasOptiFine Then
  1267. Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Critical)
  1268. End If
  1269. End If
  1270. '自定义
  1271. Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Version:=McVersionCurrent)
  1272. Arguments += " " & If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame)
  1273. '输出
  1274. McLaunchLog("Minecraft 启动参数:")
  1275. McLaunchLog(Arguments.Replace(McLoginLoader.Output.AccessToken, McLoginLoader.Output.AccessToken.Substring(0, 22) & "[数据删除]" & McLoginLoader.Output.AccessToken.Substring(30)))
  1276. McLaunchArgument = Arguments
  1277. End Sub
  1278. 'Jvm 部分(第一段)
  1279. Private Function McLaunchArgumentsJvmOld(Version As McVersion) As String
  1280. '存储以空格为间隔的启动参数列表
  1281. Dim DataList As New List(Of String)
  1282. '输出固定参数
  1283. DataList.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump")
  1284. Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
  1285. If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
  1286. If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
  1287. DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
  1288. DataList.Add("-Xmn256m")
  1289. DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
  1290. DataList.Add("""-Djava.library.path=" & Version.Path & Version.Name & "-natives""")
  1291. DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
  1292. '统一通行证
  1293. If McLoginLoader.Output.Type = "Nide" Then
  1294. DataList.Insert(0, "-Dnide8auth.client=true -javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
  1295. End If
  1296. 'Authlib-Injector
  1297. If McLoginLoader.Output.Type = "Auth" Then
  1298. Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
  1299. "http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
  1300. Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
  1301. Try
  1302. Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
  1303. DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
  1304. " -Dauthlibinjector.side=client" &
  1305. " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
  1306. Catch ex As Exception
  1307. Throw New Exception("无法连接到第三方登录服务器(" & If(Server, Nothing) & ")", ex)
  1308. End Try
  1309. End If
  1310. '添加 Java Wrapper 作为主 Jar
  1311. If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
  1312. DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
  1313. DataList.Add("-jar """ & ExtractJavaWrapper() & """")
  1314. '添加 MainClass
  1315. If Version.JsonObject("mainClass") Is Nothing Then
  1316. Throw New Exception("版本 Json 中没有 mainClass 项!")
  1317. Else
  1318. DataList.Add(Version.JsonObject("mainClass"))
  1319. End If
  1320. Return Join(DataList, " ")
  1321. End Function
  1322. Private Function McLaunchArgumentsJvmNew(Version As McVersion) As String
  1323. Dim DataList As New List(Of String)
  1324. '获取 Json 中的 DataList
  1325. Dim CurrentVersion As McVersion = Version
  1326. NextVersion:
  1327. If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("jvm") IsNot Nothing Then
  1328. For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("jvm")
  1329. If SubJson.Type = JTokenType.String Then
  1330. '字符串类型
  1331. DataList.Add(SubJson.ToString)
  1332. Else
  1333. '非字符串类型
  1334. If McJsonRuleCheck(SubJson("rules")) Then
  1335. '满足准则
  1336. If SubJson("value").Type = JTokenType.String Then
  1337. DataList.Add(SubJson("value").ToString)
  1338. Else
  1339. For Each value As JToken In SubJson("value")
  1340. DataList.Add(value.ToString)
  1341. Next
  1342. End If
  1343. End If
  1344. End If
  1345. Next
  1346. End If
  1347. If CurrentVersion.InheritVersion <> "" Then
  1348. CurrentVersion = New McVersion(CurrentVersion.InheritVersion)
  1349. GoTo NextVersion
  1350. End If
  1351. '内存、Log4j 防御参数等
  1352. SecretLaunchJvmArgs(DataList)
  1353. '统一通行证
  1354. If McLoginLoader.Output.Type = "Nide" Then
  1355. DataList.Insert(0, "-javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
  1356. End If
  1357. 'Authlib-Injector
  1358. If McLoginLoader.Output.Type = "Auth" Then
  1359. Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
  1360. "http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
  1361. Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
  1362. Try
  1363. Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
  1364. DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
  1365. " -Dauthlibinjector.side=client" &
  1366. " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
  1367. Catch ex As Exception
  1368. Throw New Exception("无法连接到第三方登录服务器(" & If(Server, Nothing) & ")", ex)
  1369. End Try
  1370. End If
  1371. '添加 Java Wrapper 作为主 Jar
  1372. If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
  1373. DataList.Insert(0, "-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
  1374. DataList.Add("-jar """ & ExtractJavaWrapper() & """")
  1375. '将 "-XXX" 与后面 "XXX" 合并到一起
  1376. '如果不合并,会导致 Forge 1.17 启动无效,它有两个 --add-exports,进一步导致其中一个在后面被去重
  1377. Dim DeDuplicateDataList As New List(Of String)
  1378. For i = 0 To DataList.Count - 1
  1379. Dim CurrentEntry As String = DataList(i)
  1380. If DataList(i).StartsWith("-") Then
  1381. Do While i < DataList.Count - 1
  1382. If DataList(i + 1).StartsWith("-") Then
  1383. Exit Do
  1384. Else
  1385. i += 1
  1386. CurrentEntry += " " + DataList(i)
  1387. End If
  1388. Loop
  1389. End If
  1390. DeDuplicateDataList.Add(CurrentEntry.Trim.Replace("McEmu= ", "McEmu="))
  1391. Next
  1392. '去重
  1393. Dim Result As String = Join(ArrayNoDouble(DeDuplicateDataList), " ")
  1394. '添加 MainClass
  1395. If Version.JsonObject("mainClass") Is Nothing Then
  1396. Throw New Exception("版本 Json 中没有 mainClass 项!")
  1397. Else
  1398. Result += " " & Version.JsonObject("mainClass").ToString
  1399. End If
  1400. Return Result
  1401. End Function
  1402. 'Game 部分(第二段)
  1403. Private Function McLaunchArgumentsGameOld(Version As McVersion) As String
  1404. Dim DataList As New List(Of String)
  1405. '本地化 Minecraft 启动信息
  1406. Dim BasicString As String = Version.JsonObject("minecraftArguments").ToString
  1407. If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
  1408. DataList.Add(BasicString)
  1409. Dim Result As String = Join(DataList, " ")
  1410. '特别改变 OptiFineTweaker
  1411. If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
  1412. '把 OptiFineForgeTweaker 放在最后,不然会导致崩溃!
  1413. If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
  1414. Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & Result)
  1415. Result = Result.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
  1416. End If
  1417. If Result.Contains("--tweakClass optifine.OptiFineTweaker") Then
  1418. Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & Result)
  1419. Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
  1420. Try
  1421. WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
  1422. Catch ex As Exception
  1423. Log(ex, "替换 OptiFineForge TweakClass 失败")
  1424. End Try
  1425. End If
  1426. End If
  1427. Return Result
  1428. End Function
  1429. Private Function McLaunchArgumentsGameNew(Version As McVersion) As String
  1430. Dim DataList As New List(Of String)
  1431. '获取 Json 中的 DataList
  1432. Dim CurrentVersion As McVersion = Version
  1433. NextVersion:
  1434. If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("game") IsNot Nothing Then
  1435. For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("game")
  1436. If SubJson.Type = JTokenType.String Then
  1437. '字符串类型
  1438. DataList.Add(SubJson.ToString)
  1439. Else
  1440. '非字符串类型
  1441. If McJsonRuleCheck(SubJson("rules")) Then
  1442. '满足准则
  1443. If SubJson("value").Type = JTokenType.String Then
  1444. DataList.Add(SubJson("value").ToString)
  1445. Else
  1446. For Each value As JToken In SubJson("value")
  1447. DataList.Add(value.ToString)
  1448. Next
  1449. End If
  1450. End If
  1451. End If
  1452. Next
  1453. End If
  1454. If CurrentVersion.InheritVersion <> "" Then
  1455. CurrentVersion = New McVersion(CurrentVersion.InheritVersion)
  1456. GoTo NextVersion
  1457. End If
  1458. '将 "-XXX" 与后面 "XXX" 合并到一起
  1459. '如果不进行合并 Impact 会启动无效,它有两个 --tweakclass
  1460. Dim DeDuplicateDataList As New List(Of String)
  1461. For i = 0 To DataList.Count - 1
  1462. Dim CurrentEntry As String = DataList(i)
  1463. If DataList(i).StartsWith("-") Then
  1464. Do While i < DataList.Count - 1
  1465. If DataList(i + 1).StartsWith("-") Then
  1466. Exit Do
  1467. Else
  1468. i += 1
  1469. CurrentEntry += " " + DataList(i)
  1470. End If
  1471. Loop
  1472. End If
  1473. DeDuplicateDataList.Add(CurrentEntry)
  1474. Next
  1475. '去重
  1476. McLaunchArgumentsGameNew = Join(ArrayNoDouble(DeDuplicateDataList), " ")
  1477. '特别改变 OptiFineTweaker
  1478. If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
  1479. '把 OptiFineForgeTweaker 放在最后,不然会导致崩溃!
  1480. If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
  1481. Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameNew)
  1482. McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
  1483. End If
  1484. If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineTweaker") Then
  1485. Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameNew)
  1486. McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
  1487. Try
  1488. WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
  1489. Catch ex As Exception
  1490. Log(ex, "替换 OptiFineForge TweakClass 失败")
  1491. End Try
  1492. End If
  1493. End If
  1494. End Function
  1495. '替换 Arguments
  1496. Private Function McLaunchArgumentsReplace(Version As McVersion, ByRef Loader As LoaderTask(Of String, List(Of McLibToken))) As Dictionary(Of String, String)
  1497. Dim GameArguments As New Dictionary(Of String, String)
  1498. '基础参数
  1499. GameArguments.Add("${classpath_separator}", ";")
  1500. GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives")
  1501. GameArguments.Add("${library_directory}", PathMcFolder & "libraries")
  1502. GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries")
  1503. GameArguments.Add("${launcher_name}", "PCL2")
  1504. GameArguments.Add("${launcher_version}", VersionCode)
  1505. GameArguments.Add("${version_name}", Version.Name)
  1506. Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
  1507. GameArguments.Add("${version_type}", If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo))
  1508. GameArguments.Add("${game_directory}", Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1))
  1509. GameArguments.Add("${assets_root}", PathMcFolder & "assets")
  1510. GameArguments.Add("${user_properties}", "{}")
  1511. GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name)
  1512. GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid)
  1513. GameArguments.Add("${auth_access_token}", McLoginLoader.Output.AccessToken)
  1514. GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
  1515. GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
  1516. GameArguments.Add("${user_type}", If(McLoginLoader.Output.Type = "Legacy", "Legacy", "Mojang"))
  1517. Dim GameSize As Size = Setup.GetLaunchArgumentWindowSize()
  1518. GameArguments.Add("${resolution_width}", GameSize.Width)
  1519. GameArguments.Add("${resolution_height}", GameSize.Height)
  1520. 'Assets 相关参数
  1521. GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
  1522. GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))
  1523. '支持库参数
  1524. Dim LibList As List(Of McLibToken) = McLibListGet(Version, True)
  1525. Loader.Output = LibList
  1526. Dim CpStrings As New List(Of String)
  1527. Dim OptiFineCp As String = Nothing
  1528. For Each Library As McLibToken In LibList
  1529. If Library.IsNatives Then Continue For
  1530. If Library.Name IsNot Nothing AndAlso Library.Name = "optifine:OptiFine" Then
  1531. OptiFineCp = Library.LocalPath
  1532. Else
  1533. CpStrings.Add(Library.LocalPath)
  1534. End If
  1535. Next
  1536. If OptiFineCp IsNot Nothing Then CpStrings.Insert(CpStrings.Count - 2, OptiFineCp)
  1537. GameArguments.Add("${classpath}", Join(CpStrings, ";"))
  1538. Return GameArguments
  1539. End Function
  1540. #End Region
  1541. #Region "解压 Natives"
  1542. Private Sub McLaunchNatives(Loader As LoaderTask(Of List(Of McLibToken), Integer))
  1543. '创建文件夹
  1544. Directory.CreateDirectory(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
  1545. '解压文件
  1546. McLaunchLog("正在解压 Natives 文件")
  1547. Dim ExistFiles As New List(Of String)
  1548. For Each Native As McLibToken In Loader.Input
  1549. If Not Native.IsNatives Then Continue For
  1550. Dim Zip As ZipArchive
  1551. Try
  1552. Zip = New ZipArchive(New FileStream(Native.LocalPath, FileMode.Open))
  1553. Catch ex As InvalidDataException
  1554. Log(ex, "打开 Natives 文件失败(" & Native.LocalPath & ")")
  1555. File.Delete(Native.LocalPath)
  1556. Throw New Exception("无法打开 Natives 文件(" & Native.LocalPath & "),该文件可能已损坏,请重新尝试启动游戏")
  1557. End Try
  1558. For Each Entry In Zip.Entries
  1559. Dim FileName As String = Entry.FullName
  1560. If FileName.EndsWith(".dll") Then
  1561. '实际解压文件的步骤
  1562. Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName
  1563. ExistFiles.Add(FilePath)
  1564. Dim OriginalFile As New FileInfo(FilePath)
  1565. If OriginalFile.Exists Then
  1566. If OriginalFile.Length = Entry.Length Then
  1567. If ModeDebug Then McLaunchLog("无需解压:" & FilePath)
  1568. Continue For
  1569. End If
  1570. '删除原文件
  1571. Try
  1572. File.Delete(FilePath)
  1573. Catch ex As UnauthorizedAccessException
  1574. McLaunchLog("删除原 dll 访问被拒绝,这通常代表有一个 MC 正在运行,跳过解压:" & FilePath)
  1575. McLaunchLog("实际的错误信息:" & GetExceptionSummary(ex))
  1576. Exit For
  1577. End Try
  1578. End If
  1579. '解压新文件
  1580. WriteFile(FilePath, Entry.Open)
  1581. McLaunchLog("已解压:" & FilePath)
  1582. End If
  1583. Next
  1584. If Zip IsNot Nothing Then Zip.Dispose()
  1585. Next
  1586. '删除多余文件
  1587. For Each FileName As String In Directory.GetFiles(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
  1588. If ExistFiles.Contains(FileName) Then Continue For
  1589. Try
  1590. McLaunchLog("删除:" & FileName)
  1591. File.Delete(FileName)
  1592. Catch ex As UnauthorizedAccessException
  1593. McLaunchLog("删除多余文件访问被拒绝,跳过删除步骤")
  1594. McLaunchLog("实际的错误信息:" & GetExceptionSummary(ex))
  1595. Exit Sub
  1596. End Try
  1597. Next
  1598. End Sub
  1599. #End Region
  1600. #Region "启动与前后处理"
  1601. Private Sub McLaunchPrerun()
  1602. '更新 launcher_profiles.json
  1603. Try
  1604. '确保可用
  1605. If Not (McLoginLoader.Output.Type = "Mojang" OrElse McLoginLoader.Output.Type = "Microsoft") Then Exit Try
  1606. McFolderLauncherProfilesJsonCreate(PathMcFolder)
  1607. '构建需要替换的 Json 对象
  1608. Dim ReplaceJsonString As String = "
  1609. {
  1610. ""authenticationDatabase"": {
  1611. ""00000111112222233333444445555566"": {
  1612. ""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
  1613. ""username"": """ & If(McLoginLoader.Output.Email, McLoginLoader.Output.Name).Replace("""", "-") & """,
  1614. ""profiles"": {
  1615. ""66666555554444433333222221111100"": {
  1616. ""displayName"": """ & McLoginLoader.Output.Name & """
  1617. }
  1618. }
  1619. }
  1620. },
  1621. ""clientToken"": """ & McLoginLoader.Output.ClientToken & """,
  1622. ""selectedUser"": {
  1623. ""account"": ""00000111112222233333444445555566"",
  1624. ""profile"": ""66666555554444433333222221111100""
  1625. }
  1626. }"
  1627. Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
  1628. '更新文件
  1629. Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
  1630. Profiles.Merge(ReplaceJson)
  1631. WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
  1632. McLaunchLog("已更新 launcher_profiles.json")
  1633. Catch ex As Exception
  1634. Log(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试")
  1635. Try
  1636. File.Delete(PathMcFolder & "launcher_profiles.json")
  1637. McFolderLauncherProfilesJsonCreate(PathMcFolder)
  1638. '构建需要替换的 Json 对象
  1639. Dim ReplaceJsonString As String = "
  1640. {
  1641. ""authenticationDatabase"": {
  1642. ""00000111112222233333444445555566"": {
  1643. ""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
  1644. ""username"": """ & If(McLoginLoader.Output.Email, McLoginLoader.Output.Name).Replace("""", "-") & """,
  1645. ""profiles"": {
  1646. ""66666555554444433333222221111100"": {
  1647. ""displayName"": """ & McLoginLoader.Output.Name & """
  1648. }
  1649. }
  1650. }
  1651. },
  1652. ""clientToken"": """ & McLoginLoader.Output.ClientToken & """,
  1653. ""selectedUser"": {
  1654. ""account"": ""00000111112222233333444445555566"",
  1655. ""profile"": ""66666555554444433333222221111100""
  1656. }
  1657. }"
  1658. Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
  1659. '更新文件
  1660. Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
  1661. Profiles.Merge(ReplaceJson)
  1662. WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
  1663. McLaunchLog("已在删除后更新 launcher_profiles.json")
  1664. Catch exx As Exception
  1665. Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
  1666. End Try
  1667. End Try
  1668. '更新 options.txt
  1669. Dim SetupFileAddress As String = McVersionCurrent.PathIndie & "options.txt"
  1670. Try
  1671. '语言
  1672. If Setup.Get("ToolHelpChinese") Then
  1673. If Not File.Exists(SetupFileAddress) OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves") Then
  1674. McLaunchLog("已根据设置自动修改语言为中文")
  1675. WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改,避免删除后重新下载残留缓存
  1676. If McVersionCurrent.Version.McCodeMain >= 12 Then
  1677. WriteIni(SetupFileAddress, "lang", "zh_cn")
  1678. Else
  1679. WriteIni(SetupFileAddress, "lang", "zh_CN")
  1680. End If
  1681. WriteIni(SetupFileAddress, "forceUnicodeFont", "true")
  1682. Else
  1683. McLaunchLog("并非首次启动,不修改语言")
  1684. End If
  1685. End If
  1686. '窗口
  1687. Select Case Setup.Get("LaunchArgumentWindowType")
  1688. Case 0 '全屏
  1689. WriteIni(SetupFileAddress, "fullscreen", "true")
  1690. Case 5 '保持默认
  1691. Case Else '其他
  1692. WriteIni(SetupFileAddress, "fullscreen", "false")
  1693. End Select
  1694. Catch ex As Exception
  1695. Log(ex, "更新 options.txt 失败", LogLevel.Hint)
  1696. End Try
  1697. '离线皮肤 Alex 警告
  1698. Try
  1699. If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2
  1700. McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
  1701. (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
  1702. (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
  1703. Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
  1704. End If
  1705. Catch ex As Exception
  1706. Log(ex, "检查离线皮肤失效失败")
  1707. End Try
  1708. '离线皮肤资源包
  1709. Try
  1710. Directory.CreateDirectory(McVersionCurrent.PathIndie & "resourcepacks\")
  1711. Dim ZipFileAddress As String = McVersionCurrent.PathIndie & "resourcepacks\PCL2 Skin.zip"
  1712. Dim NewTypeSetup As Boolean = McVersionCurrent.Version.McCodeMain >= 13 OrElse McVersionCurrent.Version.McCodeMain < 6
  1713. If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Setup.Get("LaunchSkinType") = 4 AndAlso File.Exists(PathAppdata & "CustomSkin.png") Then
  1714. Directory.CreateDirectory(PathTemp)
  1715. Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
  1716. Dim PackPicAddress As String = PathTemp & "pack.png"
  1717. Dim PackFormat As Integer
  1718. Select Case McVersionCurrent.Version.McCodeMain
  1719. Case 0, 1, 2, 3, 4, 5
  1720. '更早的版本没有资源包;如果判断失败该值为 -1,不会跑到这
  1721. McLaunchLog("Minecraft 版本过老,尚不支持自定义离线皮肤")
  1722. GoTo IgnoreCustomSkin
  1723. Case 6, 7, 8
  1724. PackFormat = 1
  1725. Case 9, 10
  1726. PackFormat = 2
  1727. Case 11, 12
  1728. PackFormat = 3
  1729. Case 13, 14
  1730. PackFormat = 4
  1731. Case 15
  1732. PackFormat = 5
  1733. Case 16
  1734. PackFormat = 6
  1735. Case 17
  1736. PackFormat = 7
  1737. Case 18
  1738. If McVersionCurrent.Version.McCodeSub <= 2 Then
  1739. PackFormat = 8
  1740. Else
  1741. PackFormat = 9
  1742. End If
  1743. Case 19
  1744. If McVersionCurrent.Version.McCodeSub <= 2 Then
  1745. PackFormat = 9
  1746. Else
  1747. PackFormat = 12
  1748. End If
  1749. Case Else
  1750. PackFormat = 13
  1751. End Select
  1752. McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat)
  1753. '准备文件
  1754. Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
  1755. Bit.Save(PackPicAddress)
  1756. WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL2 自定义离线皮肤资源包""}}")
  1757. Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
  1758. If (McVersionCurrent.Version.McCodeMain = 6 OrElse McVersionCurrent.Version.McCodeMain = 7) AndAlso Skin.Pic.Height = 64 Then
  1759. McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
  1760. Skin = Skin.Clip(New System.Drawing.Rectangle(0, 0, 64, 32))
  1761. End If
  1762. Skin.Save(Path & "PCL\CustomSkin_Cliped.png")
  1763. '构建压缩文件
  1764. Using ZipFile As New FileStream(ZipFileAddress, FileMode.Create)
  1765. Using ZipAr As New ZipArchive(ZipFile, ZipArchiveMode.Create)
  1766. ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta")
  1767. ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png")
  1768. ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
  1769. End Using
  1770. End Using
  1771. File.Delete(Path & "PCL\CustomSkin_Cliped.png")
  1772. '更改设置文件
  1773. IniClearCache(SetupFileAddress)
  1774. Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
  1775. If NewTypeSetup Then
  1776. If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla"""
  1777. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  1778. Dim NewResourcePacks As New List(Of String)
  1779. For Each Res In EnabledResourcePacks
  1780. If Res <> """file/PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res)
  1781. Next
  1782. NewResourcePacks.Add("""file/PCL2 Skin.zip""")
  1783. Dim Result As String = "[" & Join(NewResourcePacks, ",") & "]"
  1784. WriteIni(SetupFileAddress, "resourcePacks", Result)
  1785. Else
  1786. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  1787. Dim NewResourcePacks As New List(Of String)
  1788. For Each Res In EnabledResourcePacks
  1789. If Res <> """PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res)
  1790. Next
  1791. NewResourcePacks.Add("""PCL2 Skin.zip""")
  1792. Dim Result As String = "[" & Join(NewResourcePacks, ",") & "]"
  1793. WriteIni(SetupFileAddress, "resourcePacks", Result)
  1794. End If
  1795. IgnoreCustomSkin:
  1796. ElseIf File.Exists(ZipFileAddress) Then
  1797. McLaunchLog("正在清空自定义皮肤资源包")
  1798. '删除压缩文件
  1799. File.Delete(ZipFileAddress)
  1800. '更改设置文件
  1801. IniClearCache(SetupFileAddress)
  1802. Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
  1803. If NewTypeSetup Then
  1804. If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla"""
  1805. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  1806. EnabledResourcePacks.Remove("""file/PCL2 Skin.zip""")
  1807. Dim Result As String = "[" & Join(EnabledResourcePacks, ",") & "]"
  1808. WriteIni(SetupFileAddress, "resourcePacks", Result)
  1809. Else
  1810. Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
  1811. EnabledResourcePacks.Remove("""PCL2 Skin.zip""")
  1812. Dim Result As String = "[" & Join(EnabledResourcePacks, ",") & "]"
  1813. WriteIni(SetupFileAddress, "resourcePacks", Result)
  1814. End If
  1815. End If
  1816. Catch ex As Exception
  1817. Log(ex, "离线皮肤资源包设置失败", LogLevel.Hint)
  1818. End Try
  1819. End Sub
  1820. Private Sub McLaunchCustom(Loader As LoaderTask(Of Integer, Integer))
  1821. '获取自定义命令
  1822. Dim CustomCommand As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
  1823. If CustomCommand <> "" Then CustomCommand = ArgumentReplace(CustomCommand)
  1824. '输出 bat
  1825. Try
  1826. Dim CmdString As String =
  1827. "@echo off" & vbCrLf &
  1828. "title 启动 - " & McVersionCurrent.Name & vbCrLf &
  1829. "echo 游戏正在启动,请稍候。" & vbCrLf &
  1830. "set APPDATA=""" & PathMcFolder & """" & vbCrLf &
  1831. "cd /D """ & PathMcFolder & """" & vbCrLf &
  1832. CustomCommand & vbCrLf &
  1833. """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
  1834. "echo 游戏已退出。" & vbCrLf &
  1835. "pause"
  1836. WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), CmdString,
  1837. Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
  1838. If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
  1839. McLaunchLog("导出启动脚本完成,强制结束启动过程")
  1840. AbortHint = "导出启动脚本成功!"
  1841. OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """")
  1842. Loader.Parent.Abort()
  1843. Exit Sub '导出脚本完成
  1844. End If
  1845. Catch ex As Exception
  1846. Log(ex, "输出启动脚本失败")
  1847. If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
  1848. End Try
  1849. '执行自定义命令
  1850. If CustomCommand <> "" Then
  1851. McLaunchLog("正在执行自定义命令:" & CustomCommand)
  1852. Try
  1853. Dim Cmd As New Process
  1854. Cmd.StartInfo.FileName = "cmd.exe"
  1855. Cmd.StartInfo.Arguments = "/c """ & CustomCommand & """"
  1856. Cmd.StartInfo.WorkingDirectory = Path
  1857. Cmd.StartInfo.UseShellExecute = False
  1858. Cmd.StartInfo.CreateNoWindow = True
  1859. Cmd.Start()
  1860. If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then
  1861. Do Until Cmd.HasExited OrElse Loader.IsAborted
  1862. Thread.Sleep(10)
  1863. Loop
  1864. End If
  1865. Catch ex As Exception
  1866. Log(ex, "执行自定义命令失败", LogLevel.Hint)
  1867. End Try
  1868. End If
  1869. End Sub
  1870. Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
  1871. '启动信息
  1872. Dim GameProcess = New Process()
  1873. Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw)
  1874. '设置环境变量
  1875. If StartInfo.EnvironmentVariables.ContainsKey("appdata") Then
  1876. StartInfo.EnvironmentVariables("appdata") = PathMcFolder
  1877. Else
  1878. StartInfo.EnvironmentVariables.Add("appdata", PathMcFolder)
  1879. End If
  1880. Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
  1881. Paths.Add(McLaunchJavaSelected.PathFolder)
  1882. StartInfo.EnvironmentVariables("Path") = Join(ArrayNoDouble(Paths), ";")
  1883. '设置其他参数
  1884. StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
  1885. StartInfo.UseShellExecute = False
  1886. StartInfo.RedirectStandardOutput = True
  1887. StartInfo.RedirectStandardError = True
  1888. StartInfo.CreateNoWindow = False
  1889. StartInfo.Arguments = McLaunchArgument
  1890. GameProcess.StartInfo = StartInfo
  1891. '开始进程
  1892. GameProcess.Start()
  1893. McLaunchLog("已启动游戏进程:" & McLaunchJavaSelected.PathJavaw)
  1894. Loader.Output = GameProcess
  1895. McLaunchProcess = GameProcess
  1896. '进程优先级处理
  1897. Try
  1898. If GameProcess.HasExited Then Exit Try '可能在启动游戏进程的同时刚好取消了启动
  1899. GameProcess.PriorityBoostEnabled = True
  1900. Select Case Setup.Get("LaunchArgumentPriority")
  1901. Case 0 '高
  1902. GameProcess.PriorityClass = ProcessPriorityClass.AboveNormal
  1903. Case 2 '低
  1904. GameProcess.PriorityClass = ProcessPriorityClass.BelowNormal
  1905. Case Else '中
  1906. End Select
  1907. Catch ex As Exception
  1908. Log(ex, "设置进程优先级失败", LogLevel.Feedback)
  1909. End Try
  1910. End Sub
  1911. Private Sub McLaunchWait(Loader As LoaderTask(Of Process, Integer))
  1912. '输出信息
  1913. McLaunchLog("")
  1914. McLaunchLog("~ 基础参数 ~")
  1915. McLaunchLog("PCL2 版本:" & VersionDisplayName & " (" & VersionCode & ")")
  1916. McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")")
  1917. McLaunchLog("资源版本:" & McAssetsGetIndexName(McVersionCurrent))
  1918. McLaunchLog("版本继承:" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion))
  1919. McLaunchLog("分配的内存:" & PageVersionSetup.GetRam(McVersionCurrent) & " GB(" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & " MB)")
  1920. McLaunchLog("MC 文件夹:" & PathMcFolder)
  1921. McLaunchLog("版本文件夹:" & McVersionCurrent.Path)
  1922. McLaunchLog("版本隔离:" & (McVersionCurrent.PathIndie = McVersionCurrent.Path))
  1923. McLaunchLog("HMCL 格式:" & McVersionCurrent.IsHmclFormatJson)
  1924. McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
  1925. McLaunchLog("环境变量:" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
  1926. McLaunchLog("")
  1927. McLaunchLog("~ 登录参数 ~")
  1928. McLaunchLog("玩家用户名:" & McLoginLoader.Output.Name)
  1929. McLaunchLog("AccessToken:" & McLoginLoader.Output.AccessToken.Substring(0, 22) & "[数据删除]" & McLoginLoader.Output.AccessToken.Substring(30))
  1930. McLaunchLog("ClientToken:" & McLoginLoader.Output.ClientToken)
  1931. McLaunchLog("UUID:" & McLoginLoader.Output.Uuid)
  1932. McLaunchLog("登录方式:" & McLoginLoader.Output.Type)
  1933. McLaunchLog("")
  1934. '获取窗口标题
  1935. Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent)
  1936. If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle")
  1937. WindowTitle = ArgumentReplace(WindowTitle)
  1938. '初始化等待
  1939. Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle)
  1940. McLaunchWatcher = Watcher
  1941. '等待
  1942. Do While Watcher.State = Watcher.MinecraftState.Loading
  1943. Thread.Sleep(100)
  1944. Loop
  1945. If Watcher.State = Watcher.MinecraftState.Crashed Then
  1946. Throw New Exception("$$")
  1947. End If
  1948. End Sub
  1949. Private Sub McLaunchEnd()
  1950. McLaunchLog("开始启动结束处理")
  1951. '暂停或开始音乐播放
  1952. If Setup.Get("UiMusicStop") Then
  1953. RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置,在启动后暂停音乐播放"))
  1954. ElseIf Setup.Get("UiMusicStart") Then
  1955. RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置,在启动后开始音乐播放"))
  1956. End If
  1957. '启动器可见性
  1958. McLaunchLog("启动器可见性:" & Setup.Get("LaunchArgumentVisible"))
  1959. Select Case Setup.Get("LaunchArgumentVisible")
  1960. Case 0
  1961. '直接关闭
  1962. McLaunchLog("已根据设置,在启动后关闭启动器")
  1963. RunInUi(Sub() FrmMain.EndProgram(False))
  1964. Case 2, 3
  1965. '隐藏
  1966. McLaunchLog("已根据设置,在启动后隐藏启动器")
  1967. RunInUi(Sub() FrmMain.Hidden = True)
  1968. Case 4
  1969. '最小化
  1970. McLaunchLog("已根据设置,在启动后最小化启动器")
  1971. RunInUi(Sub() FrmMain.WindowState = WindowState.Minimized)
  1972. Case 5
  1973. '啥都不干
  1974. End Select
  1975. '启动计数
  1976. Setup.Set("SystemLaunchCount", Setup.Get("SystemLaunchCount") + 1)
  1977. End Sub
  1978. ''' <summary>
  1979. ''' 在启动结束时,对 PCL 约定的替换标记进行处理。
  1980. ''' </summary>
  1981. Private Function ArgumentReplace(Raw As String) As String
  1982. If Raw Is Nothing Then Return Nothing
  1983. '路径替换
  1984. Raw = Raw.Replace("{minecraft}", PathMcFolder)
  1985. Raw = Raw.Replace("{verpath}", McVersionCurrent.Path)
  1986. Raw = Raw.Replace("{verindie}", McVersionCurrent.PathIndie)
  1987. Raw = Raw.Replace("{java}", McLaunchJavaSelected.PathFolder)
  1988. '普通替换
  1989. Raw = Raw.Replace("{user}", McLoginLoader.Output.Name)
  1990. Raw = Raw.Replace("{uuid}", McLoginLoader.Output.Uuid)
  1991. Select Case McLoginLoader.Input.Type
  1992. Case McLoginType.Legacy
  1993. If PageLinkHiper.HiperState = LoadState.Finished Then
  1994. Raw = Raw.Replace("{login}", "联机离线")
  1995. Else
  1996. Raw = Raw.Replace("{login}", "离线")
  1997. End If
  1998. Case McLoginType.Mojang
  1999. Raw = Raw.Replace("{login}", "Mojang 正版")
  2000. Case McLoginType.Ms
  2001. Raw = Raw.Replace("{login}", "微软正版")
  2002. Case McLoginType.Nide
  2003. Raw = Raw.Replace("{login}", "统一通行证")
  2004. Case McLoginType.Auth
  2005. Raw = Raw.Replace("{login}", "Authlib-Injector")
  2006. End Select
  2007. Raw = Raw.Replace("{name}", McVersionCurrent.Name)
  2008. If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then
  2009. Raw = Raw.Replace("{version}", McVersionCurrent.Name)
  2010. Else
  2011. Raw = Raw.Replace("{version}", McVersionCurrent.Version.McName)
  2012. End If
  2013. Raw = Raw.Replace("{path}", Path)
  2014. Return Raw
  2015. End Function
  2016. #End Region
  2017. End Module