ModLaunch.vb 122 KB

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