ModLaunch.vb 94 KB

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