ModLaunch.vb 112 KB

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