ModLaunch.vb 121 KB

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