@@ -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}邀请码：{N etworkName}-{NetworkSecret } "
LabFinishDesc . Text = $ " 把邀请码发给朋友，让大家加入房间吧！{vbCrLf}邀请码：{G etInviteCode() } "
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 启动器中输入邀请码【{N etworkName}-{NetworkSecret }】，即可加入联机房间！ "
Dim CodeText As String = $ " 在 PCL 启动器中输入邀请码【{G etInviteCode() }】，即可加入联机房间！ "
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=2 00 " ) ) , 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=10 00 " , 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_公用服务器
'| 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 '自己
NewPeers . Add ( Peer )
If Peer . Type = Peer . Types . Self Then
NATType = Peer . NATType '记录自己的 NAT
Else
NewPeers . Add ( Peer )
End If
Catch exx As Exception
Log ( exx , $ " 错误的信息行 （ ） " )
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} " , $ " {Ping:0.0} " )
AniStart ( AaRotateTransform ( ImgFinishLogo , 500 , 5000 ) , " Link Logo Rotation " ) 'Logo 旋转动画
LabFinishPing . Text = If ( Ping >= 10 , $ " {Ping:0} " , $ " {Ping:0.0} " )
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 ,
龙腾猫跃