ModLaunch.vb 96 KB

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