-
-
Notifications
You must be signed in to change notification settings - Fork 198
/
ModLaunch.vb
2288 lines (2157 loc) · 117 KB
/
ModLaunch.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Imports System.IO.Compression
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。使用 McVersionCurrent。
''' </summary>
Public Version As McVersion = Nothing
''' <summary>
''' 额外的启动参数。
''' </summary>
Public ExtraArgs 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.Critical)
Return False
End If
'强制切换需要启动的版本
If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
'检查版本
CurrentLaunchOptions.Version.Load()
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Critical)
Return False
End If
'切换版本
McVersionCurrent = CurrentLaunchOptions.Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
FrmLaunchLeft.RefreshButtonsUI()
FrmLaunchLeft.RefreshPage(False, False)
End If
FrmMain.AprilGiveup()
'禁止进入版本选择页面（否则就可以在启动中切换 McVersionCurrent 了）
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.VersionSelect).ToList
'实际启动加载器
McLaunchLoader.Start(Options, IsForceRestart:=True)
Return True
End Function
''' <summary>
''' 记录启动日志。
''' </summary>
Public Sub McLaunchLog(Text As String)
Text = SecretFilter(Text, "*")
RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
Log("[Launch] " & Text)
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.Aborted
FrmLaunchLeft.PageChangeToLogin()
Case LoadState.Loading
'在预检测结束后再触发动画
FrmLaunchRight.LabLog.Text = ""
End Select
End Sub
''' <summary>
''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
''' </summary>
Private AbortHint 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.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
Throw
End Try
'正式加载
Try
'构造主加载器
Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader,
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), 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 Setup.Get("VersionRamOptimize", Version:=McVersionCurrent)
Case 0 '全局
If Setup.Get("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
AbortHint = Nothing
LaunchLoader.Start()
'任务栏进度条
LoaderTaskbarAdd(LaunchLoader)
Do While LaunchLoader.State = LoadState.Loading
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
Thread.Sleep(200)
Loop
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
'成功与失败处理
Select Case LaunchLoader.State
Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish)
Case LoadState.Aborted
If AbortHint Is Nothing Then
Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info)
Else
Hint(AbortHint, HintType.Finish)
End If
Case LoadState.Failed
Throw LaunchLoader.Error
Case Else
Throw New Exception("错误的状态改变：" & GetStringFromEnum(CType(LaunchLoader.State, [Enum])))
End Select
Catch ex As Exception
Dim CurrentEx = ex
NextInner:
If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息，则以此为准显示提示
'若错误信息为 $$，则不提示
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
Throw
ElseIf CurrentEx.InnerException IsNot Nothing Then
'检查下一级错误
CurrentEx = CurrentEx.InnerException
GoTo NextInner
Else
'没有特殊处理过的错误信息
McLaunchLog("错误：" & GetExceptionDetail(ex))
Log(ex,
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox,
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
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.IsAborted
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 Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
'检查路径
If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.PathIndie & "）")
If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.Path & "）")
'检查版本
If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本！")
McVersionCurrent.Load()
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info)
'检查输入信息
Dim CheckResult As String = ""
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
#If BETA Then
'求赞助
RunInNewThread(
Sub()
Select Case Setup.Get("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 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf &
"如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易（悲）……",
"求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.com/a/LTCat")
End If
End Select
End Sub, "Donate")
#End If
'正版购买提示
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
If IsSystemLanguageChinese() Then
Select Case Setup.Get("SystemLaunchCount")
Case 2, 5, 10, 15, 20, 40, 60, 80, 100, 125, 150, 175, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("你已经启动了 " & Setup.Get("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
ElseIf Setup.Get("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.Critical)
CurrentLaunchOptions.ExtraArgs.Add("--demo")
Case 3
Throw New Exception("$$")
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 GetHash(UserName & Password & BaseUrl & Token & Type) 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 GetHash(OAuthRefreshToken & AccessToken & Uuid & UserName & ProfileJson) 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 GetHash(UserName & SkinType & SkinName & Type) 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 Setup.Get("LoginType")
Case McLoginType.Ms
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
Case McLoginType.Legacy
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Case McLoginType.Nide
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
Case McLoginType.Auth
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
End Select
'查找所有可能的项
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Return Nothing
End Function
''' <summary>
''' 当前是否可以进行登录。若不可以则会返回错误原因。
''' </summary>
Public Function McLoginAble() As String
Select Case Setup.Get("LoginType")
Case McLoginType.Ms
If Setup.Get("CacheMsOAuthRefresh") = "" Then
Return FrmLoginMs.IsVaild()
Else
Return ""
End If
Case McLoginType.Legacy
Return FrmLoginLegacy.IsVaild()
Case McLoginType.Nide
If Setup.Get("CacheNideAccess") = "" Then
Return FrmLoginNide.IsVaild()
Else
Return ""
End If
Case McLoginType.Auth
If Setup.Get("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 As McLoginType = Setup.Get("LoginType")
Try
Select Case LoginType
Case McLoginType.Legacy
LoginData = PageLoginLegacy.GetLoginData()
Case McLoginType.Ms
If Setup.Get("CacheMsOAuthRefresh") = "" Then
LoginData = PageLoginMs.GetLoginData()
Else
LoginData = PageLoginMsSkin.GetLoginData()
End If
Case McLoginType.Nide
If Setup.Get("CacheNideAccess") = "" Then
LoginData = PageLoginNide.GetLoginData()
Else
LoginData = PageLoginNideSkin.GetLoginData()
End If
Case McLoginType.Auth
If Setup.Get("CacheAuthAccess") = "" Then
LoginData = PageLoginAuth.GetLoginData()
Else
LoginData = PageLoginAuthSkin.GetLoginData()
End If
End Select
Catch ex As Exception
Log(ex, "获取登录输入信息失败（" & GetStringFromEnum(LoginType) & "）", LogLevel.Feedback)
End Try
Return LoginData
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)
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 McLoginMsRefreshTime As Long = 0 '上次刷新登录的时间
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
'检查是否已经登录完成
If Not Data.IsForceRestarting AndAlso '不要求强行重启
Input.AccessToken <> "" AndAlso '已经登录过了
(McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内
Data.Output = New McLoginResult With
{.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
GoTo SkipLogin
End If
'尝试登录
Dim OAuthTokens As String()
If Input.OAuthRefreshToken = "" Then
'无 RefreshToken
Relogin:
OAuthTokens = MsLoginStep1New(Data)
Else
'有 RefreshToken
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken) '要求重新打开登录网页认证
If OAuthTokens(0) = "Relogin" Then GoTo Relogin
End If
If Data.IsAborted Then Throw New ThreadInterruptedException
Data.Progress = 0.25
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim OAuthAccessToken As String = OAuthTokens(0)
Dim OAuthRefreshToken As String = OAuthTokens(1)
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
Data.Progress = 0.4
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Tokens = MsLoginStep3(XBLToken)
Data.Progress = 0.55
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim AccessToken As String = MsLoginStep4(Tokens)
Data.Progress = 0.7
If Data.IsAborted Then Throw New ThreadInterruptedException
MsLoginStep5(AccessToken)
Data.Progress = 0.85
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Result = MsLoginStep6(AccessToken)
Data.Progress = 0.98
'输出登录结果
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsAccess", AccessToken)
Setup.Set("CacheMsUuid", Result(0))
Setup.Set("CacheMsName", Result(1))
Setup.Set("CacheMsProfileJson", Result(2))
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
MsJson.Remove(Input.UserName) '如果更改了玩家名……
MsJson(Result(1)) = OAuthRefreshToken
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)}
'结束
McLoginMsRefreshTime = GetTimeTick()
McLaunchLog("微软登录完成")
SkipLogin:
Setup.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
Dim LogUsername As String = Input.UserName
If LogUsername.Contains("@") AndAlso Setup.Get("UiLauncherEmail") Then
LogUsername = AccountFilter(LogUsername)
End If
McLaunchLog("登录方式：" & Input.Description & "（" & LogUsername & "）")
Data.Progress = 0.05
'尝试登录
If (Not Data.Input.ForceReselectProfile) AndAlso
Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso
Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso
Setup.Get("Cache" & Input.Token & "Access") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Client") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Uuid") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Name") <> "" Then
'尝试验证登录
Try
If Data.IsAborted Then Throw New ThreadInterruptedException
McLoginRequestValidate(Data)
GoTo LoginFinish
Catch ex As Exception
Dim AllMessage = GetExceptionSummary(ex)
McLaunchLog("验证登录失败：" & AllMessage)
If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
McLaunchLog("已触发超时登录失败")
Throw New Exception("$登录失败：连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好，或尝试使用 VPN！")
End If
End Try
Data.Progress = 0.25
'尝试刷新登录
Refresh:
Try
If Data.IsAborted Then Throw New ThreadInterruptedException
McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish
Catch ex As Exception
McLaunchLog("刷新登录失败：" & GetExceptionSummary(ex))
End Try
Data.Progress = If(NeedRefresh, 0.85, 0.45)
End If
'尝试普通登录
Try
If Data.IsAborted Then Throw New ThreadInterruptedException
NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception
McLaunchLog("登录失败：" & GetExceptionSummary(ex))
Throw
End Try
If NeedRefresh Then
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 Setup.Get("Login" & Input.Token & "Email") = "" Then Emails.AddRange(Setup.Get("Login" & Input.Token & "Email").ToString.Split("¨"))
If Not Setup.Get("Login" & Input.Token & "Pass") = "" Then Passwords.AddRange(Setup.Get("Login" & Input.Token & "Pass").ToString.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)
Setup.Set("Login" & Input.Token & "Email", Join(Emails, "¨"))
Setup.Set("Login" & Input.Token & "Pass", Join(Passwords, "¨"))
Catch ex As Exception
Log(ex, "保存启动记录失败", LogLevel.Hint)
Setup.Set("Login" & Input.Token & "Email", "")
Setup.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 Setup.Get("LoginLegacyName") = "" Then Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
Names.Remove(Input.UserName)
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
End Sub
'Server 登录：三种验证方式的请求
Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult))
McLaunchLog("验证登录开始（Validate, " & Data.Input.Token & "）")
'提前缓存信息，否则如果在登录请求过程中退出登录，设置项目会被清空，导致输出存在空值
Dim AccessToken As String = Setup.Get("Cache" & Data.Input.Token & "Access")
Dim ClientToken As String = Setup.Get("Cache" & Data.Input.Token & "Client")
Dim Uuid As String = Setup.Get("Cache" & Data.Input.Token & "Uuid")
Dim Name As String = Setup.Get("Cache" & Data.Input.Token & "Name")
'发送登录请求
Dim RequestData As New JObject(
New JProperty("accessToken", AccessToken), New JProperty("clientToken", ClientToken), New JProperty("requestUser", True))
NetRequestRetry(
Url:=Data.Input.BaseUrl & "/validate",
Method:="POST",
Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"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 = GetJson(NetRequestRetry(
Url:=Data.Input.BaseUrl & "/refresh",
Method:="POST",
Data:="{" &
If(RequestUser, "
""requestUser"": true,
""selectedProfile"": {
""id"":""" & Setup.Get("Cache" & Data.Input.Token & "Uuid") & """,
""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8"))
'将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("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
'保存缓存
Setup.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
Setup.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
Setup.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
Setup.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
Setup.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
Setup.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 = GetJson(NetRequestRetry(
Url:=Data.Input.BaseUrl & "/authenticate",
Method:="POST",
Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8"))
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Critical)
Throw New Exception("$你还没有创建角色，请在创建角色后再试！")
ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").Count = 1 Then
Hint("你的账户中只有一个角色，无法更换！", HintType.Critical)
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 = Setup.Get("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
'保存缓存
Setup.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken)
Setup.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken)
Setup.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid)
Setup.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name)
Setup.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName)
Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
McLaunchLog("登录成功（Login, " & Data.Input.Token & "）")
Return NeedRefresh
Catch ex As Exception
Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
'读取服务器返回的错误
If TypeOf ex Is ResponsedWebException Then
Dim ErrorMessage As String = Nothing
Try
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then Throw New Exception("$登录失败：" & ErrorMessage)
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 AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") 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 String()
'参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
'初始请求
McLaunchLog("开始微软登录步骤 1/6（原始登录）")
Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
'弹窗
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
WaitingMyMsgBox.Add(Converter)
While Converter.Result Is Nothing
Thread.Sleep(100)
End While
If TypeOf Converter.Result Is Exception Then
Throw CType(Converter.Result, Exception)
Else
Return Converter.Result
End If
End Function
'微软登录步骤 1，刷新登录：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
Private Function MsLoginStep1Refresh(Code As String) As String()
McLaunchLog("开始微软登录步骤 1/6（刷新登录）")
Dim Result As String
Try
Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST",
$"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
"application/x-www-form-urlencoded", 2)
Catch ex As Exception
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
Return {"Relogin", ""}
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
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""
}" 'TODO: 新版登录改为 ""RpsTicket"": ""d=" & AccessToken & """
Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
Dim ResultJson As JObject = GetJson(Result)
Dim XBLToken As String = ResultJson("Token").ToString
Return XBLToken
End Function
'微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) 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 = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Catch ex As Net.WebException
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If ex.Message.Contains("2148916227") Then
MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916233") Then
If MyMsgBox("你尚未注册 Xbox 账户，请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
OpenWebsite("https://signup.live.com/signup")
End If
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请尝试使用加速器或 VPN。", "登录失败", "我知道了")
Throw New Exception("$$")
ElseIf ex.Message.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 Exception("$$")
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim XSTSToken As String = ResultJson("Token").ToString
Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
Return {XSTSToken, UHS}
End Function
'微软登录步骤 4：从 {XSTSToken, UHS} 获取 Minecraft AccessToken
Private Function MsLoginStep4(Tokens As String()) As String
McLaunchLog("开始微软登录步骤 4/6")
Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0)
Dim Result As String
Try
Result = NetRequestMulty("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then
Log(ex, "微软登录第 5 步汇报 429")
Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！")
ElseIf Message.Contains("(403)") Then
Log(ex, "微软登录第 5 步汇报 403")
Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器，请把它们关掉或更换节点后再试！")
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim AccessToken As String = ResultJson("access_token").ToString
Return AccessToken
End Function
'微软登录步骤 5：验证微软账号是否持有 MC，这也会刷新 XGP
Private Sub MsLoginStep5(AccessToken As String)
McLaunchLog("开始微软登录步骤 5/6")
Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Try
Dim ResultJson As JObject = GetJson(Result)
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 Exception("$$")
End If
Catch ex As Exception
Log(ex, "微软登录第 6 步异常：" & Result)
Throw
End Try
End Sub
'微软登录步骤 6：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
Private Function MsLoginStep6(AccessToken As String) As String()
McLaunchLog("开始微软登录步骤 6/6")