2.11.2
Some checks failed
Build / Build (Debug) (push) Has been cancelled
Build / Build (Release) (push) Has been cancelled

This commit is contained in:
龙腾猫跃
2025-11-06 23:10:47 +08:00
parent efd480f06c
commit ad757f54b7
13 changed files with 322 additions and 115 deletions

View File

@@ -113,6 +113,14 @@ Public Class FormMain
'3BUG+ IMP* FEAT-
'2BUG* IMP-
'1BUG-
If LastVersion < 375 Then 'Snapshot 2.11.2
If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:对联机进行了各种各样的优化,以改善稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若有加入者的网络环境比房主更好,会提示可以让那位加入者担任房主"))
End If
FeatureCount += 16
BugCount += 4
End If
If LastVersion < 374 Then 'Snapshot 2.11.1
If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:使用离线登录也可以直接加入联机房间了"))
@@ -452,7 +460,7 @@ Public Class FormMain
Thread.Sleep(100)
DlClientListMojangLoader.Start(1) 'PCL 会同时根据这里的加载结果决定是否使用官方源进行下载
RunCountSub()
ServerLoader.Start(1)
ServerLoader.Start()
RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
Catch ex As Exception
Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
@@ -776,6 +784,7 @@ Public Class FormMain
End Try
'读取剪贴板,自动加入联机房间
If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机
If PageCurrent = PageType.Link Then Return '已在联机界面
Dim Code = ClipboardGetText() : If Code Is Nothing Then Return '剪贴板无文本
If Setup.Get("LinkLastAutoJoinInviteCode") = Code Then Return
If PageLinkMain.ValidateCodeFormat(Code) IsNot Nothing Then Return '不是邀请码

View File

@@ -14,13 +14,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.11.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.11.1." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.11.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.11.2." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 372 'Release
#Else
Public Const VersionCode As Integer = 374 'Snapshot
Public Const VersionCode As Integer = 375 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -3169,12 +3169,12 @@ Retry:
''' <summary>
''' 将数组随机打乱。
''' </summary>
Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T)
Shuffle = New List(Of T)
Do While array.Any
Dim i As Integer = RandomInteger(0, array.Count - 1)
Shuffle.Add(array(i))
array.RemoveAt(i)
<Extension> Public Iterator Function Shuffle(Of T)(Raw As IEnumerable(Of T)) As IEnumerable(Of T)
Dim RawCopy As New List(Of T)(Raw)
Do While RawCopy.Any
Dim i As Integer = RandomInteger(0, RawCopy.Count - 1)
Yield RawCopy(i)
RawCopy.RemoveAt(i)
Loop
End Function

View File

@@ -341,7 +341,12 @@
Failed(ex)
End Try
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
Try
LastRunningThread.Start() '不能使用 RunInNewThread否则在函数返回前线程就会运行完导致误判 IsAborted
Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试
Thread.Sleep(500)
LastRunningThread.Start()
End Try
End Sub
Public Overrides Sub Failed(ex As Exception)
[Error] = ex

View File

@@ -1984,7 +1984,7 @@ Retry:
''' </summary>
Public Function FindFreePorts(ConsecutiveCount As Integer, ParamArray ExtraBlackLists As Integer()) As List(Of Integer)
Dim UsedPorts = GetUsedPorts().Concat(ExtraBlackLists)
For port = 12000 To 65000 - ConsecutiveCount
For port = 12000 + RandomInteger(0, 1000) To 65000 - ConsecutiveCount
Dim Range = Enumerable.Range(port, ConsecutiveCount)
If Not Range.Any(Function(p) UsedPorts.Contains(p)) Then Return Range.ToList
Next

View File

@@ -2220,7 +2220,9 @@ IgnoreCustomSkin:
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
'设置环境变量
Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";"))
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(ShortenPath(McLaunchJavaSelected.PathFolder))
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)

View File

