feat. 授权代码流

Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb

@@ -1,4 +1,5 @@
 Imports System.IO.Compression
+Imports System.Resources.ResXFileRef
 
 Public Module ModLaunch
 
@@ -864,33 +865,69 @@ LoginFinish:
     Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String()
         '参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
 
-        '初始请求
+        Select Case Setup.Get("SystemSystemAuth")
+            Case 0 '设备代码流
+                '初始请求
 Retry:
-        McLaunchLog("开始微软登录步骤 1/6（原始登录）")
-        Dim PrepareJson As JObject = GetJson(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))
-        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 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 Exception("$$")
-            End If
-        ElseIf TypeOf Converter.Result Is Exception Then
-            Throw CType(Converter.Result, Exception)
-        Else
-            Return Converter.Result
-        End If
+                McLaunchLog("开始微软登录步骤 1/6（原始登录）")
+                Dim PrepareJson As JObject = GetJson(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))
+                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 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 Exception("$$")
+                    End If
+                ElseIf TypeOf Converter.Result Is Exception Then
+                    Throw CType(Converter.Result, Exception)
+                Else
+                    Return Converter.Result
+                End If
+            Case 1 '授权代码流
+                McLaunchLog("开始微软登录步骤 1/6（授权代码流）")
+                Dim Random As New Random
+                Dim RedirectUri As String = $"http://localhost:{Random.Next(1024, 65535)}/"
+                Dim State As String = Random.Next(10000, 99999)
+                Dim HttpListener As New HttpListener
+                HttpListener.Prefixes.Add(RedirectUri)
+                HttpListener.Start()
+                OpenWebsite($"https://login.microsoftonline.com/consumers/oauth2/v2.0/authorize?client_id={OAuthClientId}&response_type=code&redirect_uri={WebUtility.UrlEncode(RedirectUri)}&scope=XboxLive.signin%20offline_access&response_mode=query&state={State}&prompt=select_account")
+                Dim Context As HttpListenerContext = HttpListener.GetContext()
+                Dim Code = Context.Request.QueryString("code")
+                Dim ResponseString As String
+                Dim Result As String() = {"Ignore", ""}
+                If (Code <> Nothing AndAlso Context.Request.QueryString("state") = State) Then
+                    Context.Response.StatusCode = 200
+                    ResponseString = "<html><head><meta charset=""UTF-8""></head><body><h1>成功！</h1><h2>你现在可以关闭此页面。</h2></body></html>"
+                    Dim ResultJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", HttpMethod.Post, Content:=$"client_id={OAuthClientId}&scope=XboxLive.signin%20offline_access&code={Code}&redirect_uri={WebUtility.UrlEncode(RedirectUri)}&grant_type=authorization_code", ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
+                    Dim AccessToken As String = ResultJson("access_token").ToString
+                    Dim RefreshToken As String = ResultJson("refresh_token").ToString
+                    Result = {AccessToken, RefreshToken}
+                Else
+                    Context.Response.StatusCode = 400
+                    ResponseString = $"<html><head><meta charset=""UTF-8""></head><body><h1>{Context.Request.QueryString("error")}</h1><h2>{Context.Request.QueryString("error_description")}</h2></body></html>"
+                End If
+                Dim Buffer = Encoding.UTF8.GetBytes(ResponseString)
+                Context.Response.ContentLength64 = Buffer.Length
+                Context.Response.OutputStream.Write(Buffer, 0, Buffer.Length)
+                HttpListener.Stop()
+                Thread.Sleep(1000)
+                FrmMain.ShowWindowToTop()
+                Return Result
+            Case Else
+                Throw New Exception("未知授权方式")
+        End Select
     End Function
     '微软登录步骤 1，刷新登录：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
     Private Function MsLoginStep1Refresh(Code As String) As String()

Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb

@@ -42,6 +42,7 @@
         {"SystemSystemCache", New SetupEntry("", Source:=SetupSource.Registry)},
         {"SystemSystemUpdate", New SetupEntry(0)},
         {"SystemSystemActivity", New SetupEntry(0)},
