ModLaunch.vb 126 KB

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