@@ -30,7 +30,7 @@
Next
End If
'打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
MusicWaitingList = If(Setup.Get("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList))
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0)

View File

@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.11.1.0")>
<Assembly: AssemblyFileVersion("2.11.1.0")>
<Assembly: AssemblyVersion("2.11.2.0")>
<Assembly: AssemblyFileVersion("2.11.2.0")>
<Assembly: NeutralResourcesLanguage("")>

View File

@@ -122,11 +122,16 @@
</Grid>
<Grid x:Name="PanFinish" Visibility="Collapsed" HorizontalAlignment="Center" VerticalAlignment="Center" MinWidth="300">
<Grid.RowDefinitions>
<RowDefinition Height="30" />
<RowDefinition Height="35" />
<RowDefinition Height="Auto" />
<RowDefinition Height="25" />
<RowDefinition Height="Auto" />
<RowDefinition Height="60" />
</Grid.RowDefinitions>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" CornerRadius="12">
<local:MyHint Text="你的网络环境差,正使用社区节点进行中继。" HasBorder="True"
HorizontalAlignment="Center" x:Name="HintFinish" Theme="Yellow" />
<local:MyCard Grid.Row="2" HorizontalAlignment="Center" VerticalAlignment="Center" CornerRadius="12">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="25" />
@@ -156,7 +161,7 @@
<local:MyButton x:Name="BtnFinishExit" Grid.Column="5" Grid.Row="3" Text="退出" Padding="13,8" />
</Grid>
</local:MyCard>
<local:MyCard Grid.Row="2" HorizontalAlignment="Center" VerticalAlignment="Center" CornerRadius="8">
<local:MyCard Grid.Row="4" HorizontalAlignment="Center" VerticalAlignment="Center" CornerRadius="8">
<StackPanel Orientation="Horizontal" Margin="3,0">
<StackPanel x:Name="BtnFinishPing" Orientation="Horizontal" Background="{StaticResource ColorBrushSemiTransparent}"
ToolTip="延迟" ToolTipService.Placement="Center" ToolTipService.InitialShowDelay="50" ToolTipService.VerticalOffset="40" ToolTipService.HorizontalOffset="4">

View File

@@ -1,6 +1,8 @@
Imports System.Net.Sockets
Imports System.Globalization
Imports System.Net.Sockets
Public Class PageLinkMain
Private Const INVITE_CODE_VERSION As Integer = 2
'===============================
' 状态机与前端页面
@@ -106,6 +108,7 @@ Public Class PageLinkMain
End Function
NetworkName = $"P{RadixConvert(ServerPort, 10, 16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
NetworkSecret = GenerateRandomCode()
DiscoverNodeID = -1
Log($"[Link] 尝试创建房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
'启动
ChangeState(LinkStates.Loading)
@@ -118,7 +121,7 @@ Public Class PageLinkMain
''' </summary>
Public Shared Sub Join() Handles PanSelectJoin.MouseLeftButtonUp
Dim Code As String = MyMsgBoxInput("输入邀请码", "输入房主发给你的邀请码。",
HintText:=If(String.IsNullOrEmpty(LastCode), "", "使用上一次的邀请码" & LastCode))
HintText:=If(String.IsNullOrEmpty(LastCode), "", "使用上一次的邀请码"))
If Not String.IsNullOrEmpty(LastCode) AndAlso Code IsNot Nothing AndAlso Code = "" Then Code = LastCode
If Code Is Nothing Then Return
Join(Code)
@@ -126,27 +129,32 @@ Public Class PageLinkMain
Public Sub JoinInternal(Code As String)
If Code Is Nothing Then Return
'基础格式校验
Code = Code.Between("", "").Between("[", "]") '从完整消息中提取
Code = Code.ToUpper.Replace("O", "0").Replace("I", "1") '输入修正
Dim ValidateResult = ValidateCodeFormat(Code)
If ValidateResult IsNot Nothing Then
Hint(ValidateResult, HintType.Red)
Return
End If
Code = FixCodeFormat(Code)
Log($"[Link] 实际使用的邀请码:{Code}")
'基础信息
IsServerSide = False
ServerPort = RadixConvert(Code.Substring(1, 4), 16, 10)
NetworkName = Code.Substring(0, 11)
NetworkSecret = Code.Substring(12, 5)
Log($"[Link] 尝试加入房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
If Code.Substring(20, 3) = "000" Then
DiscoverNodeID = -2
Else
DiscoverNodeID = RadixConvert(Code.Substring(20, 3), 16, 10)
End If
Log($"[Link] 尝试加入房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort},发现节点 {DiscoverNodeID}")
'启动
LastCode = Code
ChangeState(LinkStates.Loading)
End Sub
Public Shared Function ValidateCodeFormat(Code As String) As String
If Code Is Nothing Then Return "邀请码为空!"
Code = Code.Between("", "").Between("[", "]") '从完整消息中提取
Code = Code.ToUpper.Replace("O", "0").Replace("I", "1") '输入修正
Code = FixCodeFormat(Code)
'判断类型
If Not (Code.Length >= 14 AndAlso Code(0) = "P"c AndAlso Code(5) = "-"c AndAlso Code(11) = "-"c) Then
If Code.StartsWithF("U/") Then 'HMCL
Return "请让房主使用 PCL 创建房间!"
@@ -156,8 +164,20 @@ Public Class PageLinkMain
Return "邀请码有误,请让房主使用 PCL 创建房间!"
End If
End If
'校验版本
If Code.Length >= 23 AndAlso Code(17) = "-"c AndAlso
Val(Code.Substring(18, 2)) > INVITE_CODE_VERSION Then Return "你的 PCL 版本太老了,请在更新 PCL 之后再联机!"
Return Nothing
End Function
Private Shared Function FixCodeFormat(Code As String) As String
Code = Code.Between("", "").Between("[", "]") '从完整消息中提取
Code = Code.ToUpper.Replace("O", "0").Replace("I", "1") '输入修正
'版本 1 兼容
If Code.Length >= 17 AndAlso (Code.Length < 23 OrElse (Code.Length >= 18 AndAlso Code(17) <> "-"c)) Then
Code = Code.Substring(0, 17) & "-0105E"
End If
Return Code
End Function
'自动加入
@@ -280,8 +300,9 @@ Public Class PageLinkMain
'UI 更新
If IsServerSide Then
LabFinishTitle.Text = "已创建房间"
LabFinishDesc.Text = $"把邀请码发给朋友,让大家加入房间吧!{vbCrLf}邀请码:{NetworkName}-{NetworkSecret}"
LabFinishDesc.Text = $"把邀请码发给朋友,让大家加入房间吧!{vbCrLf}邀请码:{GetInviteCode()}"
BtnFinishExit.Text = "关闭"
BtnFinishPing.ToolTip = "网络延迟"
BtnFinishCopy.Visibility = Visibility.Visible
Copy() '立即复制邀请码
'下边栏
@@ -294,6 +315,7 @@ Public Class PageLinkMain
LabFinishTitle.Text = "已加入房间"
LabFinishDesc.Text = $"在多人游戏页面的最下方就能找到联机房间!{vbCrLf}注意:使用离线登录时不要手动输入 IP"
BtnFinishExit.Text = "离开"
BtnFinishPing.ToolTip = "与房主的延迟"
BtnFinishCopy.Visibility = Visibility.Collapsed
'下边栏
BtnFinishPort.Visibility = Visibility.Collapsed
@@ -332,11 +354,15 @@ Public Class PageLinkMain
'复制邀请码
Private Sub Copy() Handles BtnFinishCopy.Click
Dim CodeText As String = $"在 PCL 启动器中输入邀请码【{NetworkName}-{NetworkSecret}】,即可加入联机房间!"
Dim CodeText As String = $"在 PCL 启动器中输入邀请码【{GetInviteCode()}】,即可加入联机房间!"
ClipboardSet(CodeText, False)
Setup.Set("LinkLastAutoJoinInviteCode", CodeText)
Hint("已复制邀请码!", HintType.Green)
End Sub
Private Function GetInviteCode() As String
Return $"{NetworkName}-{NetworkSecret}-{INVITE_CODE_VERSION.ToString.PadLeft(2, "0"c)}{ _
RadixConvert(If(DiscoverNodeID = -1, 0, DiscoverNodeID), 10, 16).PadLeft(3, "0"c)}"
End Function
'复制 IP
Private Sub BtnFinishIp_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishIp.MouseLeftButtonUp
@@ -376,6 +402,11 @@ Public Class PageLinkMain
''' </summary>
Private ClientAddress As String = Nothing
''' <summary>
''' 发现节点的 ID。
''' 若必须设定自定义节点则为 -2若等待选择则为 -1选择回退节点则为 0否则为对应节点的 ID。
''' </summary>
Private DiscoverNodeID As Integer = -1
''' <summary>
''' 网络信息。
''' </summary>
Private NetworkName As String, NetworkSecret As String
@@ -383,7 +414,7 @@ Public Class PageLinkMain
#Region "加载"
Private WithEvents LinkLoader As New LoaderCombo(Of Integer)("联机", {
New LoaderTask(Of Integer, Integer)("获取配置", AddressOf InitConfig) With {.Block = False, .ProgressWeight = 8},
New LoaderTask(Of Integer, Integer)("获取配置", AddressOf InitConfig) With {.ProgressWeight = 8},
New LoaderTask(Of Integer, List(Of NetFile))("准备下载联机模块", AddressOf InitPrepareDownload) With {.ProgressWeight = 2},
New LoaderDownload("下载联机模块", New List(Of NetFile)) With {.ProgressWeight = 40},
New LoaderTask(Of Integer, Integer)("启动联机模块", AddressOf InitLaunch) With {.ProgressWeight = 50}
@@ -397,8 +428,12 @@ Public Class PageLinkMain
End If
ServerLoader.WaitForExit(LoaderToSyncProgress:=Task)
If ServerConfig Is Nothing Then Throw New Exception("无法从服务器获取配置")
If Not String.IsNullOrEmpty(ServerConfig("Link")("DisableReason")) Then '检查是否已禁用联机功能
Throw New Exception("$" & ServerConfig("Link")("DisableReason").ToString)
'检查是否已禁用联机功能
Dim DisableReason = ServerConfig("Link")?("DisableReason2")?.ToString
If Not String.IsNullOrEmpty(DisableReason) Then Throw New Exception("$" & DisableReason)
If CType(ServerConfig("Link"), JObject).ContainsKey("MinVersionCode") AndAlso
VersionCode < ServerConfig("Link")("MinVersionCode").ToObject(Of Integer) Then
Throw New Exception("$你的 PCL 版本太老了,请在更新 PCL 之后再联机!")
End If
End Sub
@@ -443,7 +478,6 @@ Public Class PageLinkMain
End Sub
'3. 启动联机模块
Private Shared HostName As String
Private Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
'解压文件
UpdateLoadingPage("正在解压联机模块……", "解压联机模块")
@@ -466,13 +500,19 @@ Public Class PageLinkMain
End If
Task.Progress = 0.07
'获取节点列表
Dim Peers As List(Of String)
UpdateLoadingPage("正在获取节点列表……", "获取节点列表")
Dim RawPeers As List(Of String)
Dim CustomPeers As String = Setup.Get("LinkCustomPeer")
If String.IsNullOrWhiteSpace(CustomPeers) Then
Peers = GetOnlinePeers()
If DiscoverNodeID = -2 AndAlso Not IsServerSide Then
Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容,{vbCrLf}才能进入该房间!")
Return
End If
RawPeers = GetTargetPeers()
Else
Peers = CustomPeers.Split(",".ToCharArray).Select(Function(p) p.Trim).Where(Function(p) Not String.IsNullOrEmpty(p)).ToList()
Log("[Link] 使用自定义节点")
If DiscoverNodeID <> -2 AndAlso Not IsServerSide Then Hint("房主可能没有使用自定义节点设置,请确认你们的自定义节点设置是否一致!")
RawPeers = CustomPeers.Split(",".ToCharArray).Select(Function(p) p.Trim).Where(Function(p) Not String.IsNullOrEmpty(p)).ToList()
Log("[Link] 使用自定义节点:" & CustomPeers)
End If
Task.Progress = 0.13
'获取空闲端口
@@ -484,7 +524,7 @@ Public Class PageLinkMain
'获取启动参数
Dim Arguments As String = ServerConfig("Link")("Argument")
Arguments += $" --network-name={NetworkName} --network-secret={NetworkSecret} --listeners {ListenersPort} --rpc-portal {RPCPort}"
HostName = If(IsServerSide, "Server-", "Client-") & RadixConvert(Math.Abs(Identify.GetHashCode), 10, 36)
Dim HostName = If(IsServerSide, "Server-", "Client-") & RadixConvert(Math.Abs(Identify.GetHashCode), 10, 36)
If IsServerSide Then
Arguments += $" -i 10.114.114.114 --hostname={HostName} --tcp-whitelist={ServerPort} --udp-whitelist={ServerPort}"
Else
@@ -496,10 +536,11 @@ Public Class PageLinkMain
Arguments += $" --port-forward tcp://{IPAddress.Loopback}:{ClientPort}/10.114.114.114:{ServerPort}"
Arguments += $" --port-forward udp://{IPAddress.Loopback}:{ClientPort}/10.114.114.114:{ServerPort}"
End If
For Each Peer As String In Peers
For Each Peer As String In RawPeers
Arguments += $" -p=""{Peer}"""
Next
Arguments += " --private-mode true" '老好人模式现在莫得用If Not Setup.Get("LinkShareMode") Then
If Setup.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
'启动进程
ProcessStart(Arguments)
Task.Progress = 0.15
@@ -512,23 +553,23 @@ Public Class PageLinkMain
RefreshPeerLoader.WaitForExit(IsForceRestart:=True)
'查找目标节点
Dim Ping = GetPeerPing()
If Ping <> 0 Then
If Ping > 0 Then
Log($"[Link] 已与目标建立连接,当前 Ping 为 {Ping:0.0}ms")
Telemetry("联机成功", "Server", IsServerSide, "Ping", Ping)
Telemetry("联机成功", "Server", IsServerSide, "NAT", NATType)
Exit Do '退出循环
End If
'更新进度
Dim LastProgress = Task.Progress
Dim PeerCount As Integer = If(Peers Is Nothing, -1, Peers.Count)
Dim PeerCount As Integer = If(Peers Is Nothing, -1, Peers.Where(Function(p) p.Ping > 0).Count)
Select Case PeerCount
Case -1 'CLI 无返回
Task.Progress = MathClamp(Task.Progress + 0.02, 0.15, 0.25)
Case 0 'CLI 有返回,但未连接到任何节点
UpdateLoadingPage("正在连接到节点……", "连接节点")
Task.Progress = MathClamp(Task.Progress + 0.02, If(IsServerSide, 0.5, 0.3), If(IsServerSide, 0.99, 0.5))
Task.Progress = MathClamp(Task.Progress + 0.02, If(IsServerSide, 0.5, 0.3), If(IsServerSide, 0.95, 0.5))
Case Else '已连接到节点,但未连接到房主
UpdateLoadingPage("正在连接到房主……", "连接房主")
Task.Progress = MathClamp(Task.Progress + 0.02, Math.Min(0.45 + PeerCount * 0.05, 0.65), 0.99)
Task.Progress = MathClamp(Task.Progress + 0.02, Math.Min(0.45 + PeerCount * 0.05, 0.65), 0.95)
End Select
'超时判定
If LastProgress <> Task.Progress Then
@@ -547,49 +588,112 @@ Public Class PageLinkMain
End If
Loop Until Task.IsAborted
If Task.IsAborted Then Throw New ThreadInterruptedException
'等待连接稳定,最多 5s
If IsServerSide Then Return
UpdateLoadingPage("连接优化中……", "优化连接")
Task.Progress = 0.999
For i = 1 To 50
Dim Server = GetTargetPeer()
If Server IsNot Nothing AndAlso Not Server.Relay AndAlso Server.Ping < 100 Then Return '结束
If Task.IsAborted Then Throw New ThreadInterruptedException
Thread.Sleep(100)
Next
End Sub
''' <summary>
''' 从在线配置和 API 获取节点列表
''' 从在线配置和 API 获取需要连接的节点列表,并更新发现节点 ID
''' 根据发现节点 ID会有以下行为变化
''' -1作为房主根据负载均衡选择一个发现节点。
''' 0作为加入者但邀请码未提供发现节点 ID使用回退发现节点。
''' >0作为加入者根据 ID 选择对应的发现节点;如果没有,使用回退发现节点。
''' </summary>
Private Function GetOnlinePeers() As List(Of String)
Dim Peers As List(Of String) = ServerConfig("Link")("Peers").Select(Function(p) p.ToString).ToList()
Private Function GetTargetPeers() As List(Of String)
Dim FinalPeers As New List(Of String), FinalDiscoverID As Integer = -1
Dim FallbackDiscoverID = ServerConfig("Link")("DiscoverPeerId").ToObject(Of Integer)
Dim FallbackDiscoverAddress As String = ServerConfig("Link")("DiscoverPeer").ToString()
Try
'从 API 获取节点列表
Dim BlackList As List(Of String) = ServerConfig("Link")("PeersBlackList").Select(Function(p) p.ToString).ToList() '黑名单
Dim CentralNodes As New List(Of String)
Dim RandomNodes As New List(Of Tuple(Of String, Double))
For Each Node As JObject In CType(GetJson(NetRequestByClientRetry("https://uptime.easytier.cn/api/nodes?page=1&per_page=200")), JObject)("data")("items")
Dim RawNodes As JObject
Dim IsFallbackRawList As Boolean = False
Try
RawNodes = GetJson(NetRequestByClient("https://uptime.easytier.cn/api/nodes?page=1&per_page=1000", RequireJson:=True))
Catch exx As Exception
Log(exx, "从源站获取节点列表失败,将使用 CDN 缓存")
RawNodes = GetJson(NetRequestByClientRetry("https://easytier.meloong.com/?page=1&per_page=1000", RequireJson:=True))
IsFallbackRawList = True
End Try
'分析节点列表
Dim Nodes As New List(Of JObject) '负载会添加在 load 字段上
Dim BlackList As List(Of String) = ServerConfig("Link")("PeersBlackList").Select(Function(p) p.ToString).ToList()
For Each Node As JObject In RawNodes("data")("items")
'状态检查
If Node("protocol").ToString <> "tcp" Then Continue For
If Node("current_health_status").ToString <> "healthy" Then Continue For
If Not Node("is_active").ToObject(Of Boolean) Then Continue For
If Not Node("is_approved").ToObject(Of Boolean) Then Continue For
Dim ID = Node("id").ToObject(Of Integer)
If Not Node("is_active").ToObject(Of Boolean) OrElse Not Node("is_approved").ToObject(Of Boolean) Then Continue For
If ID = DiscoverNodeID Then GoTo ForcedPass '若为指定的发现节点,忽略后续检查
If ID = FallbackDiscoverID Then Continue For '不主动选取回退发现节点
If BlackList.Contains(Node("address").ToString) Then Continue For 'ServerConfig 黑名单
If Node("usage_percentage").ToObject(Of Double) = 0 AndAlso RandomInteger(1, 100) <> 1 Then Continue For '或许节点有问题才导致是 0 负载,让它只有 1% 概率被选中
'标签检查
Dim Tags = Node("tags").Select(Function(t) t.ToString).ToList
If Not Tags.Contains("国内") Then Continue For
If Tags.Contains("即将下线") Then Continue For
Dim Address As String = Node("address").ToString
If BlackList.Contains(Address) Then Continue For
'添加节点
If Tags.Contains("MC") Then
CentralNodes.Add(Address)
Else
If Not Node("allow_relay").ToObject(Of Boolean) Then Continue For
If Node("usage_percentage").ToObject(Of Double) = 0 Then Continue For '或许节点有问题才导致是 0 负载
RandomNodes.Add(New Tuple(Of String, Double)(
Address,
Node("usage_percentage").ToObject(Of Double) * (103 - Node("health_percentage_24h").ToObject(Of Double)))) '负载,越低越好
End If
If Not Tags.Contains("国内") OrElse Not Tags.Contains("MC中继") Then Continue For
'计算负载并加入列表
ForcedPass:
Dim Load As Double = Node("usage_percentage").ToObject(Of Double) '负载
Load *= 110 - Node("health_percentage_24h").ToObject(Of Double) '可用率
Node("load") = Load
Nodes.Add(Node)
Next
RandomNodes = RandomNodes.OrderBy(Function(n) n.Item2).ToList()
Log($"[Link] 获取到 {CentralNodes.Count} 个中心节点,{RandomNodes.Count} 个随机节点")
'选择节点
Dim RandomCount As Integer = ServerConfig("Link")("RandomPeer").ToObject(Of Integer)
If RandomNodes.Count < RandomCount Then Throw New Exception($"可用的随机节点数量不足,需要 {RandomCount} 个,实际 {RandomNodes.Count} 个")
Peers = CentralNodes.Concat(RandomNodes.Take(RandomCount).Select(Function(n) n.Item1)).ToList()
'排序
If Not IsFallbackRawList Then
Nodes = Nodes.OrderBy(Function(n) n("load").ToObject(Of Double)).ToList() '按负载从低到高排序
Else
Nodes = Nodes.Shuffle().ToList() '回退到 CDN 缓存时,由于负载数据可能过期,直接随机选择
End If
'选取发现节点
Dim SelectedDiscoverNode As JObject = Nothing
If DiscoverNodeID = -1 Then '-1作为房主根据负载均衡选择一个发现节点
SelectedDiscoverNode = Nodes.FirstOrDefault(Function(n) Not n("allow_relay").ToObject(Of Boolean))
ElseIf DiscoverNodeID > 0 Then '>0作为加入者根据 ID 选择对应的发现节点;如果没有,使用回退发现节点
SelectedDiscoverNode = Nodes.FirstOrDefault(Function(n) n("id").ToObject(Of Integer) = DiscoverNodeID)
If SelectedDiscoverNode Is Nothing Then
Log($"[Link] 未找到 ID {DiscoverNodeID} 的发现节点", LogLevel.Debug)
Panic("房间已过期", "请让房主重新创建房间!")
Throw New ThreadInterruptedException
End If
End If
If SelectedDiscoverNode Is Nothing Then '使用回退发现节点
SelectedDiscoverNode = New JObject From {{"address", FallbackDiscoverAddress}, {"id", FallbackDiscoverID}}
Log("[Link] 将使用回退发现节点", LogLevel.Debug)
End If
FinalPeers.Add(SelectedDiscoverNode("address").ToString())
FinalDiscoverID = SelectedDiscoverNode("id").ToObject(Of Integer)
Log($"[Link] 发现节点:{SelectedDiscoverNode("address")} (ID: {FinalDiscoverID})")
'选取中继节点
If ModeDebug OrElse Not IsServerSide Then '房主只连接发现节点,不连接中继节点
Dim RelayCount As Integer = ServerConfig("Link")("RandomPeer").ToObject(Of Integer)
Dim RelayNodes = Nodes.Where(Function(n) n("allow_relay").ToObject(Of Boolean)).ToList()
If RelayNodes.Count < RelayCount Then Throw New Exception($"可用的中继节点数量不足,需要 {RelayCount} 个,实际 {RelayNodes.Count} 个")
FinalPeers.AddRange(RelayNodes.Take(RelayCount).Select(Function(n) n("address").ToString()))
End If
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
Log(ex, "获取节点列表失败,联机质量可能受到影响", LogLevel.Hint)
FinalPeers.AddRange(ServerConfig("Link")("Peers").Select(Function(p) p.ToString))
If FinalDiscoverID <= 0 Then
FinalPeers.Add(FallbackDiscoverAddress)
FinalDiscoverID = FallbackDiscoverID
End If
End Try
Return Peers
'版本 1 兼容
If CType(ServerConfig("Link"), JObject).ContainsKey("EnableForcedPeer") Then
FinalPeers.Add("tcp://mc1.easytier.cn:55558")
If FinalDiscoverID <= 0 Then FinalDiscoverID = 94
End If
'强制添加的节点
FinalPeers.AddRange(ServerConfig("Link")("MandatoryPeers").Select(Function(p) p.ToString))
'结束
DiscoverNodeID = FinalDiscoverID
Return FinalPeers.Distinct.ToList
End Function
#End Region
@@ -638,6 +742,11 @@ Public Class PageLinkMain
''' 出现意外错误,给出错误信息并结束联机。
''' </summary>
Private Sub Panic(Brief As String, Detail As String)
'常见原因分析
If Detail.Contains("failed to listen on ") Then
Detail = $"监听端口失败。{vbCrLf}请点击重试,如果还是出现此错误,可以重启电脑解决。{vbCrLf}{vbCrLf}{Detail}"
End If
'显示信息
If LinkState = LinkStates.Loading Then
FailReason = Brief
LinkLoader.Failed(New Exception(Detail))
@@ -739,9 +848,13 @@ Public Class PageLinkMain
''' </summary>
Public ReadOnly Name As String
''' <summary>
''' 连接方式
''' 是否通过中继连接。
''' </summary>
Public ReadOnly Cost As String
Public ReadOnly Relay As Boolean
''' <summary>
''' NAT 类型。
''' </summary>
Public ReadOnly NATType As NATTypes
''' <summary>
''' 从 CLI 给出的信息分析对应的数据。
@@ -749,7 +862,7 @@ Public Class PageLinkMain
Public Sub New(Info As JObject)
'类别
Dim PeerName = Info("hostname").ToString
If PeerName = HostName Then
If Info("cost").ToString = "Local" Then
Type = Types.Self
ElseIf PeerName.StartsWithF("Client") Then
Type = Types.Client
@@ -759,20 +872,42 @@ Public Class PageLinkMain
Type = Types.Misc
End If
'基础信息
Ping = If(Info("lat_ms").ToString = "-", 0, Info("lat_ms").ToString)
Double.TryParse(Info("lat_ms"), NumberStyles.Any, CultureInfo.InvariantCulture, Ping)
Name = PeerName
Cost = Info("cost")
Relay = Info("cost").ToString.ContainsF("relay", True)
NATType = Info("nat_type").ToString.ParseToEnum(Of NATTypes)
End Sub
Public Overrides Function ToString() As String
Return $"{Type} - {Name} - Ping {Ping:0.0}ms [{Cost}]"
Return $"{Type} - {Name} - Ping {Ping:0.0}ms [中继? {Relay}] - NAT {NATType}"
End Function
End Class
Private Enum NATTypes
'https://github.com/EasyTier/EasyTier/blob/6bb2fd9a15ab2499bdeabdcc3a925e9bd9aebf50/easytier/src/proto/common.proto#L129
Unknown = 0
OpenInternet = 1
NoPAT = 2
FullCone = 3
Restricted = 4
PortRestricted = 5
Symmetric = 6
SymUdpFirewall = 7
SymmetricEasyInc = 8
SymmetricEasyDec = 9
''' <summary>
''' 尚未获取。
''' </summary>
Pending = 10
End Enum
''' <summary>
''' 当前的节点列表,使用 RefreshPeerLoader 来刷新。
''' 若尚未成功获取过则为 Nothing但保证在加载完成后至少是一个列表。
''' </summary>
Private Peers As List(Of Peer) = Nothing
''' <summary>
''' 自己的 NAT 类型。
''' </summary>
Private NATType As NATTypes = NATTypes.Pending
''' <summary>
''' 调用 EasyTier CLI 获取已连接节点信息。
@@ -781,25 +916,22 @@ Public Class PageLinkMain
''' </summary>
Private RefreshPeerLoader As New LoaderTask(Of Integer, List(Of Peer))("EasyTier CLI", AddressOf RefreshPeer)
Private Sub RefreshPeer()
'| ipv4 | hostname | cost | lat(ms) | loss | rx | tx | tunnel | NAT | version |
'|-------------------|-----------------------|----------|---------|------|---------|---------|--------|----------------|----------------|
'| 10.114.114.1/24 | Client-RJ458A | Local | - | - | - | - | - | Unknown | 2.4.5-4c4d172e |
'| | PublicServer_公用服务器| p2p | 48.40 | 0.0% | 875 B | 1.26 kB | tcp | NoPat | 2.4.5-4c4d172e |
'| 10.114.114.114/24 | Server-J6P6IW | p2p | 5.63 | 0.0% | 1.65 kB | 1.64 kB | udp | PortRestricted | 2.4.5-4c4d172e |
'| 10.114.114.114/24 | Server-J6PHIW (连接中) | relay(2) | 1000.00 | 0.0% | 0 B | 0 B | | PortRestricted | 2.4.5-4c4d172e |
Try
Dim CliResult = StartProcessAndGetOutput(PathEasyTier & "联机模块 CLI.exe", $"-o json -p 127.0.0.1:{RPCPort} peer", 2000, Encoding:=Encoding.UTF8, PrintLog:=False)
'解析
If Not CliResult.Contains("lat_ms") Then Throw New Exception("CLI 调用失败:" & vbCrLf & CliResult)
If GetUuid() Mod If(ModeDebug, 23, 103) = 0 Then Log("[EasyTier] CLI 输出抽样:" & vbCrLf & CliResult)
Dim NewPeers As New List(Of Peer)
For Each Line As JObject In CType(GetJson(CliResult), JArray).Skip(1)
For Each Line As JObject In CType(GetJson(CliResult), JArray)
Try
Dim Peer = New Peer(Line)
If Peer.Type = Peer.Types.Self Then Continue For '自己
If Peer.Type = Peer.Types.Self Then
NATType = Peer.NATType '记录自己的 NAT
Else
NewPeers.Add(Peer)
End If
Catch exx As Exception
Log(exx, $"错误的信息{Line}")
Log(exx, $"错误的信息({Line}")
End Try
Next
'完成
@@ -829,7 +961,7 @@ Public Class PageLinkMain
Return Peer.Ping
End Function
''' <summary>
''' 服务端会返回所有节点中 Ping 的那一个,客户端会返回服务端。
''' 服务端会返回所有节点中 Ping 大于 0 最低的那一个,客户端会返回服务端。
''' 若没有则为 Nothing。
''' </summary>
Private Function GetTargetPeer() As Peer
@@ -841,7 +973,7 @@ Public Class PageLinkMain
Targets = Peers.Where(Function(p) p.Type = Peer.Types.Server AndAlso p.Ping > 0)
End If
If Not Targets.Any Then Return Nothing
'返回 Ping 大于 0 且最低的那个
'返回 Ping 且最低的那个
Dim MinPing = Targets.Min(Function(p) p.Ping)
Return Targets.First(Function(p) p.Ping = MinPing)
End Function
@@ -862,8 +994,8 @@ Public Class PageLinkMain
#Region "定时任务"
'启动
Private IsTimerStarted As Boolean = False
Private Sub StartTimerThread() Handles Me.Loaded
Static IsTimerStarted As Boolean = False
If IsTimerStarted Then Return
RunInNewThread(
Sub()
@@ -888,38 +1020,66 @@ Public Class PageLinkMain
End Sub
'每秒或进入页面时触发
Private BroadcastSocket As New Socket(SocketType.Dgram, ProtocolType.Udp)
Private Sub Update() Handles Me.Loaded
If LinkState <> LinkStates.Finished Then Return
'重新获取信息
SyncLock RefreshPeerLoader.LockState
If RefreshPeerLoader.State <> LoadState.Loading Then RefreshPeerLoader.Start(IsForceRestart:=True)
End SyncLock
'更新 Ping 与人数显示
'更新 UI
If FrmMain.PageCurrent = FormMain.PageType.Link Then
RunInUi(
Sub()
'Logo 旋转动画
AniStart(AaRotateTransform(ImgFinishLogo, 500, 5000), "Link Logo Rotation")
'Ping
Dim Ping As Double = GetPeerPing()
Dim RelayLayer As Integer = If(GetTargetPeer().Cost.RegexSeek("(?<=relay\()\d+") Is Nothing,
0, Val(GetTargetPeer().Cost.RegexSeek("(?<=relay\()\d+")) - 1)
'更新 Ping 显示
If Ping Mod 500 = 0 OrElse $"{Ping:0.0}" = "1.0" OrElse FailCount > 0 Then
LabFinishPing.Text = "连接中"
AniStop("Link Logo Rotation")
Dim Connecting As Boolean = Ping Mod 500 = 0 OrElse $"{Ping:0.0}" = "1.0" OrElse FailCount > 0
If Connecting Then
LabFinishPing.Text = "连接优化中"
Else
LabFinishPing.Text =
If(RelayLayer > 0, If(RelayLayer > 1, $"中继 {RelayLayer} · ", "中继 · "), "") & '使用中继连接时显示 “中继” 前缀
If(Ping >= 10, $"{Ping:0}ms", $"{Ping:0.0}ms")
AniStart(AaRotateTransform(ImgFinishLogo, 500, 5000), "Link Logo Rotation") 'Logo 旋转动画
LabFinishPing.Text = If(Ping >= 10, $"{Ping:0}ms", $"{Ping:0.0}ms")
End If
'更新 Ping 的 Tooltip 显示
Dim Tooltip As String = If(IsServerSide, "网络延迟", "与房主的延迟")
If RelayLayer Then Tooltip &= If(IsServerSide,
$"(你的网络环境较差,正经过 {RelayLayer} 层中继,可能会有点卡)",
$"(你或者房主的网络环境较差,正经过 {RelayLayer} 层中继,可能会有点卡)")
BtnFinishPing.ToolTip = Tooltip
'更新人数显示
'人数显示
LabFinishPlayer.Text = PeopleCount & "  人"
'------------------------
' 提示条
'------------------------
HintFinish.Visibility = Visibility.Collapsed
If IsServerSide Then Return '服务端没有需要显示的提示
If Connecting Then Return '连接稳定过程中不显示提示
'中继提示
Dim Server As Peer = GetTargetPeer()
If Server Is Nothing Then Return
If Server.Relay Then
If NATType >= NATTypes.Symmetric AndAlso Server.NATType >= NATTypes.Symmetric Then
HintFinish.Text = "你和房主的网络环境都不太好,"
ElseIf NATType >= NATTypes.Symmetric Then
HintFinish.Text = "你的网络环境不太好,"
ElseIf Server.NATType >= NATTypes.Symmetric Then
HintFinish.Text = "房主的网络环境不太好,"
Else
HintFinish.Text = "你或者房主的网络环境不太好,"
End If
If String.IsNullOrWhiteSpace(Setup.Get("LinkCustomPeer")) Then
HintFinish.Text &= "正使用社区节点进行中继。"
Else
HintFinish.Text &= "正通过自定义节点进行中继。"
End If
HintFinish.Visibility = Visibility.Visible
HintFinish.Theme = MyHint.Themes.Yellow
Return
End If
'环境比房主更好的提示
If NATType >= NATTypes.PortRestricted Then Return '自身的 NAT 为 2 或更好
If Server.NATType < NATTypes.PortRestricted Then Return '房主的 NAT 为 3 或更差
Dim OtherPlayers = Peers.Where(Function(p) p.Type = Peer.Types.Client).ToList()
If Not OtherPlayers.Any() Then Return '房间里还有其他玩家
If OtherPlayers.Any(Function(p) p.Relay) Then Return '自己可以与所有玩家打洞
If OtherPlayers.All(Function(p) p.NATType < NATTypes.PortRestricted) Then Return '任意其他玩家的 NAT 为 3 或更差
HintFinish.Visibility = Visibility.Visible
HintFinish.Theme = MyHint.Themes.Blue
HintFinish.Text = "你的网络环境比房主更好!如果你来当房主,其他玩家或许能更加流畅!"
End Sub)
End If
'检查核心状态
@@ -937,6 +1097,7 @@ Public Class PageLinkMain
'广播联机房间端口
If Not IsServerSide Then
Try
Static BroadcastSocket As New Socket(SocketType.Dgram, ProtocolType.Udp)
BroadcastSocket.SendTo(
Encoding.UTF8.GetBytes($"[MOTD]PCL 联机房间[/MOTD][AD]{ClientPort}[/AD]"),
SocketFlags.None,

View File

@@ -113,6 +113,7 @@
{"LaunchRamCustom", New SetupEntry(15)},
{"LinkLastAutoJoinInviteCode", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkShareMode", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LinkLatencyMode", New SetupEntry(0, Source:=SetupSource.Registry)},
{"LinkCustomPeer", New SetupEntry("")},
{"LinkEasyTierVersion", New SetupEntry(-1, Source:=SetupSource.Registry)},
{"ToolHelpChinese", New SetupEntry(True, Source:=SetupSource.Registry)},

View File

@@ -6,7 +6,26 @@
PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard Margin="0,15" Title="高级设置" IsSwapped="True" CanSwap="True">
<local:MyCard x:Name="CardArgument" Margin="0,15" Title="连接选项">
<StackPanel Margin="25,40,25,20">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="60" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="模式" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="0" x:Name="ComboLatencyMode" Grid.ColumnSpan="2" Tag="LinkLatencyMode" Grid.Column="1">
<local:MyComboBoxItem Content="优先直连" IsSelected="True" ToolTip="尽量不进行中转,而是 P2P 直连。" />
<local:MyComboBoxItem Content="优先低延迟" ToolTip="如果使用中转节点能降低延迟,就不进行直连。&#xa;不过,这会增加社区节点的负载……" />
</local:MyComboBox>
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="高级设置" IsSwapped="True" CanSwap="True">
<Grid Margin="25,40,25,22">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
@@ -25,8 +44,8 @@
<StackPanel Orientation="Horizontal" Grid.Row="2" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyButton MinWidth="140" Padding="13,5" Margin="0,0,20,0" HorizontalAlignment="Left"
Text=" 光荣地贡献节点!" ColorType="Highlight"
ToolTip="联机功能全靠社区的各位无私贡献的节点才能存在!&#xa;如果你有空闲的服务器,欢迎搭建一个共享节点,人人为我,我为人人嘛……&#xa;&#xa;你可以在 EasyTier 的【搭建共享节点】文档中查看搭建方式,搭建好后点击这里提交。&#xa;PCL 会自动选取节点进行连接。"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://uptime.easytier.cn/submit" />
ToolTip="联机功能全靠社区的各位无私贡献的节点才能存在!&#xa;如果你有空闲的高带宽服务器,欢迎搭建一个共享节点,人人为我,我为人人嘛……"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://shimo.im/docs/qKPttVvXKqPD8YDC#anchor-Dupo" />
<local:MyButton MinWidth="140" Padding="13,5" Margin="0,0,20,0" HorizontalAlignment="Left"
Text="节点状态"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://uptime.easytier.cn/" />

View File

@@ -17,6 +17,7 @@
End Sub
Public Sub Reload()
ComboLatencyMode.SelectedIndex = Setup.Get("LinkLatencyMode")
CheckShareMode.Checked = Setup.Get("LinkShareMode")
TextCustomPeer.Text = Setup.Get("LinkCustomPeer")
End Sub
@@ -24,6 +25,7 @@
'初始化
Public Sub Reset()
Try
Setup.Reset("LinkLatencyMode")
Setup.Reset("LinkShareMode")
Setup.Reset("LinkCustomPeer")
@@ -43,5 +45,8 @@
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckShareMode.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboLatencyMode.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
End Class