+        {"SystemSystemAuth", New SetupEntry(0)},
         {"SystemSystemTelemetry", New SetupEntry(True, Source:=SetupSource.Registry)},
         {"CacheConfig", New SetupEntry(0, Source:=SetupSource.Registry)},
         {"CacheExportConfig", New SetupEntry("", Source:=SetupSource.Registry)},

Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml

@@ -123,6 +123,8 @@
                         <RowDefinition Height="28" />
                         <RowDefinition Height="9" />
                         <RowDefinition Height="28" />
+                        <RowDefinition Height="9" />
+                        <RowDefinition Height="28" />
                         <RowDefinition Height="5" />
                         <RowDefinition Height="Auto" />
                         <RowDefinition Height="Auto" />
@@ -148,7 +150,12 @@
                             <local:ValidateFolderPath UseMinecraftCharCheck="False" />
                         </local:MyTextBox.ValidateRules>
                     </local:MyTextBox>
-                    <local:MyCheckBox Margin="0,5,0,4" Text="匿名数据收集" Grid.Row="6" Height="22" Grid.ColumnSpan="2"
+                    <TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="登录方式" Margin="0,0,25,0" />
+                    <local:MyComboBox x:Name="ComboSystemAuth" Grid.Row="6" Tag="SystemSystemAuth" Grid.Column="1">
+                        <local:MyComboBoxItem Content="设备代码流" />
+                        <local:MyComboBoxItem Content="授权代码流" />
+                    </local:MyComboBox>
+                    <local:MyCheckBox Margin="0,5,0,4" Text="匿名数据收集" Grid.Row="8" Height="22" Grid.ColumnSpan="2"
                         x:Name="CheckSystemTelemetry" Tag="SystemSystemTelemetry" 
                         ToolTip="当下载失败、PCL 出错、游戏崩溃等事件时，PCL 会匿名上报情况，以通知龙猫 “哦吼，出错了”，让龙猫能更好地修 Bug……&#xa;你可以关闭上报，不过龙猫就不知道你遇到了什么 Bug 了……&#13;PCL 不会上传或收集任何个人信息，包括上报的东西里面也没有！&#xa;详情：https://github.com/Meloong-Git/PCL/discussions/7036" />
                     <Grid Height="35" Grid.Row="7" Grid.ColumnSpan="5" Margin="0,12,0,0">
@@ -161,7 +168,7 @@
                         <local:MyButton Grid.Column="1" x:Name="BtnSystemSettingExp" MinWidth="140" Text="导出设置" Padding="13,0" Margin="0,0,20,0" />
                         <local:MyButton Grid.Column="2" x:Name="BtnSystemSettingImp" MinWidth="140" Text="导入设置" Padding="13,0" Margin="0,0,20,0" />
                     </Grid>
-                    <Grid Height="35" Grid.Row="8" Grid.ColumnSpan="5" Margin="0,12,0,0" x:Name="PanDonate">
+                    <Grid Height="35" Grid.Row="10" Grid.ColumnSpan="5" Margin="0,12,0,0" x:Name="PanDonate">
                         <Grid.ColumnDefinitions>
                             <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
                             <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />

Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb

@@ -50,6 +50,7 @@
         ComboSystemUpdate.SelectedIndex = Setup.Get("SystemSystemUpdate")
         ComboSystemActivity.SelectedIndex = Setup.Get("SystemSystemActivity")
         TextSystemCache.Text = Setup.Get("SystemSystemCache")
+        ComboSystemAuth.SelectedIndex = Setup.Get("SystemSystemAuth")
         CheckSystemTelemetry.Checked = Setup.Get("SystemSystemTelemetry")
 
         '调试选项
@@ -100,7 +101,7 @@
     Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change
         If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
     End Sub
-    Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslateV2.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadSource.SelectionChanged, ComboDownloadMod.SelectionChanged
+    Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslateV2.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboSystemAuth.SelectionChanged, ComboDownloadSource.SelectionChanged, ComboDownloadMod.SelectionChanged
         If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
     End Sub
     Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged