| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205 |
- Public Module ModLaunch
- #Region "开始"
- Public CurrentLaunchOptions As McLaunchOptions = Nothing
- Public Class McLaunchOptions
- ''' <summary>
- ''' 强制指定在启动后进入的服务器 IP。
- ''' 默认值:Nothing。使用版本设置的值。
- ''' </summary>
- Public ServerIp As String = Nothing
- ''' <summary>
- ''' 将启动脚本保存到该地址,然后取消启动。这同时会改变启动时的提示等。
- ''' 默认值:Nothing。不保存。
- ''' </summary>
- Public SaveBatch As String = Nothing
- ''' <summary>
- ''' 强行指定启动的 MC 版本。
- ''' 默认值:Nothing。使用 McInstanceCurrent。
- ''' </summary>
- Public Instance As McInstance = Nothing
- ''' <summary>
- ''' 额外的启动参数。
- ''' </summary>
- Public ExtraGameArgs As New List(Of String)
- End Class
- ''' <summary>
- ''' 尝试启动 Minecraft。必须在 UI 线程调用。
- ''' 返回是否实际开始了启动(如果没有,则一定弹出了错误提示)。
- ''' </summary>
- Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
- CurrentLaunchOptions = If(Options, New McLaunchOptions)
- '预检查
- If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
- If McLaunchLoader.State = LoadState.Loading Then
- Hint("已有游戏正在启动中!", HintType.Red)
- Return False
- End If
- '强制切换需要启动的版本
- If CurrentLaunchOptions.Instance IsNot Nothing AndAlso McInstanceSelected <> CurrentLaunchOptions.Instance Then
- McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Instance.Name)
- '检查版本是否存在
- Try
- CurrentLaunchOptions.Instance.GetJsonPath()
- Catch
- Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}:当前 Minecraft 文件夹中尚未安装该版本!", HintType.Red)
- Return False
- End Try
- '检查版本
- CurrentLaunchOptions.Instance.Load()
- If CurrentLaunchOptions.Instance.State = McInstanceState.Error Then
- Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}:{CurrentLaunchOptions.Instance.Info}", HintType.Red)
- Return False
- End If
- '切换版本
- McInstanceSelected = CurrentLaunchOptions.Instance
- FrmLaunchLeft.RefreshButtonsUI()
- FrmLaunchLeft.RefreshPage(False, False)
- End If
- FrmMain.AprilGiveup()
- '禁止进入版本选择页面(否则就可以在启动中切换 McInstanceSelected 了)
- FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.InstanceSelect).ToList
- '实际启动加载器
- McLaunchLoader.Start(Options, IsForceRestart:=True)
- Return True
- End Function
- ''' <summary>
- ''' 记录启动日志。
- ''' </summary>
- Public Sub McLaunchLog(Text As String, Optional Level As LogLevel = LogLevel.Info)
- Text = FilterUserName(FilterAccessToken(Text, "*"), "*")
- If ModeDebug Then RunInUi(Sub() FrmLaunchRight.LabLog.Text += $"{vbCrLf}[{Date.Now:HH':'mm':'ss'.'fff}] {Text}")
- Logger.Log(Text, Level)
- End Sub
- '启动状态切换
- Public McLaunchLoader As New LoaderTask(Of McLaunchOptions, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState}
- Public McLaunchLoaderReal As LoaderCombo(Of Object)
- Public McLaunchProcess As Process
- Public McLaunchWatcher As Watcher
- Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
- Select Case McLaunchLoader.State
- Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Canceled
- FrmLaunchLeft.PageChangeToLogin()
- Case LoadState.Loading
- '在预检测结束后再触发动画
- FrmLaunchRight.LabLog.Text = ""
- End Select
- End Sub
- ''' <summary>
- ''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
- ''' </summary>
- Private CanceledHint As String = Nothing
- '实际的启动方法
- Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
- '开始动画
- RunInUiWait(AddressOf FrmLaunchLeft.PageChangeToLaunching)
- '预检测(预检测的错误将直接抛出)
- Try
- McLaunchPrecheck()
- McLaunchLog("预检测已通过")
- Catch ex As Exception
- If Not ex.IsCanceled Then Hint(ex.Message, HintType.Red)
- Throw
- End Try
- Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
- '正式加载
- Try
- '构造主加载器
- Dim Loaders As New List(Of LoaderBase) From {
- New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
- McLoginLoader, '.ProgressWeight = 15, .Block = False
- New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, True)) With {.ProgressWeight = 15, .Show = False},
- New LoaderTask(Of String, Integer)("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
- New LoaderTask(Of Integer, Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
- New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
- New LoaderTask(Of Integer, Integer)("执行自定义命令", AddressOf McLaunchCustom) With {.ProgressWeight = 1},
- New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2},
- New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
- New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
- }
- '内存优化
- Select Case Settings.Get(Of Integer)("VersionRamOptimize", Instance:=McInstanceSelected)
- Case 0 '全局
- If Settings.Get(Of Boolean)("LaunchArgumentRam") Then '使用全局设置
- CType(Loaders(2), LoaderCombo(Of String)).Block = False
- Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
- End If
- Case 1 '开启
- CType(Loaders(2), LoaderCombo(Of String)).Block = False
- Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
- Case 2 '关闭
- End Select
- Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
- If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
- '等待加载器执行并更新 UI
- McLaunchLoaderReal = LaunchLoader
- CanceledHint = Nothing
- LaunchLoader.Start()
- '任务栏进度条
- LoaderTaskbarAdd(LaunchLoader)
- Do While LaunchLoader.State = LoadState.Loading
- FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
- Thread.Sleep(100)
- Loop
- FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
- '成功与失败处理
- Select Case LaunchLoader.State
- Case LoadState.Finished
- Hint(McInstanceSelected.Name & " 启动成功!", HintType.Green)
- '上报
- If Not IsSavingBatch Then
- Telemetry("Minecraft 启动成功",
- "Version", McInstanceSelected.VersionDisplayName,
- "LoginType", Settings.Get(Of McLoginType)("LoginType").ToString)
- End If
- Case LoadState.Canceled
- If CanceledHint Is Nothing Then
- Hint(If(IsSavingBatch, "已取消导出启动脚本!", "已取消启动!"), HintType.Blue)
- Else
- Hint(CanceledHint, HintType.Green)
- End If
- Case LoadState.Failed
- Throw LaunchLoader.Error
- Case Else
- Throw New Exception("错误的状态改变:" & LaunchLoader.State.ToString())
- End Select
- Catch ex As Exception
- ex.ThrowIfCanceled()
- Dim CurrentEx = ex
- NextInner:
- If CurrentEx.Message.StartsWithF("$") Then
- '若有以 $ 开头的错误信息,则以此为准显示提示
- MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
- Throw
- ElseIf CurrentEx.InnerException IsNot Nothing Then
- '检查下一级错误
- CurrentEx = CurrentEx.InnerException
- GoTo NextInner
- Else
- '没有特殊处理过的错误信息
- McLaunchLog("错误:" & ex.GetDisplay(True))
- Logger.Error(ex, If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogBehavior.Alert)
- '上报
- If Not IsSavingBatch Then
- Telemetry("Minecraft 启动失败",
- "Version", McInstanceSelected.VersionDisplayName,
- "LoginType", Settings.Get(Of McLoginType)("LoginType").ToString,
- "Exception", FilterUserName(FilterAccessToken(ex.GetDisplay(True), "*"), "*"))
- End If
- Throw
- End If
- End Try
- End Sub
- #End Region
- #Region "内存优化"
- Private Sub McLaunchMemoryOptimize(Loader As LoaderTask(Of Integer, Integer))
- McLaunchLog("内存优化开始")
- Dim Finished As Boolean = False
- RunInNewThread(
- Sub()
- PageOtherTest.MemoryOptimize(False)
- Finished = True
- End Sub, "Launch Memory Optimize")
- Do While Not Finished AndAlso Not Loader.IsCanceled
- If Loader.Progress < 0.7 Then
- Loader.Progress += 0.007 '10s
- Else
- Loader.Progress += (0.95 - Loader.Progress) * 0.02 '最快 += 0.005
- End If
- Thread.Sleep(100)
- Loop
- End Sub
- #End Region
- #Region "预检测"
- Private Sub McLaunchPrecheck()
- If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
- '检查路径
- If McInstanceSelected.PathIndie.Contains("!") OrElse McInstanceSelected.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McInstanceSelected.PathIndie & ")")
- If McInstanceSelected.PathVersion.Contains("!") OrElse McInstanceSelected.PathVersion.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McInstanceSelected.PathVersion & ")")
- '检查版本
- If McInstanceSelected Is Nothing Then Throw New Exception("未选择 Minecraft 版本!")
- McInstanceSelected.Load()
- If McInstanceSelected.State = McInstanceState.Error Then Throw New Exception("Minecraft 存在问题:" & McInstanceSelected.Info)
- '检查输入信息
- Dim CheckResult As String = ""
- RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
- If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
- '求赞助
- If BuildType = BuildTypes.Release AndAlso CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
- RunInNewThread(
- Sub()
- Select Case Settings.Get(Of Integer)("SystemLaunchCount")
- 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
- If MyMsgBox("PCL 已经为你启动了 " & Settings.Get(Of Integer)("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
- "如果 PCL 还算好用的话,能不能考虑赞助一下 PCL……" & vbCrLf &
- "如果没有大家的支持,PCL 很难在免费、无任何广告的情况下维持数年的更新(磕头)……!",
- Settings.Get(Of Integer)("SystemLaunchCount") & " 次启动!", "支持 PCL!", "但是我拒绝") = 1 Then
- OpenWebsite("https://meloong.com/afd/a/LTCat")
- End If
- End Select
- End Sub, "Donate")
- End If
- '正版购买提示
- If CurrentLaunchOptions?.SaveBatch Is Nothing AndAlso '保存脚本时不提示
- Not Settings.Get(Of Boolean)("HintBuy") AndAlso Settings.Get(Of McLoginType)("LoginType") <> McLoginType.Ms Then
- If Globalization.CultureInfo.CurrentCulture.Name.StartsWithF("zh") OrElse Globalization.CultureInfo.CurrentUICulture.Name.StartsWithF("zh") Then '中文?
- RunInNewThread(
- Sub()
- Select Case Settings.Get(Of Integer)("SystemLaunchCount")
- 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
- If MyMsgBox("你已经启动了 " & Settings.Get(Of Integer)("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
- "如果觉得 Minecraft 还不错,可以购买正版支持一下,毕竟开发游戏也真的很不容易……不要一直白嫖啦。" & vbCrLf & vbCrLf &
- "在登录一次正版账号后,就不会再出现这个提示了!",
- "考虑一下正版?", "支持正版游戏!", "下次一定") = 1 Then
- OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
- End If
- End Select
- End Sub, "Buy Minecraft")
- ElseIf Settings.Get(Of McLoginType)("LoginType") = McLoginType.Legacy Then
- Select Case MyMsgBox("你必须先登录正版账号,才能进行离线登录!", "正版验证", "购买正版", "试玩", "返回",
- Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
- Case 2
- Hint("游戏将以试玩模式启动!", HintType.Red)
- CurrentLaunchOptions.ExtraGameArgs.Add("--demo")
- Case 3
- Throw New OperationCanceledException
- End Select
- End If
- End If
- End Sub
- #End Region
- #Region "主登录模块"
- '登录方式
- Public Enum McLoginType
- Legacy = 0
- Nide = 2
- Auth = 3
- Ms = 5
- End Enum
- '各个登录方式的对应数据
- Public MustInherit Class McLoginData
- ''' <summary>
- ''' 登录方式。
- ''' </summary>
- Public Type As McLoginType
- Public Overrides Function Equals(obj As Object) As Boolean
- Return obj IsNot Nothing AndAlso obj.GetHashCode() = GetHashCode()
- End Function
- End Class
- Public Class McLoginServer
- Inherits McLoginData
- ''' <summary>
- ''' 登录用户名。
- ''' </summary>
- Public UserName As String
- ''' <summary>
- ''' 登录密码。
- ''' </summary>
- Public Password As String
- ''' <summary>
- ''' 登录服务器基础地址。
- ''' </summary>
- Public BaseUrl As String
- ''' <summary>
- ''' 登录所使用的标识符,目前只可能为 “Auth” 或 “Nide”,用于存储缓存等。
- ''' </summary>
- Public Token As String
- ''' <summary>
- ''' 登录方式的描述字符串,如 “正版”、“统一通行证”。
- ''' </summary>
- Public Description As String
- ''' <summary>
- ''' 是否在本次登录中强制要求玩家重新选择角色,目前仅对 Authlib-Injector 生效。
- ''' </summary>
- Public ForceReselectProfile As Boolean = False
- Public Sub New(Type As McLoginType)
- Me.Type = Type
- End Sub
- Public Overrides Function GetHashCode() As Integer
- Return (UserName & Password & BaseUrl & Token & Type).GetStableHashCode() Mod Integer.MaxValue
- End Function
- End Class
- Public Class McLoginMs
- Inherits McLoginData
- ''' <summary>
- ''' 缓存的 OAuth Refresh Token。若没有则为空字符串。
- ''' </summary>
- Public OAuthRefreshToken As String = ""
- Public AccessToken As String = ""
- Public Uuid As String = ""
- Public UserName As String = ""
- Public ProfileJson As String = ""
- Public Sub New()
- Type = McLoginType.Ms
- End Sub
- Public Overrides Function GetHashCode() As Integer
- '不能使用全部信息,这俩就足以在登录输入时确保是同一个用户了
- Return (OAuthRefreshToken & UserName).GetStableHashCode() Mod Integer.MaxValue
- End Function
- End Class
- Public Class McLoginLegacy
- Inherits McLoginData
- ''' <summary>
- ''' 登录用户名。
- ''' </summary>
- Public UserName As String
- ''' <summary>
- ''' 皮肤种类。
- ''' </summary>
- Public SkinType As Integer
- ''' <summary>
- ''' 若采用正版皮肤,则为该皮肤名。
- ''' </summary>
- Public SkinName As String
- Public Sub New()
- Type = McLoginType.Legacy
- End Sub
- Public Overrides Function GetHashCode() As Integer
- Return (UserName & SkinType & SkinName & Type).GetStableHashCode() Mod Integer.MaxValue
- End Function
- End Class
- '登录返回结果
- Public Structure McLoginResult
- Public Name As String
- Public Uuid As String
- Public AccessToken As String
- Public Type As String
- Public ClientToken As String
- ''' <summary>
- ''' 进行微软登录时返回的 profile 信息。
- ''' </summary>
- Public ProfileJson As String
- End Structure
- ''' <summary>
- ''' 根据登录信息获取玩家的 MC 用户名。如果无法获取则返回 Nothing。
- ''' </summary>
- Public Function McLoginName() As String
- '根据当前登录方式优先返回
- Select Case Settings.Get(Of McLoginType)("LoginType")
- Case McLoginType.Ms
- If Settings.Get(Of String)("CacheMsV2Name") <> "" Then Return Settings.Get(Of String)("CacheMsV2Name")
- Case McLoginType.Legacy
- If Settings.Get(Of String)("LoginLegacyName") <> "" Then Return Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨")
- Case McLoginType.Nide
- If Settings.Get(Of String)("CacheNideName") <> "" Then Return Settings.Get(Of String)("CacheNideName")
- Case McLoginType.Auth
- If Settings.Get(Of String)("CacheAuthName") <> "" Then Return Settings.Get(Of String)("CacheAuthName")
- End Select
- '查找所有可能的项
- If Settings.Get(Of String)("CacheMsV2Name") <> "" Then Return Settings.Get(Of String)("CacheMsV2Name")
- If Settings.Get(Of String)("CacheNideName") <> "" Then Return Settings.Get(Of String)("CacheNideName")
- If Settings.Get(Of String)("CacheAuthName") <> "" Then Return Settings.Get(Of String)("CacheAuthName")
- If Settings.Get(Of String)("LoginLegacyName") <> "" Then Return Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨")
- Return Nothing
- End Function
- ''' <summary>
- ''' 当前是否可以进行登录。若不可以则会返回错误原因。
- ''' </summary>
- Public Function McLoginAble() As String
- Select Case Settings.Get(Of McLoginType)("LoginType")
- Case McLoginType.Ms
- If Settings.Get(Of String)("CacheMsV2OAuthRefresh") = "" Then
- Return FrmLoginMs.IsVaild()
- Else
- Return ""
- End If
- Case McLoginType.Legacy
- Return FrmLoginLegacy.IsVaild()
- Case McLoginType.Nide
- If Settings.Get(Of String)("CacheNideAccess") = "" Then
- Return FrmLoginNide.IsVaild()
- Else
- Return ""
- End If
- Case McLoginType.Auth
- If Settings.Get(Of String)("CacheAuthAccess") = "" Then
- Return FrmLoginAuth.IsVaild()
- Else
- Return ""
- End If
- Case Else
- Return "未知的登录方式"
- End Select
- End Function
- ''' <summary>
- ''' 登录输入是否可以进行登录。若不可以则会返回错误原因。
- ''' </summary>
- Public Function McLoginAble(LoginData As McLoginData) As String
- Select Case LoginData.Type
- Case McLoginType.Ms
- Return PageLoginMs.IsVaild(LoginData)
- Case McLoginType.Legacy
- Return PageLoginLegacy.IsVaild(LoginData)
- Case McLoginType.Nide
- Return PageLoginNide.IsVaild(LoginData)
- Case McLoginType.Auth
- Return PageLoginAuth.IsVaild(LoginData)
- Case Else
- Return "未知的登录方式"
- End Select
- End Function
- '登录主模块加载器
- Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
- Public Function McLoginInput() As McLoginData
- Dim LoginData As McLoginData = Nothing
- Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
- Try
- Select Case LoginType
- Case McLoginType.Legacy
- LoginData = PageLoginLegacy.GetLoginData()
- Case McLoginType.Ms
- If Settings.Get(Of String)("CacheMsV2OAuthRefresh") = "" Then
- LoginData = PageLoginMs.GetLoginData()
- Else
- LoginData = PageLoginMsSkin.GetLoginData()
- End If
- Case McLoginType.Nide
- If Settings.Get(Of String)("CacheNideAccess") = "" Then
- LoginData = PageLoginNide.GetLoginData()
- Else
- LoginData = PageLoginNideSkin.GetLoginData()
- End If
- Case McLoginType.Auth
- If Settings.Get(Of String)("CacheAuthAccess") = "" Then
- LoginData = PageLoginAuth.GetLoginData()
- Else
- LoginData = PageLoginAuthSkin.GetLoginData()
- End If
- End Select
- Return LoginData
- Catch ex As Exception
- Throw New Exception($"获取登录输入信息失败({LoginType})", ex)
- End Try
- End Function
- Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
- McLaunchLog("登录加载已开始")
- '校验登录信息
- Dim CheckResult As String = McLoginAble(Data.Input)
- If Not CheckResult = "" Then Throw New ArgumentException(CheckResult)
- '获取对应加载器
- Dim Loader As LoaderBase = Nothing
- Select Case Data.Input.Type
- Case McLoginType.Ms
- Loader = McLoginMsLoader
- Case McLoginType.Legacy
- Loader = McLoginLegacyLoader
- Case McLoginType.Nide
- Loader = McLoginNideLoader
- Case McLoginType.Auth
- Loader = McLoginAuthLoader
- End Select
- '尝试加载
- Loader.WaitForExit(Data.Input, McLoginLoader, Data.IsForceRestarting)
- Data.Output = CType(Loader, Object).Output
- RunInUi(Sub() FrmLaunchLeft.RefreshPage(True, False)) '刷新自动填充列表
- McLaunchLog("登录加载已结束")
- End Sub
- #End Region
- #Region "分方式登录模块"
- '各个登录方式的主对象与输入构造
- Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 1}
- Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
- Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
- Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
- '主加载函数,返回所有需要的登录信息
- Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
- Dim Input As McLoginMs = Data.Input
- Dim LogUsername As String = Input.UserName
- McLaunchLog("登录方式:正版(" & If(LogUsername = "", "尚未登录", LogUsername) & ")")
- Data.Progress = 0.05
- '检查是否已经登录完成
- Dim ExpiresAt = Settings.Get(Of Long)("CacheMsV2Expires")
- If Not Data.IsForceRestarting AndAlso '不要求强行重启
- ExpiresAt > 0 AndAlso ExpiresAt > GetUnixTimestampUtc() AndAlso 'AccessToken 尚未过期
- Input.UserName = Settings.Get(Of String)("CacheMsV2Name") Then
- Data.Output = New McLoginResult With {
- .Name = Input.UserName, .Type = "Microsoft",
- .AccessToken = Settings.Get(Of String)("CacheMsV2Access"),
- .Uuid = Settings.Get(Of String)("CacheMsV2Uuid"),
- .ClientToken = Settings.Get(Of String)("CacheMsV2Uuid"),
- .ProfileJson = Settings.Get(Of String)("CacheMsV2ProfileJson")
- }
- McLaunchLog("无需登录,AccessToken 尚未过期")
- GoTo SkipLogin
- End If
- '尝试登录
- Dim OAuthTokens As (OAuthAccessToken As String, OAuthRefreshToken As String)
- If Input.OAuthRefreshToken = "" Then
- '无 RefreshToken
- Relogin:
- OAuthTokens = MsLoginStep1New(Data)
- Else
- '有 RefreshToken
- OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
- If OAuthTokens.OAuthAccessToken = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
- End If
- If Data.IsCanceled Then Throw New OperationCanceledException
- Data.Progress = 0.25
- If Data.IsCanceled Then Throw New OperationCanceledException
- Dim OAuthAccessToken As String = OAuthTokens.OAuthAccessToken
- Dim OAuthRefreshToken As String = OAuthTokens.OAuthRefreshToken
- Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
- Data.Progress = 0.4
- If Data.IsCanceled Then Throw New OperationCanceledException
- Dim Tokens = MsLoginStep3(XBLToken)
- Data.Progress = 0.55
- If Data.IsCanceled Then Throw New OperationCanceledException
- Dim LoginResult = MsLoginStep4(Tokens)
- ExpiresAt = LoginResult.ExpiresAt
- Data.Progress = 0.7
- If Data.IsCanceled Then Throw New OperationCanceledException
- MsLoginStep5(LoginResult.AccessToken)
- Data.Progress = 0.85
- If Data.IsCanceled Then Throw New OperationCanceledException
- Dim Result = MsLoginStep6(LoginResult.AccessToken)
- Data.Progress = 0.98
- '输出登录结果
- Settings.Set("CacheMsV2OAuthRefresh", OAuthRefreshToken)
- Settings.Set("CacheMsV2Access", LoginResult.AccessToken)
- Settings.Set("CacheMsV2Uuid", Result.UUID)
- Settings.Set("CacheMsV2Name", Result.UserName)
- Settings.Set("CacheMsV2ProfileJson", Result.ProfileJson)
- Settings.Set("CacheMsV2Expires", LoginResult.ExpiresAt)
- Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
- MsJson.Remove(Input.UserName) '如果更改了玩家名……
- MsJson(Result.UserName) = OAuthRefreshToken
- Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
- Data.Output = New McLoginResult With {.AccessToken = LoginResult.AccessToken, .Name = Result.UserName, .Uuid = Result.UUID, .Type = "Microsoft", .ClientToken = Result.UUID, .ProfileJson = Result.ProfileJson}
- '结束
- SkipLogin:
- McLaunchLog($"微软登录结束,AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).LocalDateTime} 过期")
- Settings.Set("HintBuy", True) '关闭正版购买提示
- If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
- End Sub
- Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
- Dim Input As McLoginServer = Data.Input
- Dim NeedRefresh As Boolean = False, WasRefreshed As Boolean = False
- McLaunchLog("登录方式:" & Input.Description)
- Data.Progress = 0.05
- '尝试登录
- If (Not Data.Input.ForceReselectProfile) AndAlso
- Settings.Get(Of String)("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso
- Settings.Get(Of String)("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso
- Settings.Get(Of String)("Cache" & Input.Token & "Access") <> "" AndAlso
- Settings.Get(Of String)("Cache" & Input.Token & "Client") <> "" AndAlso
- Settings.Get(Of String)("Cache" & Input.Token & "Uuid") <> "" AndAlso
- Settings.Get(Of String)("Cache" & Input.Token & "Name") <> "" Then
- '尝试验证登录
- Try
- If Data.IsCanceled Then Throw New OperationCanceledException
- McLoginRequestValidate(Data)
- GoTo LoginFinish
- Catch ex As Exception
- Logger.Warn(ex, "验证登录失败")
- If ex.IsBadNetwork Then Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后再试,或使用加速器、VPN 改善网络环境。")
- End Try
- Data.Progress = 0.25
- '尝试刷新登录
- Refresh:
- Try
- If Data.IsCanceled Then Throw New OperationCanceledException
- McLoginRequestRefresh(Data, NeedRefresh)
- GoTo LoginFinish
- Catch ex As Exception
- McLaunchLog("刷新登录失败:" & ex.GetDisplay(True))
- If WasRefreshed Then Throw New Exception("二轮刷新登录失败", ex)
- End Try
- Data.Progress = If(NeedRefresh, 0.85, 0.45)
- End If
- '尝试普通登录
- Try
- If Data.IsCanceled Then Throw New OperationCanceledException
- NeedRefresh = McLoginRequestLogin(Data)
- Catch ex As Exception
- McLaunchLog("登录失败:" & ex.GetDisplay(True))
- Throw
- End Try
- If NeedRefresh Then
- McLaunchLog("重新进行刷新登录")
- WasRefreshed = True
- Data.Progress = 0.65
- GoTo Refresh
- End If
- LoginFinish:
- Data.Progress = 0.95
- '保存启动记录
- Dim Dict As New Dictionary(Of String, String)
- Dim Emails As New List(Of String)
- Dim Passwords As New List(Of String)
- Try
- If Not Settings.Get(Of String)("Login" & Input.Token & "Email") = "" Then Emails.AddRange(Settings.Get(Of String)("Login" & Input.Token & "Email").Split("¨"))
- If Not Settings.Get(Of String)("Login" & Input.Token & "Pass") = "" Then Passwords.AddRange(Settings.Get(Of String)("Login" & Input.Token & "Pass").Split("¨"))
- For i = 0 To Emails.Count - 1
- Dict.Add(Emails(i), Passwords(i))
- Next
- Dict.Remove(Input.UserName)
- Emails = New List(Of String)(Dict.Keys)
- Emails.Insert(0, Input.UserName)
- Passwords = New List(Of String)(Dict.Values)
- Passwords.Insert(0, Input.Password)
- Settings.Set("Login" & Input.Token & "Email", Emails.Join("¨"c))
- Settings.Set("Login" & Input.Token & "Pass", Passwords.Join("¨"c))
- Catch ex As Exception
- Logger.Error(ex, "保存启动记录失败", LogBehavior.Toast)
- Settings.Set("Login" & Input.Token & "Email", "")
- Settings.Set("Login" & Input.Token & "Pass", "")
- End Try
- End Sub
- Private Sub McLoginLegacyStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult))
- Dim Input As McLoginLegacy = Data.Input
- McLaunchLog("登录方式:离线(" & Input.UserName & ")")
- Data.Progress = 0.1
- With Data.Output
- .Name = Input.UserName
- .Uuid = McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName)
- .Type = "Legacy"
- End With
- '将结果扩展到所有项目中
- Data.Output.AccessToken = Data.Output.Uuid
- Data.Output.ClientToken = Data.Output.Uuid
- '保存启动记录
- Dim Names As New List(Of String)
- If Not Settings.Get(Of String)("LoginLegacyName") = "" Then Names.AddRange(Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨"))
- Names.Remove(Input.UserName)
- Names.Insert(0, Input.UserName)
- Settings.Set("LoginLegacyName", Names.Join("¨"c))
- End Sub
- 'Server 登录:三种验证方式的请求
- Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult))
- McLaunchLog("验证登录开始(Validate, " & Data.Input.Token & ")")
- '提前缓存信息,否则如果在登录请求过程中退出登录,设置项目会被清空,导致输出存在空值
- Dim AccessToken As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Access")
- Dim ClientToken As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Client")
- Dim Uuid As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Uuid")
- Dim Name As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Name")
- '发送登录请求
- Dim RequestData As New JObject(
- New JProperty("accessToken", AccessToken), New JProperty("clientToken", ClientToken), New JProperty("requestUser", True))
- NetRequestByClientRetry(
- Data.Input.BaseUrl & "/validate", HttpMethod.Post,
- Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
- Headers:={{"Accept-Language", "zh-CN"}},
- ContentType:="application/json; charset=utf-8") '没有返回值的
- '将登录结果输出
- Data.Output.AccessToken = AccessToken
- Data.Output.ClientToken = ClientToken
- Data.Output.Uuid = Uuid
- Data.Output.Name = Name
- Data.Output.Type = Data.Input.Token
- '不更改缓存,直接结束
- McLaunchLog("验证登录成功(Validate, " & Data.Input.Token & ")")
- End Sub
- Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
- McLaunchLog("刷新登录开始(Refresh, " & Data.Input.Token & ")")
- Dim LoginJson As JObject = NetRequestByClientRetry(
- Data.Input.BaseUrl & "/refresh", HttpMethod.Post,
- Content:=New JObject(
- New JProperty("selectedProfile", New JObject(
- New JProperty("name", Settings.Get(Of String)($"Cache{Data.Input.Token}Name")),
- New JProperty("id", Settings.Get(Of String)($"Cache{Data.Input.Token}Uuid"))
- )),
- New JProperty("accessToken", Settings.Get(Of String)($"Cache{Data.Input.Token}Access")),
- New JProperty("requestUser", True)
- ).ToString(Newtonsoft.Json.Formatting.None),
- Headers:={{"Accept-Language", "zh-CN"}},
- ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
- '将登录结果输出
- If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Settings.Get(Of String)("Cache" & Data.Input.Token & "Name") & " 无效!")
- Data.Output.AccessToken = LoginJson("accessToken").ToString
- Data.Output.ClientToken = LoginJson("clientToken").ToString
- Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString
- Data.Output.Name = LoginJson("selectedProfile")("name").ToString
- Data.Output.Type = Data.Input.Token
- '保存缓存
- Settings.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
- Settings.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
- Settings.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
- Settings.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
- Settings.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
- Settings.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
- McLaunchLog("刷新登录成功(Refresh, " & Data.Input.Token & ")")
- End Sub
- Private Function McLoginRequestLogin(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) As Boolean
- Try
- Dim NeedRefresh As Boolean = False
- McLaunchLog("登录开始(Login, " & Data.Input.Token & ")")
- Dim RequestData As New JObject(
- New JProperty("agent", New JObject(New JProperty("name", "Minecraft"), New JProperty("version", 1))),
- New JProperty("username", Data.Input.UserName),
- New JProperty("password", Data.Input.Password),
- New JProperty("requestUser", True))
- Dim LoginJson As JObject = NetRequestByClientRetry(
- Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
- Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
- Headers:={{"Accept-Language", "zh-CN"}},
- ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
- '检查登录结果
- If LoginJson("availableProfiles").Count = 0 Then
- If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Red)
- Throw New Exception("$你还没有创建角色,请在创建角色后再试!")
- ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").IsSingle Then
- Hint("你的账户中只有一个角色,无法更换!", HintType.Red)
- End If
- Dim SelectedName As String = Nothing
- Dim SelectedId As String = Nothing
- If (LoginJson("selectedProfile") Is Nothing OrElse Data.Input.ForceReselectProfile) AndAlso LoginJson("availableProfiles").Count > 1 Then
- '要求选择档案;优先从缓存读取
- NeedRefresh = True
- Dim CacheId As String = Settings.Get(Of String)("Cache" & Data.Input.Token & "Uuid")
- For Each Profile In LoginJson("availableProfiles")
- If Profile("id").ToString = CacheId Then
- SelectedName = Profile("name").ToString
- SelectedId = Profile("id").ToString
- McLaunchLog("根据缓存选择的角色:" & SelectedName)
- End If
- Next
- '缓存无效,要求玩家选择
- If SelectedName Is Nothing Then
- McLaunchLog("要求玩家选择角色")
- RunInUiWait(
- Sub()
- Dim SelectionControl As New List(Of IMyRadio)
- Dim SelectionJson As New List(Of JToken)
- For Each Profile In LoginJson("availableProfiles")
- SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString})
- SelectionJson.Add(Profile)
- Next
- Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色")
- SelectedName = SelectionJson(SelectedIndex)("name").ToString
- SelectedId = SelectionJson(SelectedIndex)("id").ToString
- End Sub)
- McLaunchLog("玩家选择的角色:" & SelectedName)
- End If
- Else
- SelectedName = LoginJson("selectedProfile")("name").ToString
- SelectedId = LoginJson("selectedProfile")("id").ToString
- End If
- '将登录结果输出
- Data.Output.AccessToken = LoginJson("accessToken").ToString
- Data.Output.ClientToken = LoginJson("clientToken").ToString
- Data.Output.Name = SelectedName
- Data.Output.Uuid = SelectedId
- Data.Output.Type = Data.Input.Token
- '保存缓存
- Settings.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
- Settings.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
- Settings.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
- Settings.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
- Settings.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
- Settings.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
- McLaunchLog("登录成功(Login, " & Data.Input.Token & ")")
- Return NeedRefresh
- Catch ex As Exception
- Dim AllMessage As String = ex.GetDisplay(False)
- Logger.Info(ex, "登录失败原始错误信息")
- '读取服务器返回的错误
- If TypeOf ex Is HttpRequestCodeException Then
- Dim ErrorMessage As String = Nothing
- Try
- Dim Response = DirectCast(ex, HttpRequestCodeException).Response
- If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = Response.DeserializeJson()("errorMessage").ToString()
- Catch
- End Try
- If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
- If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsIgnoreCase("Incorrect username or password") Then
- '密码错误,退出登录 (#5090)
- McLaunchLog("密码错误,退出登录")
- Select Case Data.Input.Type
- Case McLoginType.Auth
- RunInUi(AddressOf PageLoginAuthSkin.ExitLogin)
- Case McLoginType.Nide
- RunInUi(AddressOf PageLoginNideSkin.ExitLogin)
- End Select
- End If
- Throw New Exception("$登录失败:" & ErrorMessage)
- End If
- End If
- '通用关键字检测
- If AllMessage.Contains("(403)") Then
- Select Case Data.Input.Type
- Case McLoginType.Auth
- Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
- " - 输入的账号或密码错误。" & vbCrLf &
- " - 登录尝试过于频繁,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
- " - 只注册了账号,但没有在皮肤站新建角色。")
- Case McLoginType.Nide
- Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
- " - 输入的账号或密码错误。" & vbCrLf &
- " - 密码错误次数过多,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
- If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号,而非游戏角色 ID。" & vbCrLf) &
- " - 只注册了账号,但没有加入对应服务器。")
- End Select
- ElseIf ex.IsBadNetwork() Then
- Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后再试,或使用加速器、VPN 改善网络环境。")
- ElseIf ex.Message.StartsWithF("$") Then
- Throw
- Else
- Throw New Exception("登录失败:" & ex.Message, ex)
- End If
- Return False
- End Try
- End Function
- '微软登录步骤 1,原始登录:获取 DeviceCode 并开启登录网页
- Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As (OAuthAccessToken As String, OAuthRefreshToken As String)
- '参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
- '初始请求
- Retry:
- McLaunchLog("开始微软登录步骤 1/6(原始登录)")
- Dim PrepareJson As JObject = NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
- Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
- ContentType:="application/x-www-form-urlencoded", RequireJson:=True).DeserializeJson()
- McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
- '弹窗
- Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
- WaitingMyMsgBox.Enqueue(Converter)
- While Converter.Result Is Nothing
- Thread.Sleep(100)
- End While
- If TypeOf Converter.Result Is RestartException Then
- If MyMsgBox($"请在登录时选择 {vbLQ}其他登录方法{vbRQ},然后选择 {vbLQ}使用我的密码{vbRQ}。{vbCrLf}如果没有该选项,请选择 {vbLQ}设置密码{vbRQ},设置完毕后再登录。",
- "需要使用密码登录", "重新登录", "设置密码", "取消",
- Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
- GoTo Retry
- Else
- Throw New OperationCanceledException
- End If
- ElseIf TypeOf Converter.Result Is Exception Then
- Throw CType(Converter.Result, Exception)
- Else
- Return (Converter.Result(0), Converter.Result(1))
- End If
- End Function
- '微软登录步骤 1,刷新登录:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
- Private Function MsLoginStep1Refresh(Code As String) As (OAuthAccessToken As String, OAuthRefreshToken As String)
- McLaunchLog("开始微软登录步骤 1/6(刷新登录)")
- Dim Result As String
- Try
- Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post,
- Content:=$"client_id={OAuthClientId}&refresh_token={StringUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
- ContentType:="application/x-www-form-urlencoded",
- Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
- ThreadCount:=2)
- Catch ex As HttpRequestCodeException
- '修改错误列表时,同时检查 MyMsgLogin.xaml.vb 中的对应代码
- Dim Response = ex.Response
- If Response.ContainsIgnoreCase("must sign in again") OrElse Response.ContainsIgnoreCase("password expired") OrElse
- (Response.Contains("refresh_token") AndAlso Response.ContainsIgnoreCase("is not valid")) OrElse '#269
- Response.ContainsIgnoreCase("expired") Then '#8611
- Return ("Relogin", "")
- ElseIf Response.Contains("Account security interrupt") Then
- MyMsgBox("该账号由于安全问题无法登陆,请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
- Throw New OperationCanceledException
- ElseIf Response.Contains("service abuse") Then
- MyMsgBox("非常抱歉,该账号已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
- Throw New OperationCanceledException
- Else
- Throw
- End If
- End Try
- Dim ResultJson As JObject = Result.DeserializeJson()
- Dim AccessToken As String = ResultJson("access_token").ToString
- Dim RefreshToken As String = ResultJson("refresh_token").ToString
- Return (AccessToken, RefreshToken)
- End Function
- '微软登录步骤 2:从 OAuth AccessToken 获取 XBLToken
- Private Function MsLoginStep2(AccessToken As String) As String
- McLaunchLog("开始微软登录步骤 2/6")
- Dim Request As String = "{
- ""Properties"": {
- ""AuthMethod"": ""RPS"",
- ""SiteName"": ""user.auth.xboxlive.com"",
- ""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """
- },
- ""RelyingParty"": ""http://auth.xboxlive.com"",
- ""TokenType"": ""JWT""
- }"
- Return NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
- Content:=Request, ContentType:="application/json", RequireJson:=True).DeserializeJson()("Token").ToString
- End Function
- '微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS}
- Private Function MsLoginStep3(XBLToken As String) As (XSTSToken As String, UHS As String)
- McLaunchLog("开始微软登录步骤 3/6")
- Dim Request As String = "{
- ""Properties"": {
- ""SandboxId"": ""RETAIL"",
- ""UserTokens"": [""" & XBLToken & """]
- },
- ""RelyingParty"": ""rp://api.minecraftservices.com/"",
- ""TokenType"": ""JWT""
- }"
- Dim Result As String
- Try
- Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post,
- Content:=Request, ContentType:="application/json", RequireJson:=True)
- Catch ex As HttpRequestCodeException
- '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
- If ex.Response.Contains("2148916227") Then
- MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
- Throw New OperationCanceledException
- ElseIf ex.Response.Contains("2148916233") Then
- If MyMsgBox("你尚未注册 Xbox 账户,请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
- OpenWebsite("https://signup.live.com/signup")
- End If
- Throw New OperationCanceledException
- ElseIf ex.Response.Contains("2148916235") Then
- MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN,然后再试。", "登录失败", "我知道了")
- Throw New OperationCanceledException
- ElseIf ex.Response.Contains("2148916238") Then
- If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
- "该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
- OpenWebsite("https://account.live.com/editprof.aspx")
- MyMsgBox("请在打开的网页中修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
- "在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示")
- Else
- OpenWebsite("https://support.microsoft.com/zh-cn/account-billing/如何更改-microsoft-帐户上的出生日期-837badbc-999e-54d2-2617-d19206b9540a")
- MyMsgBox("请根据打开的网页的说明,修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
- "在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示")
- End If
- Throw New OperationCanceledException
- Else
- Throw
- End If
- End Try
- Dim ResultJson As JObject = Result.DeserializeJson()
- Return (
- ResultJson("Token").ToString(), 'XSTSToken
- ResultJson("DisplayClaims")("xui")(0)("uhs").ToString() 'UHS
- )
- End Function
- '微软登录步骤 4:从 {XSTSToken, UHS} 获取 {Minecraft AccessToken, 过期于 (Unix 时间戳)}
- Private Function MsLoginStep4(Tokens As (XSTSToken As String, UHS As String)) As (AccessToken As String, ExpiresAt As Integer)
- McLaunchLog("开始微软登录步骤 4/6")
- Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens.UHS};{Tokens.XSTSToken}")).ToString(0)
- Dim Result As String
- Try
- Result = NetRequestByClientRetry("https://api.minecraftservices.com/authentication/login_with_xbox", HttpMethod.Post,
- Content:=Request, ContentType:="application/json", RequireJson:=True)
- Catch ex As HttpRequestCodeException
- If ex.StatusCode = 429 Then
- Logger.Warn(ex, "微软登录第 4 步汇报 429")
- Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
- ElseIf ex.StatusCode = HttpStatusCode.Forbidden Then
- Logger.Warn(ex, "微软登录第 4 步汇报 403")
- Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器,请把它们关掉或更换节点后再试!")
- ElseIf ex.StatusCode = HttpStatusCode.ServiceUnavailable Then
- Logger.Warn(ex, "微软登录第 4 步汇报 503")
- Throw New Exception("$Mojang 服务器出现问题,请稍后再试。" & vbCrLf & "你的网络是正常的,PCL 也是正常的,是 Mojang 出问题了……")
- ElseIf ex.Response?.Contains("ACCOUNT_SUSPENDED") Then '#8655
- MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
- Throw New OperationCanceledException
- Else
- Throw
- End If
- End Try
- Dim ResultJson As JObject = Result.DeserializeJson()
- Return (
- ResultJson("access_token").ToString,
- ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 1200) '提前 20 分钟视作过期
- End Function
- '微软登录步骤 5:验证微软账号是否持有 MC,这也会刷新 XGP
- Private Sub MsLoginStep5(AccessToken As String)
- McLaunchLog("开始微软登录步骤 5/6")
- Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
- ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
- Try
- Dim ResultJson As JObject = Result.DeserializeJson()
- If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
- Select Case MyMsgBox("你尚未购买正版 Minecraft,或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
- Case 1
- OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
- End Select
- Throw New OperationCanceledException
- End If
- Catch ex As Exception
- Logger.Warn(ex, $"微软登录第 5 步异常:{Result}")
- Throw
- End Try
- End Sub
- '微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
- Private Function MsLoginStep6(AccessToken As String) As (UUID As String, UserName As String, ProfileJson As String)
- McLaunchLog("开始微软登录步骤 6/6")
- Dim Result As String
- Try
- Result = NetRequestByClientMultiple("https://api.minecraftservices.com/minecraft/profile",
- ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
- Catch ex As HttpRequestCodeException
- Select Case ex.StatusCode
- Case 429
- Logger.Warn(ex, "微软登录第 6 步汇报 429")
- Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
- Case HttpStatusCode.NotFound
- Logger.Warn(ex, "微软登录第 6 步汇报 404")
- RunInNewThread(
- Sub()
- Select Case MyMsgBox("请先创建 Minecraft 玩家档案,然后再重新登录。", "登录失败", "创建档案", "取消")
- Case 1
- OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
- End Select
- End Sub, "Login Failed: Create Profile")
- Throw New OperationCanceledException
- Case Else
- Throw
- End Select
- End Try
- Dim ResultJson As JObject = Result.DeserializeJson()
- Dim UUID As String = ResultJson("id").ToString
- Dim UserName As String = ResultJson("name").ToString
- Return (UUID, UserName, Result)
- End Function
- '返回符合离线皮肤设置的 UUID
- Private Function McLoginLegacyUuidWithCustomSkin(UserName As String, SkinType As Integer, SkinName As String) As String
- Dim Uuid As String = McLoginLegacyUuid(UserName)
- '根据离线皮肤获取实际使用的 Uuid
- Select Case SkinType
- Case 0
- '默认,不需要处理
- Case 1
- 'Steve
- Do Until McSkinSex(Uuid) = "Steve"
- If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
- Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
- Loop
- Case 2
- 'Alex
- Do Until McSkinSex(Uuid) = "Alex"
- If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
- Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
- Loop
- Case 3
- '使用正版用户名
- Try
- If SkinName <> "" AndAlso
- McInstanceSelected IsNot Nothing AndAlso McInstanceSelected.Version.Vanilla.Major < 20 Then '1.20+ 或快照版不能使用该项(#3746)
- Logger.Info($"由于离线皮肤设置,使用正版 UUID:{SkinName}")
- Uuid = McLoginMojangUuid(SkinName, False)
- End If
- Catch ex As Exception
- Logger.Error(ex, "皮肤信息获取失败,游戏将以无皮肤的方式启动", LogBehavior.Toast)
- End Try
- Case 4
- '自定义
- Do Until McSkinSex(Uuid) = If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "Alex", "Steve")
- If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
- Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
- Loop
- End Select
- Return Uuid
- End Function
- '根据用户名返回对应 UUID,需要多线程
- Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean)
- If Name.Trim.Length = 0 Then Return New String("0"c, 32)
- '从缓存获取
- Dim Uuid As String = ReadIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, "")
- If Len(Uuid) = 32 Then Return Uuid
- '从官网获取
- Try
- Dim GotJson As JObject = NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True).DeserializeJson()
- If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在(" & Name & ")")
- Uuid = If(GotJson("id"), "")
- Catch ex As Exception
- Logger.Warn(ex, $"从官网获取正版 Uuid 失败({Name})")
- If Not ThrowOnNotFound AndAlso ex.GetType.Name = "FileNotFoundException" Then
- Uuid = McLoginLegacyUuid(Name) '玩家档案不存在
- Else
- Throw New Exception("从官网获取正版 Uuid 失败", ex)
- End If
- End Try
- '写入缓存
- If Not Len(Uuid) = 32 Then Throw New Exception("获取的正版 Uuid 长度不足(" & Uuid & ")")
- WriteIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, Uuid)
- Return Uuid
- End Function
- Public Function McLoginLegacyUuid(Name As String)
- Dim FullUuid As String = Name.Length.ToString("X").EnsureLength("0", 16) & Name.GetStableHashCode().ToString("X").EnsureLength("0", 16)
- Return FullUuid.Substring(0, 12) & "3" & FullUuid.Substring(13, 3) & "9" & FullUuid.Substring(17, 15)
- End Function
- #End Region
- #Region "Java 处理"
- Public McLaunchJavaSelected As Java = Nothing
- Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer))
- McLaunchJavaSelected = SelectOrDownloadJava(McInstanceSelected, True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider)
- If Task.IsCanceled Then Return
- If McLaunchJavaSelected Is Nothing Then Throw New OperationCanceledException 'SelectOrDownloadJava 已经会给予适当的提示
- If ModeDebug Then
- McLaunchLog($"预期 Java 版本范围:{GetJavaRequirement(McInstanceSelected).Range}")
- McLaunchLog($"Java 版本设置类别:{Settings.Get(Of Integer)("VersionArgumentJavaV2", McInstanceSelected)}")
- End If
- McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
- End Sub
- #End Region
- #Region "启动参数"
- Private McLaunchArgument As String
- '主方法
- Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, Integer))
- '获取基础参数
- Dim Arguments As New List(Of String)
- McLaunchLog("参数获取开始")
- Arguments.AddRange(McLaunchArgumentsJVM()) 'JVM 参数
- Arguments.Add(McInstanceSelected.JsonObject("mainClass")) 'mainClass
- Arguments.AddRange(McLaunchArgumentsGame()) '游戏参数
- '替换
- McLaunchLog("=================== 启动参数开始 ===================")
- Dim Replacements = McLaunchArgumentsReplace(Arguments).ToList
- Dim Argument As String = ""
- For Each Arg In Arguments
- '应用替换标记
- For Each Replacement In Replacements
- Arg = Arg.Replace(Replacement.Key, Replacement.Value)
- Next
- '为带特殊字符的参数添加双引号
- If Arg.IndexOfAny({"&"c, "|"c, "<"c, ">"c, "^"c, " "c}) >= 0 AndAlso Not Arg.StartsWithF("""") AndAlso Not Arg.EndsWithF("""") Then
- Arg = $"""{Arg.Replace("""", "\""")}""" '转义在原本参数中间的双引号
- End If
- '输出
- McLaunchLog(Arg)
- Argument &= Arg & " "
- Next
- McLaunchLog("=================== 启动参数结束 ===================")
- '输出
- McLaunchArgument = Argument.TrimEnd
- End Sub
- 'JVM 部分
- Private Function McLaunchArgumentsJVM() As List(Of String)
- Dim Args As New List(Of String)
- 'Minecraft 参数
- If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("jvm") IsNot Nothing Then
- '新版 MC:从版本 JSON 获取参数
- Dim CurrentInstance As McInstance = McInstanceSelected
- NextInstance:
- McLaunchLog($"新版 JVM 参数:从版本 JSON 获取({CurrentInstance.Name})")
- If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("jvm") IsNot Nothing Then
- For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("jvm")
- Select Case SubJson.Type
- Case JTokenType.String
- Args.Add(SubJson.ToString.Trim)
- Case JTokenType.Object
- Dim Argument As JObject = CType(SubJson, JObject)
- If Argument.ContainsKey("rules") AndAlso Not McJsonRuleCheck(Argument("rules")) Then Continue For '不满足准则
- If Not Argument.ContainsKey("value") Then Continue For '没有 value 字段
- If Argument("value").Type = JTokenType.String Then
- Args.Add(Argument("value").ToString.Trim)
- Else
- For Each value As JToken In Argument("value")
- Args.Add(value.ToString.Trim)
- Next
- End If
- End Select
- Next
- End If
- If CurrentInstance.InheritName <> "" Then
- CurrentInstance = New McInstance(CurrentInstance.InheritName)
- GoTo NextInstance
- End If
- '1.17.1 中有个 "-Dos.name=Windows 10",不立即加双引号会导致 10 被隔开
- Args = Args.Select(Function(a) If(a.Contains(" ") AndAlso Not a.StartsWithF("""") AndAlso Not a.EndsWithF(""""), $"""{a.Replace("""", "\""")}""", a)).ToList
- Else
- '旧版 MC:直接添加参数
- McLaunchLog($"旧版 JVM 参数")
- Args.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump")
- Args.Add("-Djava.library.path=${natives_directory}")
- Args.Add("-cp") : Args.Add("${classpath}")
- End If
- '设置里自定义的参数
- Dim CustomArg As String = Settings.Get(Of String)("VersionAdvanceJvm", Instance:=McInstanceSelected)
- If CustomArg = "" Then CustomArg = Settings.Get(Of String)("LaunchAdvanceJvm")
- If CustomArg <> "" Then CustomArg = ArgumentReplace(CustomArg)
- '重新分割字符串并去重
- Args = DeduplicateJavaArguments(SplitJavaArguments(Args.Join(" "c).Replace("McEmu= ", "McEmu=") & " " & CustomArg).ToList, True)
- '统一通行证
- If McLoginLoader.Output.Type = "Nide" Then
- Args.Add("-javaagent:""${pure_directory}\nide8auth.jar""=""" & Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected) & """")
- End If
- 'Authlib-Injector
- If McLoginLoader.Output.Type = "Auth" Then
- If McLaunchJavaSelected.Version.Major >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#)
- Dim Server As String = Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)
- Try
- McLaunchLog($"开始 Authlib Injector Prefetch")
- Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
- Args.Add("-javaagent:""${pure_directory}\authlib-injector.jar""=""" & Server & """")
- Args.Add("-Dauthlibinjector.side=client")
- Args.Add("-Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
- Catch ex As Exception
- Throw New Exception("无法连接到第三方登录服务器(" & If(Server, Nothing) & ")", ex)
- End Try
- End If
- 'JLW
- '非 GBK 编码下命令行参数乱码的问题(JDK-8272352)
- Dim UseJLW As Boolean =
- Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableJLW", McInstanceSelected) AndAlso
- Not IsGBKEncoding '即使游戏文件夹名称不含非 ASCII 字符,但玩家名等也可能出现中文,因此依然需要 JLW(#8739)
- If UseJLW AndAlso CustomArg.Contains("-javaagent") Then
- UseJLW = False
- McLaunchLog("由于使用了自定义 javaagent,已禁用 JLW,这可能导致游戏崩溃!", LogLevel.Warn)
- End If
- If UseJLW Then
- If McLaunchJavaSelected.Version.Major >= 9 Then
- Args.Add("--add-exports") : Args.Add("cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
- End If
- Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾
- End If
- McLaunchLog("使用 JLW:" & UseJLW)
- 'LUA
- Dim UseLUA As Boolean =
- Not Settings.Get(Of Boolean)("LaunchAdvanceDisableLUA") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableLUA", McInstanceSelected) AndAlso
- McLibListGet(McInstanceSelected, False).Any(Function(e) e.OriginalName = "org.lwjgl:lwjgl:3.4.1")
- If UseLUA Then Args.Add($"-javaagent:""{ExtractPatch("LUA")}""")
- McLaunchLog("使用 LUA:" & UseLUA)
- #Region "内存管理"
- McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
- Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024)
- Args.Add("-Xmx" & TargetRam & "m")
- '获取设置的管理方式
- '0:在 Java 21+ 使用分代 ZGC,20~15 使用非分代的 ZGC,14- 使用 G1GC
- '1:在 Java 21+ 使用分代 ZGC,20- 使用 G1GC
- '2:仅 G1GC
- '3:不指定,玩家自定义
- Dim SetupType As Integer = Settings.Get(Of Integer)("LaunchAdvanceGC")
- If McInstanceSelected IsNot Nothing AndAlso Settings.Get(Of Integer)("VersionAdvanceGC", McInstanceSelected) > 0 Then SetupType = Settings.Get(Of Integer)("VersionAdvanceGC", McInstanceSelected) - 1 '去掉默认
- If SetupType <> 3 Then
- '确定是使用 G1GC 还是 ZGC
- Dim UseG1GC As Boolean = False
- If (SetupType = 0 AndAlso McLaunchJavaSelected.Version.Major < 15) OrElse
- (SetupType = 1 AndAlso McLaunchJavaSelected.Version.Major < 21) OrElse
- (SetupType = 2 OrElse SetupType = 4) Then UseG1GC = True '检查 Java 版本,ZGC 在 Java 15+ 可用,分代 ZGC 在 Java 21+ 可用
- If Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性,ZGC 需要 Windows 10 1809+
- McLaunchLog($"GC 设置:{SetupType},选取 {If(UseG1GC, "G1GC", "ZGC")},Java 版本:{McLaunchJavaSelected.Version.Major}")
- '移除已有的 GC 参数
- Args = Args.Where(Function(a) Not a.RegexCheck(
- "( )*-XX:[+-]?(Use\w+GC|ZGenerational|UseCompactObjectHeaders|G1\w+Percent|G1\w+Size|(Max|Min)(GCPauseMillis|HeapFreeRatio))")).ToList
- '添加 GC 参数
- Args.Add("-XX:+UnlockExperimentalVMOptions")
- If McLaunchJavaSelected.Version.Major >= 24 Then Args.Add("-XX:+UseCompactObjectHeaders")
- If UseG1GC AndAlso SetupType = 4 Then
- '优化的 G1GC
- Args.Add("-XX:+UseG1GC")
- Args.Add("-XX:G1NewSizePercent=20")
- Args.Add("-XX:G1ReservePercent=20")
- Args.Add("-XX:G1HeapRegionSize=32M")
- Args.Add("-XX:MaxGCPauseMillis=50")
- If Not ModeDebug Then Args.Add("-XX:+PerfDisableSharedMem")
- If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
- If McLaunchJavaSelected.Version.Major = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
- If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
- If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
- ElseIf UseG1GC Then
- 'Mojang G1GC
- Args.Add("-XX:+UseG1GC")
- Args.Add("-XX:G1NewSizePercent=20")
- Args.Add("-XX:G1ReservePercent=20")
- Args.Add("-XX:G1HeapRegionSize=32M")
- Args.Add("-XX:MaxGCPauseMillis=50")
- If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
- Else
- 'ZGC
- Args.Add("-XX:+UseZGC")
- If McLaunchJavaSelected.Version.Major = 21 OrElse McLaunchJavaSelected.Version.Major = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC,不需要再添加参数
- End If
- End If
- Args.Remove("-XX:MaxDirectMemorySize=256M") '#3511 的清理
- #End Region
- 'Log4j 漏洞防御参数
- Args.Add("-Dlog4j2.formatMsgNoLookups=true")
- '编码(#4700、#5892、#5909)
- If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
- If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
- If McLaunchJavaSelected.Version.Major >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面(#6934)
- '为 JLW 添加 -jar,它必须放在最后
- If UseJLW Then
- Args.Add("-jar") : Args.Add(ExtractPatch("JavaWrapper"))
- End If
- '再次去重并输出
- Return DeduplicateJavaArguments(Args, True)
- End Function
- '游戏参数部分
- Private Function McLaunchArgumentsGame() As List(Of String)
- Dim Arg As String = ""
- 'Minecraft 参数
- '旧版 MC:直接添加参数
- If McInstanceSelected.JsonObject("minecraftArguments")?.ToString.Any Then
- Dim BasicString As String = McInstanceSelected.JsonObject("minecraftArguments").ToString
- McLaunchLog($"旧版游戏参数:" & BasicString)
- BasicString += " --height ${resolution_height} --width ${resolution_width}" '总是添加宽高选项,之后去重的时候会覆盖 MC 自带的
- Arg &= " " & BasicString
- End If
- '新版 MC:从版本 JSON 获取参数
- If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("game") IsNot Nothing Then
- Dim CurrentInstance As McInstance = McInstanceSelected
- Dim AppendArg = Sub(a As String) Arg &= " " & If(a.Contains(" ") AndAlso Not a.StartsWithF("""") AndAlso Not a.EndsWithF(""""), $"""{a.Replace("""", "\""")}""", a)
- NextInstance:
- McLaunchLog($"新版游戏参数:从版本 JSON 获取({CurrentInstance.Name})")
- If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("game") IsNot Nothing Then
- For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("game")
- Select Case SubJson.Type
- Case JTokenType.String
- AppendArg(SubJson.ToString)
- Case JTokenType.Object
- Dim Argument As JObject = CType(SubJson, JObject)
- If Argument.ContainsKey("rules") AndAlso Not McJsonRuleCheck(Argument("rules")) Then Continue For '不满足准则
- If Not Argument.ContainsKey("value") Then Continue For '没有 value 字段
- If Argument("value").Type = JTokenType.String Then
- AppendArg(Argument("value").ToString)
- Else
- For Each value As JToken In Argument("value")
- AppendArg(value.ToString)
- Next
- End If
- End Select
- Next
- End If
- If CurrentInstance.InheritName <> "" Then
- CurrentInstance = New McInstance(CurrentInstance.InheritName)
- GoTo NextInstance
- End If
- End If
- '设置里自定义的参数
- Dim CustomArg As String = Settings.Get(Of String)("VersionAdvanceGame", Instance:=McInstanceSelected)
- If CustomArg = "" Then CustomArg = Settings.Get(Of String)("LaunchAdvanceGame")
- If CustomArg <> "" Then CustomArg = ArgumentReplace(CustomArg)
- Arg &= " " & CustomArg
- '把 OptiFineForgeTweaker 放在参数的末尾
- If (McInstanceSelected.Version.HasForge OrElse McInstanceSelected.Version.HasLiteLoader) AndAlso McInstanceSelected.Version.HasOptiFine Then
- If Arg.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
- McLaunchLog("发现正确的 OptiFineForge TweakClass,目前的游戏参数:" & Arg)
- Arg = Arg.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
- End If
- If Arg.Contains("--tweakClass optifine.OptiFineTweaker") Then
- McLaunchLog("发现错误的 OptiFineForge TweakClass,目前的游戏参数:" & Arg)
- Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
- Try
- FileUtils.Write(
- McInstanceSelected.GetJsonPath(),
- FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
- Catch ex As Exception
- Logger.Warn(ex, "替换 OptiFineForge TweakClass 失败")
- End Try
- End If
- End If
- '重新分割字符串并去重
- Dim Args As List(Of String) = DeduplicateJavaArguments(SplitJavaArguments(Arg).ToList, False)
- '额外传入的参数
- Args.AddRange(CurrentLaunchOptions.ExtraGameArgs)
- '全屏
- If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 0 Then Args.Add("--fullscreen")
- '自动进入服务器
- Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Settings.Get(Of String)("VersionServerEnter", McInstanceSelected), CurrentLaunchOptions.ServerIp)
- If Server.Any Then
- If McInstanceSelected.ReleaseTime > New Date(2023, 4, 4) Then
- 'QuickPlay
- Args.Add($"--quickPlayMultiplayer") : Args.Add(Server)
- Else
- '老版本
- If Server.Contains(":") Then
- '包含端口号
- Args.Add("--server") : Args.Add(Server.Split(":")(0))
- Args.Add("--port") : Args.Add(Server.Split(":")(1))
- Else
- '不包含端口号
- Args.Add("--server") : Args.Add(Server)
- Args.Add("--port") : Args.Add("25565")
- End If
- If McInstanceSelected.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Red)
- End If
- End If
- '再次去重并输出
- Return DeduplicateJavaArguments(Args, False)
- End Function
- '获取替换标记
- Private Iterator Function McLaunchArgumentsReplace(Arguments As List(Of String)) As IEnumerable(Of (Key As String, Value As String))
- '基础参数
- Yield ("${classpath_separator}", ";")
- Yield ("${natives_directory}", GetNativesFolder().TrimEnd("\"c))
- Yield ("${library_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
- Yield ("${libraries_directory}", PathUtils.ToShortPath(McFolderSelected & "libraries"))
- Yield ("${pure_directory}", PathPure.TrimEnd("\"c)) '由 PCL 添加,这会允许在分割参数并去重后再替换路径,防止路径中的特殊字符影响参数分割和去重
- Yield ("${launcher_name}", "PCL")
- Yield ("${launcher_version}", VersionCode)
- Yield ("${version_name}", McInstanceSelected.Name)
- Yield ("${game_directory}", PathUtils.ToShortPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
- Yield ("${assets_root}", PathUtils.ToShortPath(McFolderSelected & "assets"))
- Yield ("${user_properties}", "{}")
- Yield ("${auth_player_name}", McLoginLoader.Output.Name)
- Yield ("${auth_uuid}", McLoginLoader.Output.Uuid)
- Yield ("${auth_access_token}", McLoginLoader.Output.AccessToken)
- Yield ("${access_token}", McLoginLoader.Output.AccessToken)
- Yield ("${auth_session}", McLoginLoader.Output.AccessToken)
- Yield ("${user_type}", "msa") '#1221
- Yield ("${primary_jar}", PathUtils.ToShortPath(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".jar")) '#6942
- Yield ("${game_assets}", PathUtils.ToShortPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
- Yield ("${assets_index_name}", McAssetsGetIndexName(McInstanceSelected))
- '自定义信息
- Dim ArgumentInfo As String
- ArgumentInfo = Settings.Get(Of String)("VersionArgumentInfo", Instance:=McInstanceSelected)
- If ArgumentInfo = "" Then ArgumentInfo = Settings.Get(Of String)("LaunchArgumentInfo")
- If ArgumentInfo = "" Then '若自定义信息为空,则必须从参数中去掉该部分,不然 MC 会显示 ${version_type} 或者一个空字符串
- If Arguments.Contains("--versionType") Then
- Dim Index As Integer = Arguments.IndexOf("--versionType")
- Arguments.RemoveAt(Index)
- If Index < Arguments.Count Then Arguments.RemoveAt(Index)
- End If
- Yield ("${version_type}", """""")
- Else
- Yield ("${version_type}", ArgumentReplace(ArgumentInfo))
- End If
- '窗口尺寸
- Dim TargetSize As Size
- Select Case Settings.Get(Of Integer)("LaunchArgumentWindowType")
- Case 2 '与启动器尺寸一致
- Dim Result As Size
- RunInUiWait(Sub() Result = New Size(GetPixelSize(FrmMain.PanForm.ActualWidth), GetPixelSize(FrmMain.PanForm.ActualHeight)))
- TargetSize = Result
- TargetSize.Height -= 29.5 * DPI / 96 '标题栏高度
- Case 3 '自定义
- TargetSize = New Size(Math.Max(100, Settings.Get(Of Integer)("LaunchArgumentWindowWidth")), Math.Max(100, Settings.Get(Of Integer)("LaunchArgumentWindowHeight")))
- Case Else
- TargetSize = New Size(854, 480)
- End Select
- If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
- McLaunchJavaSelected.Version >= New Version(8, 0, 200) AndAlso McLaunchJavaSelected.Version <= New Version(8, 0, 321) AndAlso
- Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍(#3463)
- McLaunchLog($"已应用窗口大小过大修复(Java 版本:{McLaunchJavaSelected.Version})")
- TargetSize.Width /= DPI / 96
- TargetSize.Height /= DPI / 96
- End If
- Yield ("${resolution_width}", Math.Round(TargetSize.Width))
- Yield ("${resolution_height}", Math.Round(TargetSize.Height))
- '支持库
- Dim Cps As New List(Of String)
- Dim OptiFineCp As String = Nothing
- For Each Library As McLibEntry In McLibListGet(McInstanceSelected, True)
- If Library.IsNatives Then Continue For
- If Library.Name IsNot Nothing AndAlso Library.Name = "optifine:OptiFine" Then
- OptiFineCp = Library.LocalPath
- Else
- Cps.Add(Library.LocalPath)
- End If
- Next
- If OptiFineCp IsNot Nothing Then Cps.Insert(Cps.Count - 2, OptiFineCp) 'OptiFine 的总是需要放到倒数第二位
- Yield ("${classpath}", Cps.Select(Function(c) PathUtils.ToShortPath(c)).Join(";"c))
- End Function
- ''' <summary>
- ''' 分割 Java 参数字符串。
- ''' </summary>
- Private Iterator Function SplitJavaArguments(Arg As String) As IEnumerable(Of String)
- Arg = Arg.ReplaceLineEndings(" ", mergeMultiple:=True).Trim '预处理换行符
- If String.IsNullOrWhiteSpace(Arg) Then Return
- Dim Current As New StringBuilder
- Dim InQuotes As Boolean = False
- Dim i As Integer = 0
- While i < Arg.Length
- Dim c As Char = Arg(i)
- If c = "\"c AndAlso i + 1 < Arg.Length AndAlso Arg(i + 1) = """"c Then '检测 \"
- '转义的双引号:保留反斜杠和引号,不切换 InQuotes
- Current.Append("\""")
- i += 1 '额外跳过下一个字符(双引号)
- ElseIf c = """"c Then
- '未转义的双引号:切换 InQuotes
- InQuotes = Not InQuotes
- Current.Append(c)
- ElseIf c = " "c AndAlso Not InQuotes Then
- '不在双引号内的空格:一个参数结束
- If Current.Length > 0 Then
- Yield Current.ToString()
- Current.Clear()
- End If
- Else
- '普通字符,直接添加
- Current.Append(c)
- End If
- i += 1
- End While
- If Current.Length > 0 Then Yield Current.ToString '添加剩余的
- End Function
- ''' <summary>
- ''' 对 Java 参数进行去重。
- ''' </summary>
- Private Function DeduplicateJavaArguments(Args As List(Of String), IsJVMArgs As Boolean) As List(Of String)
- Dim Result As New List(Of String)
- Dim i As Integer = 0
- While i < Args.Count
- Dim Key As String = Args(i)
- If Not Key.StartsWithF("-") OrElse
- (i + 1 >= Args.Count OrElse (Args(i + 1).StartsWithF("-") AndAlso Val(Args(i + 1).AfterFirst("-")) = 0)) Then '避免 -xPos 23 -xPos -50 中后面的 -50 被识别为参数
- '单参数
- i += 1
- If Result.Contains(Key) Then
- McLaunchLog($"已去重单个{If(IsJVMArgs, " JVM ", "游戏")}参数:{Key}")
- Continue While
- End If
- Result.Add(Key)
- Else
- '以空格间隔的键值对(例如 --width 233)
- Dim Value As String = Args(i + 1)
- i += 2
- For j = 0 To Result.Count - 2 '向前寻找相同的键
- If Result(j) <> Key Then Continue For
- '仅当是游戏参数且不是 tweakClass 时,用新的值覆盖旧的值
- '据测试,如果包含多个相同 --width 或 --uuid 等参数,两个都会直接失效,如果这发生在关键参数上会导致崩溃
- If Not IsJVMArgs AndAlso Key <> "--tweakClass" Then
- McLaunchLog($"已覆盖重复的{If(IsJVMArgs, " JVM ", "游戏")}参数:{Key} {Result(j + 1)} → {Key} {Value}")
- Result(j + 1) = Value
- Continue While
- End If
- '键和值完全相同,直接抛弃
- If Result(j + 1) = Value Then
- McLaunchLog($"已去重{If(IsJVMArgs, " JVM ", "游戏")}参数对:{Key} {Value}")
- Continue While
- End If
- Next
- Result.Add(Key)
- Result.Add(Value)
- End If
- End While
- Return Result
- End Function
- #End Region
- #Region "解压 Natives"
- Private Sub McLaunchNatives(Loader As LoaderTask(Of Integer, Integer))
- '创建文件夹
- Dim Target As String = GetNativesFolder()
- DirectoryUtils.Create(Target)
- '解压文件
- McLaunchLog("正在解压 Natives 文件")
- Dim ExistFiles As New List(Of String)
- For Each Native As McLibEntry In McLibListGet(McInstanceSelected, True)
- If Not Native.IsNatives Then Continue For
- Dim Zip As ZipArchive
- Try
- Zip = FileUtils.OpenZip(Native.LocalPath)
- Catch ex As InvalidDataException
- Logger.Warn(ex, $"打开 Natives 文件失败({Native.LocalPath})")
- FileUtils.Delete(Native.LocalPath)
- Throw New Exception("无法打开 Natives 文件(" & Native.LocalPath & "),该文件可能已损坏,请重新尝试启动游戏")
- End Try
- For Each Entry In Zip.Entries
- Dim FileName As String = Entry.FullName
- If FileName.EndsWithF(".dll", True) Then
- '实际解压文件的步骤
- Dim FilePath As String = Target & FileName
- ExistFiles.Add(FilePath)
- Dim OriginalFile = FileUtils.GetInfo(FilePath)
- If OriginalFile.Exists Then
- If OriginalFile.Length = Entry.Length Then
- If ModeDebug Then McLaunchLog("无需解压:" & FilePath)
- Continue For
- End If
- '删除原文件
- Try
- FileUtils.Delete(FilePath)
- Catch ex As UnauthorizedAccessException
- McLaunchLog("删除原 dll 访问被拒绝,这通常代表有一个 MC 正在运行,跳过解压:" & FilePath)
- McLaunchLog("实际的错误信息:" & ex.GetDisplay(True))
- Exit For
- End Try
- End If
- '解压新文件
- FileUtils.Write(FilePath, Entry.Open)
- McLaunchLog("已解压:" & FilePath)
- End If
- Next
- If Zip IsNot Nothing Then Zip.Dispose()
- Next
- '删除多余文件
- For Each FileName As String In DirectoryUtils.EnumerateFiles(Target)
- If ExistFiles.Contains(FileName) Then Continue For
- Try
- McLaunchLog("删除:" & FileName)
- FileUtils.Delete(FileName)
- Catch ex As UnauthorizedAccessException
- McLaunchLog("删除多余文件访问被拒绝,跳过删除步骤")
- McLaunchLog("实际的错误信息:" & ex.GetDisplay(True))
- Return
- End Try
- Next
- End Sub
- ''' <summary>
- ''' 获取 Natives 文件夹路径,以 \ 结尾。
- ''' </summary>
- Private Function GetNativesFolder() As String
- Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\"
- If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
- Result = Paths.AppData & ".minecraft\bin\natives\"
- If Not Result.IsAsciiOnly() Then
- Result = OsDrive & "ProgramData\PCL\natives\"
- End If
- End If
- DirectoryUtils.Create(Result) '提前创建,这样 DirectoryUtils.Shorten 才有结果(否则在长路径下首次启动 Forge 会崩溃)
- Return PathUtils.AddSlashSuffix(PathUtils.ToShortPath(Result))
- End Function
- #End Region
- #Region "启动与前后处理"
- Private Sub McLaunchPrerun()
- '使用高性能显卡
- If Settings.Get(Of Boolean)("LaunchAdvanceGraphicCard") Then
- Try
- SetGPUPreference(McLaunchJavaSelected.JavaExePath)
- SetGPUPreference(PathExe)
- Catch ex As Exception
- If WindowsUtils.HasAdminRole() Then
- Logger.Warn(ex, "直接调整显卡设置失败")
- Else
- Logger.Warn(ex, "直接调整显卡设置失败,将以管理员权限重启 PCL 再次尝试")
- Try
- If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.JavaExePath}""") = ProcessReturnValues.TaskDone Then
- McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
- Else
- Throw New Exception("调整过程中出现异常")
- End If
- Catch exx As Exception
- Logger.Error(exx, "调整显卡设置失败,Minecraft 可能会使用默认显卡运行", LogBehavior.Toast)
- End Try
- End If
- End Try
- End If
- '更新 launcher_profiles.json
- Try
- '确保可用
- If Not McLoginLoader.Output.Type = "Microsoft" Then Exit Try
- McFolderLauncherProfilesJsonCreate(McFolderSelected)
- '构建需要替换的 Json 对象
- Dim ReplaceJsonString As String = "
- {
- ""authenticationDatabase"": {
- ""00000111112222233333444445555566"": {
- ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
- ""profiles"": {
- ""66666555554444433333222221111100"": {
- ""displayName"": """ & McLoginLoader.Output.Name & """
- }
- }
- }
- },
- ""clientToken"": """ & McLoginLoader.Output.ClientToken & """,
- ""selectedUser"": {
- ""account"": ""00000111112222233333444445555566"",
- ""profile"": ""66666555554444433333222221111100""
- }
- }"
- Dim ReplaceJson As JObject = (ReplaceJsonString).DeserializeJson()
- '更新文件
- Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
- Profiles.Merge(ReplaceJson)
- FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
- McLaunchLog("已更新 launcher_profiles.json")
- Catch ex As Exception
- Logger.Warn(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试")
- Try
- FileUtils.Delete(McFolderSelected & "launcher_profiles.json")
- McFolderLauncherProfilesJsonCreate(McFolderSelected)
- '构建需要替换的 Json 对象
- Dim ReplaceJsonString As String = "
- {
- ""authenticationDatabase"": {
- ""00000111112222233333444445555566"": {
- ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
- ""profiles"": {
- ""66666555554444433333222221111100"": {
- ""displayName"": """ & McLoginLoader.Output.Name & """
- }
- }
- }
- },
- ""clientToken"": """ & McLoginLoader.Output.ClientToken & """,
- ""selectedUser"": {
- ""account"": ""00000111112222233333444445555566"",
- ""profile"": ""66666555554444433333222221111100""
- }
- }"
- Dim ReplaceJson As JObject = ReplaceJsonString.DeserializeJson()
- '更新文件
- Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
- Profiles.Merge(ReplaceJson)
- FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
- McLaunchLog("已在删除后更新 launcher_profiles.json")
- Catch exx As Exception
- Logger.Error(exx, "更新 launcher_profiles.json 失败")
- End Try
- End Try
- '更新 options.txt
- Dim SetupFileAddress As String = McInstanceSelected.PathIndie & "options.txt"
- If Not FileUtils.Exists(SetupFileAddress) Then
- 'Yosbr Mod 兼容(#2385):https://www.curseforge.com/minecraft/mc-mods/yosbr
- Dim YosbrFileAddress As String = McInstanceSelected.PathIndie & "config\yosbr\options.txt"
- If FileUtils.Exists(YosbrFileAddress) Then
- McLaunchLog("将修改 Yosbr Mod 中的 options.txt")
- SetupFileAddress = YosbrFileAddress
- WriteIni(SetupFileAddress, "lang", "none") '忽略默认语言
- End If
- End If
- Try
- '语言
- '1.0- :没有语言选项
- '1.1 ~ 5 :zh_CN 时正常,zh_cn 时崩溃(最后两位字母必须大写,否则将会 NPE 崩溃)
- '1.6 ~ 10 :zh_CN 时正常,zh_cn 时自动切换为英文
- '1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
- '1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文
- Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
- Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not DirectoryUtils.Exists(McInstanceSelected.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
- If(Settings.Get(Of Boolean)("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.Lower)
- If Not McInstanceSelected.Version.Vaild OrElse McInstanceSelected.Version.Vanilla.Major <= 10 Then
- '将最后两位改为大写,前面的部分保留
- RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).Upper
- End If
- If CurrentLang = RequiredLang Then
- McLaunchLog($"需要的语言为 {RequiredLang},当前语言为 {CurrentLang},无需修改")
- Else
- WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改,避免删除后重新下载残留缓存
- WriteIni(SetupFileAddress, "lang", RequiredLang)
- McLaunchLog($"已将语言从 {CurrentLang} 修改为 {RequiredLang}")
- End If
- ''如果是初次设置,一并修改 forceUnicodeFont
- 'If Settings.Get(Of Boolean)("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not DirectoryUtils.Exists(McInstanceSelected.PathIndie & "saves")) Then
- ' WriteIni(SetupFileAddress, "forceUnicodeFont", "true")
- ' McLaunchLog("已开启 forceUnicodeFont")
- 'End If
- '窗口
- Select Case Settings.Get(Of Integer)("LaunchArgumentWindowType")
- Case 0 '全屏
- WriteIni(SetupFileAddress, "fullscreen", "true")
- Case 1 '默认
- Case Else '其他
- WriteIni(SetupFileAddress, "fullscreen", "false")
- End Select
- Catch ex As Exception
- Logger.Error(ex, "更新 options.txt 失败", LogBehavior.Toast)
- End Try
- '离线皮肤 Alex 警告
- If McInstanceSelected.Version.Vanilla.Major <= 7 AndAlso McInstanceSelected.Version.Vanilla.Major >= 2 AndAlso '1.2 ~ 1.7
- McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
- (Settings.Get(Of Integer)("LaunchSkinType") = 2 OrElse '强制 Alex
- (Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso Settings.Get(Of Boolean)("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
- Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Red)
- End If
- '离线皮肤资源包
- Try
- Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
- Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
- If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
- Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
- Dim PackPicAddress As String = PathTemp & "pack.png"
- Dim PackFormat As Integer
- Select Case McInstanceSelected.Version.Vanilla.Major
- Case 0, 1, 2, 3, 4, 5
- '更早的版本没有资源包
- McLaunchLog("Minecraft 版本过老,尚不支持自定义离线皮肤")
- GoTo IgnoreCustomSkin
- Case 6, 7, 8
- PackFormat = 1
- Case 9, 10
- PackFormat = 2
- Case 11, 12
- PackFormat = 3
- Case 13, 14
- PackFormat = 4
- Case 15
- PackFormat = 5
- Case 16
- PackFormat = 6
- Case 17
- PackFormat = 7
- Case 18
- If McInstanceSelected.Version.Vanilla.Minor <= 2 Then
- PackFormat = 8
- Else
- PackFormat = 9
- End If
- Case 19
- If McInstanceSelected.Version.Vanilla.Minor <= 3 Then
- PackFormat = 9
- Else
- PackFormat = 12
- End If
- Case 20
- If McInstanceSelected.Version.Vanilla.Minor <= 1 Then
- PackFormat = 15
- Else
- PackFormat = 17
- End If
- Case Else '快照版是 9999
- PackFormat = 17
- 'https://zh.minecraft.wiki/w/数据包#数据包版本
- End Select
- McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat)
- '准备文件
- Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
- Bit.Save(PackPicAddress)
- FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
- Dim Skin As New MyBitmap(Paths.AppDataThenName & "CustomSkin.png")
- If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
- McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
- Skin = Skin.Clip(0, 0, 64, 32)
- End If
- Skin.Save(Paths.Base & "PCL\CustomSkin_Cliped.png")
- '构建压缩文件
- Dim FilesToCompress As New Dictionary(Of String, String) From {
- {"pack.mcmeta", MetaFileAddress}, {"pack.png", PackPicAddress}}
- If McInstanceSelected.Version.Vanilla >= New Version(19, 0, 3) Then
- '1.19.3+ 使用复杂版本的替换
- For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
- FilesToCompress.Add(
- $"assets/minecraft/textures/entity/player/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png",
- Paths.Base & "PCL\CustomSkin_Cliped.png")
- Next
- Else
- FilesToCompress.Add(
- $"assets/minecraft/textures/entity/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "alex.png", "steve.png")}",
- Paths.Base & "PCL\CustomSkin_Cliped.png")
- End If
- FileUtils.CreateZipFromFiles(ZipFileAddress, FilesToCompress)
- FileUtils.Delete(Paths.Base & "PCL\CustomSkin_Cliped.png")
- '更改设置文件
- IniClearCache(SetupFileAddress)
- Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
- If NewTypeSetup Then
- If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla"""
- Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
- Dim NewResourcePacks As New List(Of String)
- For Each Res In EnabledResourcePacks
- If Res <> """file/PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res)
- Next
- NewResourcePacks.Add("""file/PCL2 Skin.zip""")
- Dim Result As String = "[" & NewResourcePacks.Join(","c) & "]"
- WriteIni(SetupFileAddress, "resourcePacks", Result)
- Else
- Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
- Dim NewResourcePacks As New List(Of String)
- For Each Res In EnabledResourcePacks
- If Res <> """PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res)
- Next
- NewResourcePacks.Add("""PCL2 Skin.zip""")
- Dim Result As String = "[" & NewResourcePacks.Join(","c) & "]"
- WriteIni(SetupFileAddress, "resourcePacks", Result)
- End If
- IgnoreCustomSkin:
- ElseIf FileUtils.Exists(ZipFileAddress) Then
- McLaunchLog("正在清空自定义皮肤资源包")
- '删除压缩文件
- FileUtils.Delete(ZipFileAddress)
- '更改设置文件
- IniClearCache(SetupFileAddress)
- Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
- If NewTypeSetup Then
- If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla"""
- Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
- EnabledResourcePacks.Remove("""file/PCL2 Skin.zip""")
- Dim Result As String = "[" & EnabledResourcePacks.Join(","c) & "]"
- WriteIni(SetupFileAddress, "resourcePacks", Result)
- Else
- Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(","))
- EnabledResourcePacks.Remove("""PCL2 Skin.zip""")
- Dim Result As String = "[" & EnabledResourcePacks.Join(","c) & "]"
- WriteIni(SetupFileAddress, "resourcePacks", Result)
- End If
- End If
- Catch ex As Exception
- Logger.Error(ex, "离线皮肤资源包设置失败", LogBehavior.Toast)
- End Try
- End Sub
- Private Sub McLaunchCustom(Loader As LoaderTask(Of Integer, Integer))
- '获取自定义命令
- Dim CustomCommandGlobal As String = Settings.Get(Of String)("LaunchAdvanceRun")
- If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
- Dim CustomCommandVersion As String = Settings.Get(Of String)("VersionAdvanceRun", Instance:=McInstanceSelected)
- If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
- '输出 bat
- Try
- Dim CmdString As String =
- $"{If(McLaunchJavaSelected.Version.Major > 8, "chcp 65001>nul" & vbCrLf, "")}" &
- "@echo off" & vbCrLf &
- $"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
- "echo 游戏正在启动,请稍候。" & vbCrLf &
- $"cd /D ""{PathUtils.ToShortPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
- CustomCommandGlobal & vbCrLf &
- CustomCommandVersion & vbCrLf &
- $"""{McLaunchJavaSelected.JavaExePath}"" {McLaunchArgument}" & vbCrLf &
- "echo 游戏已退出。" & vbCrLf &
- "pause"
- FileUtils.Write(
- filePath:=If(CurrentLaunchOptions.SaveBatch, Paths.Base & "PCL\LatestLaunch.bat"),
- text:=FilterAccessToken(CmdString, "F").Replace("%", "%%"),
- encoding:=If(McLaunchJavaSelected.Version.Major > 8, Encoding.UTF8, Encoding.Default))
- If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
- McLaunchLog("导出启动脚本完成,强制结束启动过程")
- CanceledHint = "导出启动脚本成功!"
- OpenExplorer(CurrentLaunchOptions.SaveBatch)
- Loader.Parent.Cancel()
- Return '导出脚本完成
- End If
- Catch ex As Exception
- Logger.Warn(ex, "输出启动脚本失败")
- If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
- End Try
- '执行自定义命令
- If CustomCommandGlobal <> "" Then
- McLaunchLog("正在执行全局自定义命令:" & CustomCommandGlobal)
- Dim CustomProcess As Process = Nothing
- Try
- CustomProcess = StartProcess(New ProcessStartInfo With {
- .FileName = "cmd.exe",
- .Arguments = $"/c ""{CustomCommandGlobal}""",
- .WorkingDirectory = McFolderSelected,
- .UseShellExecute = False,
- .CreateNoWindow = True
- })
- If Settings.Get(Of Boolean)("LaunchAdvanceRunWait") Then
- Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
- Thread.Sleep(10)
- Loop
- End If
- Catch ex As Exception
- Logger.Error(ex, "执行全局自定义命令失败", LogBehavior.Toast)
- Finally
- If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
- McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
- CustomProcess.Kill()
- End If
- End Try
- End If
- If CustomCommandVersion <> "" Then
- McLaunchLog("正在执行版本自定义命令:" & CustomCommandVersion)
- Dim CustomProcess As Process = Nothing
- Try
- CustomProcess = StartProcess(New ProcessStartInfo With {
- .FileName = "cmd.exe",
- .Arguments = $"/c ""{CustomCommandVersion}""",
- .WorkingDirectory = McFolderSelected,
- .UseShellExecute = False,
- .CreateNoWindow = True
- })
- If Settings.Get(Of Boolean)("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
- Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
- Thread.Sleep(10)
- Loop
- End If
- Catch ex As Exception
- Logger.Error(ex, "执行版本自定义命令失败", LogBehavior.Toast)
- Finally
- If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
- McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
- CustomProcess.Kill()
- End If
- End Try
- End If
- End Sub
- Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
- '启动信息
- Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.JavaExePath) '使用 javaw.exe 会导致 #6263
- '设置环境变量
- Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
- Dim Paths As New List(Of String)
- If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
- Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.Folder))
- StartInfo.EnvironmentVariables("Path") = Paths.Distinct.Join(";"c)
- StartInfo.EnvironmentVariables("appdata") = PathUtils.ToShortPath(McFolderSelected)
- '设置其他参数
- StartInfo.WorkingDirectory = McInstanceSelected.PathIndie
- StartInfo.UseShellExecute = False
- StartInfo.RedirectStandardOutput = True
- StartInfo.RedirectStandardError = True
- StartInfo.CreateNoWindow = True
- StartInfo.Arguments = McLaunchArgument
- '开始进程
- Dim GameProcess = StartProcess(StartInfo)
- McLaunchLog("已启动游戏进程:" & McLaunchJavaSelected.JavaExePath)
- If Loader.IsCanceled Then
- McLaunchLog("由于取消启动,已强制结束游戏进程") '#1631
- GameProcess.Kill()
- Return
- End If
- Loader.Output = GameProcess
- McLaunchProcess = GameProcess
- '进程优先级处理
- Try
- GameProcess.PriorityBoostEnabled = True
- Select Case Settings.Get(Of Integer)("LaunchArgumentPriority")
- Case 0 '高
- GameProcess.PriorityClass = ProcessPriorityClass.AboveNormal
- Case 2 '低
- GameProcess.PriorityClass = ProcessPriorityClass.BelowNormal
- Case Else '中
- End Select
- Catch ex As Exception
- Logger.Error(ex, "设置进程优先级失败")
- End Try
- End Sub
- Private Sub McLaunchWait(Loader As LoaderTask(Of Process, Integer))
- '输出信息
- McLaunchLog("")
- McLaunchLog("~ 基础参数 ~")
- McLaunchLog("PCL 版本:" & VersionDisplay & " (" & VersionCode & ")")
- McLaunchLog($"游戏版本:{McInstanceSelected.VersionDisplayName}({McInstanceSelected.Version.Vanilla},Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", ",无法完全确定")})")
- McLaunchLog("资源版本:" & McAssetsGetIndexName(McInstanceSelected))
- McLaunchLog("版本继承:" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
- McLaunchLog("分配的内存:" & PageInstanceSetup.GetRam(McInstanceSelected) & " GB(" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected) * 1024) & " MB)")
- McLaunchLog("MC 文件夹:" & McFolderSelected)
- McLaunchLog("版本文件夹:" & McInstanceSelected.PathVersion)
- McLaunchLog("版本隔离:" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
- McLaunchLog("HMCL 格式:" & McInstanceSelected.IsHmclFormatJson)
- McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
- McLaunchLog("Natives 文件夹:" & GetNativesFolder())
- McLaunchLog("")
- McLaunchLog("~ 登录参数 ~")
- McLaunchLog("玩家用户名:" & McLoginLoader.Output.Name)
- McLaunchLog("AccessToken:" & McLoginLoader.Output.AccessToken)
- McLaunchLog("ClientToken:" & McLoginLoader.Output.ClientToken)
- McLaunchLog("UUID:" & McLoginLoader.Output.Uuid)
- McLaunchLog("登录方式:" & McLoginLoader.Output.Type)
- McLaunchLog("")
- '获取窗口标题
- Dim WindowTitle As String = Settings.Get(Of String)("VersionArgumentTitle", Instance:=McInstanceSelected)
- If WindowTitle = "" Then WindowTitle = Settings.Get(Of String)("LaunchArgumentTitle")
- WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
- '初始化等待
- Dim Watcher As New Watcher(Loader, McInstanceSelected, WindowTitle)
- McLaunchWatcher = Watcher
- '等待
- Do While Watcher.State = Watcher.MinecraftState.Loading
- Thread.Sleep(100)
- Loop
- If Watcher.State = Watcher.MinecraftState.Crashed Then
- Throw New OperationCanceledException
- End If
- End Sub
- Private Sub McLaunchEnd()
- McLaunchLog("开始启动结束处理")
- '暂停或开始音乐播放
- If Settings.Get(Of Boolean)("UiMusicStop") Then
- RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置,在启动后暂停音乐播放"))
- ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then
- RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置,在启动后开始音乐播放"))
- End If
- '启动器可见性
- McLaunchLog("启动器可见性:" & Settings.Get(Of Integer)("LaunchArgumentVisible"))
- Select Case Settings.Get(Of Integer)("LaunchArgumentVisible")
- Case 0
- '直接关闭
- McLaunchLog("已根据设置,在启动后关闭启动器")
- RunInUi(Sub() FrmMain.EndProgram(False))
- Case 2, 3
- '隐藏
- McLaunchLog("已根据设置,在启动后隐藏启动器")
- RunInUi(Sub() FrmMain.Hidden = True)
- Case 4
- '最小化
- McLaunchLog("已根据设置,在启动后最小化启动器")
- RunInUi(Sub() FrmMain.WindowState = WindowState.Minimized)
- Case 5
- '啥都不干
- End Select
- '启动计数
- Settings.Set("SystemLaunchCount", Settings.Get(Of Integer)("SystemLaunchCount") + 1)
- End Sub
- #End Region
- End Module
|