| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114 |
- Imports System.Collections.ObjectModel
- Imports System.Globalization
- Imports System.Net.Sockets
- Imports System.Reflection
- Imports PCL
- Public Class PageLinkMain
- Private Const INVITE_CODE_VERSION As Integer = 2
- '===============================
- ' 状态机与前端页面
- '===============================
- #Region "状态管理"
- Public Enum LinkStates
- Waiting
- Loading
- Failed
- Finished
- End Enum
- Public Shared LinkState As LinkStates = LinkStates.Waiting
- ''' <summary>
- ''' 切换到指定的状态。
- ''' </summary>
- Private Sub ChangeState(NewState As LinkStates)
- If LinkState = NewState Then Return
- Dim OldState = LinkState
- LinkState = NewState
- Logger.Info($"主状态由 {OldState} 变更为 {NewState}")
- '触发状态切换
- RunInUi(
- Sub()
- Select Case NewState
- Case LinkStates.Waiting
- SwitchToWaiting(OldState)
- Case LinkStates.Loading
- SwitchToLoading(OldState)
- Case LinkStates.Failed
- SwitchToFailed(OldState)
- Case LinkStates.Finished
- SwitchToFinished(OldState)
- End Select
- End Sub)
- End Sub
- '让加载器的 成功/失败 事件触发状态切换
- Private Sub LoaderInit() Handles Me.Initialized
- PageLoaderInit(Load, PanLoad, PanContent, PanAlways, LinkLoader, AutoRun:=False)
- AddHandler LinkLoader.OnStateChangedUi,
- Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
- Select Case NewState
- Case LoadState.Finished
- ChangeState(LinkStates.Finished)
- Case LoadState.Failed
- Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDisplay(True), "*"))
- ChangeState(LinkStates.Failed)
- End Select
- End Sub
- End Sub
- '页面动画兼容
- Private Sub UpdatePanelVisibility() Handles Me.PageEnter
- FrmLinkMain.PanSelect.Visibility = If(LinkState = LinkStates.Waiting, Visibility.Visible, Visibility.Collapsed)
- FrmLinkMain.PanFinish.Visibility = If(LinkState = LinkStates.Finished, Visibility.Visible, Visibility.Collapsed)
- End Sub
- #End Region
- #Region "初始页面 (Waiting)"
- '由任意状态切换到 Waiting
- Private Sub SwitchToWaiting(OldState As LinkStates)
- '加载器与进程状态
- LinkLoader.Cancel()
- SyncLock LinkLoader.LockState
- LinkLoader.State = LoadState.Waiting
- End SyncLock
- ProcessStop()
- '页面切换
- If OldState <> LinkStates.Finished Then
- '从完成页面退出时,PageOnContentExit 结束会触发 PageEnter 事件,这会调用 UpdatePanelVisibility
- '如果在现在提前调用了,会丢失完成页面的退出动画
- UpdatePanelVisibility()
- End If
- PageOnContentExit()
- End Sub
- '===============================
- ' 页面 UI
- '===============================
- '创建
- Private Sub Create_MouseLeftButtonUp() Handles PanSelectCreate.MouseLeftButtonUp
- '输入端口号
- Dim Port As String = MyMsgBoxInput("输入端口", $"在单人游戏的暂停菜单选择 {vbLQ}对局域网开放{vbRQ},然后输入端口数字。{vbCrLf}甚至可以输入其他游戏的端口……嗯……",
- ValidateRules:=New Collection(Of Validate) From {New ValidateInteger(1024, 65535)},
- HintText:="端口号")
- If Port Is Nothing Then Return
- '基础信息
- IsServerSide = True
- ServerPort = Port
- Dim GenerateRandomCode =
- Function() As String
- Dim Result As String = ""
- For i = 1 To 5
- Result &= RandomInteger(0, 35).ConvertRadix(36)
- Next
- Return Result.Replace("O", "0").Replace("I", "1")
- End Function
- NetworkName = $"P{ServerPort.ConvertRadix(16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
- NetworkSecret = GenerateRandomCode()
- DiscoverNodeID = -1
- Logger.Info($"尝试创建房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
- '启动
- ChangeState(LinkStates.Loading)
- End Sub
- '加入
- Private Shared LastCode As String = Nothing
- ''' <summary>
- ''' 输入邀请码,切换到联机页并立即加入房间。
- ''' </summary>
- Public Shared Sub Join() Handles PanSelectJoin.MouseLeftButtonUp
- Dim Code As String = MyMsgBoxInput("输入邀请码", "输入房主发给你的邀请码。",
- 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)
- End Sub
- Public Sub JoinInternal(Code As String)
- If Code Is Nothing Then Return
- '基础格式校验
- Dim ValidateResult = ValidateCodeFormat(Code)
- If ValidateResult IsNot Nothing Then
- Hint(ValidateResult, HintType.Red)
- Return
- End If
- Code = FixCodeFormat(Code)
- Logger.Info($"实际使用的邀请码:{Code}")
- '基础信息
- IsServerSide = False
- ServerPort = Code.Substring(1, 4).Upper.ConvertRadix(16, 10)
- NetworkName = Code.Substring(0, 11)
- NetworkSecret = Code.Substring(12, 5)
- If Code.Substring(20, 3) = "000" Then
- DiscoverNodeID = -2
- Else
- DiscoverNodeID = Code.Substring(20, 3).Upper.ConvertRadix(16, 10)
- End If
- Logger.Info($"尝试加入房间,网络名 {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 = 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 创建房间!"
- ElseIf Code.Length = 10 Then 'PCL CE
- Return "请让房主使用非社区版的 PCL 创建房间!"
- Else
- 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.Upper.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
- '自动加入
- ''' <summary>
- ''' 切换到联机页并立即加入指定房间。
- ''' </summary>
- Public Shared Sub Join(Code As String)
- If LinkState <> LinkStates.Waiting Then
- Hint("你已经在联机房间中了!", HintType.Red)
- ElseIf FrmMain.PageCurrent = FormMain.PageType.Link Then
- FrmLinkMain.JoinInternal(Code)
- Else
- AutoJoinCode = Code
- FrmMain.PageChange(FormMain.PageType.Link, FormMain.PageSubType.LinkMain)
- End If
- End Sub
- '在进入页面时自动尝试加入房间
- Private Shared AutoJoinCode As String = Nothing
- Private Sub PanSelectJoin_Loaded() Handles PanSelectJoin.Loaded
- If AutoJoinCode Is Nothing Then Return
- If LinkState = LinkStates.Waiting Then JoinInternal(AutoJoinCode)
- AutoJoinCode = Nothing
- End Sub
- #End Region
- #Region "加载页面 (Loading | Failed)"
- '由 Waiting 或 Failed 状态切换到 Loading
- Private Sub SwitchToLoading(OldState As LinkStates)
- '清理变量
- Peers = Nothing
- FailCount = 0
- '加载器与进程状态
- LinkLoader.Start(IsForceRestart:=True)
- '页面切换会由 Loader 调用 MyPageRight 来触发
- 'UI 更新
- UpdateProgressBar(0)
- LabLoadTitle.Text = If(IsServerSide, "创建房间中", "加入房间中")
- UpdateLoadingPage("正在初始化……", "准备初始化")
- End Sub
- '由 Loading 状态切换到 Failed
- Private Sub SwitchToFailed(OldState As LinkStates)
- '加载器与进程状态
- LinkLoader.Cancel()
- ProcessStop()
- 'UI 更新
- UpdateProgressBar(1)
- '显示错误信息
- LabLoadTitle.Text = FailReason
- Dim Brief As String = LinkLoader.Error.GetDisplay(False)
- Dim InnerEx As Exception = LinkLoader.Error
- If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
- Do Until InnerEx.InnerException Is Nothing
- InnerEx = InnerEx.InnerException
- If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
- Loop
- LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDisplay(True))
- Logger.Warn(LinkLoader.Error, LabLoadTitle.Text)
- End Sub
- '===============================
- ' 页面 UI
- '===============================
- Private Sub UpdateLoadingPage(Title As String, FailBrief As String)
- If FailReason = FailBrief & "失败" Then Return
- FailReason = FailBrief & "失败"
- Logger.Info($"开始步骤:{Title}")
- RunInUiWait(
- Sub()
- If FrmLinkMain Is Nothing OrElse Not FrmLinkMain.LabLoadDesc.IsLoaded Then Return
- FrmLinkMain.LabLoadDesc.Text = Title
- End Sub)
- End Sub
- Private FailReason As String = "准备初始化"
- '取消加载
- Private Sub BtnLoadCancel_Click() Handles BtnLoadCancel.Click
- ChangeState(LinkStates.Waiting)
- End Sub
- '点击重试
- Private Sub CardLoad_MouseLeftButtonUp() Handles CardLoad.MouseLeftButtonUp
- ChangeState(LinkStates.Loading)
- End Sub
- '进度条
- Private Sub UpdateProgressBar(Optional Value As Double = -1)
- If Value = -1 Then Value = LinkLoader.Progress
- Dim DisplayingProgress As Double = ColumnProgressA.Width.Value
- If Math.Round(Value - DisplayingProgress, 3) = 0 Then Return
- If DisplayingProgress <= Value Then
- Dim NewProgress As Double = If(Value = 1, 1, DisplayingProgress +
- (Value - DisplayingProgress) ^ 2 * 0.5)
- AniStart({
- AaGridLengthWidth(ColumnProgressA, NewProgress - ColumnProgressA.Width.Value, 200),
- AaGridLengthWidth(ColumnProgressB, (1 - NewProgress) - ColumnProgressB.Width.Value, 200)
- }, "Link Progress")
- Else
- ColumnProgressA.Width = New GridLength(Value, GridUnitType.Star)
- ColumnProgressB.Width = New GridLength(1 - Value, GridUnitType.Star)
- AniStop("Link Progress")
- End If
- End Sub
- Private Sub CardLoad_SizeChanged() Handles CardLoad.SizeChanged
- RectProgressClip.Rect = New Rect(0, 0, CardLoad.ActualWidth, 12)
- End Sub
- #End Region
- #Region "完成页面 (Finished)"
- '由 Loading 状态切换到 Finished
- Private Sub SwitchToFinished(OldState As LinkStates)
- '由于只可能从加载器的完成事件触发,不需要管加载器
- UpdatePanelVisibility() '页面的实际切换会由 Loader 调用 MyPageRight 来触发
- 'UI 更新
- If IsServerSide Then
- LabFinishTitle.Text = "已创建房间"
- LabFinishDesc.Text = $"把邀请码发给朋友,让大家加入房间吧!{vbCrLf}邀请码:{GetInviteCode()}"
- BtnFinishExit.Text = "关闭"
- BtnFinishPing.ToolTip = "网络延迟"
- BtnFinishCopy.Visibility = Visibility.Visible
- Copy() '立即复制邀请码
- '下边栏
- BtnFinishPort.Visibility = Visibility.Visible
- LabFinishPort.Visibility = Visibility.Visible
- BtnFinishIp.Visibility = Visibility.Collapsed
- LabFinishIp.Visibility = Visibility.Collapsed
- LabFinishPort.Text = ServerPort
- Else
- LabFinishTitle.Text = "已加入房间"
- LabFinishDesc.Text = $"在多人游戏页面的最下方就能找到联机房间!{vbCrLf}注意:使用离线登录时不要手动输入 IP!"
- BtnFinishExit.Text = "离开"
- BtnFinishPing.ToolTip = "与房主的延迟"
- BtnFinishCopy.Visibility = Visibility.Collapsed
- '下边栏
- BtnFinishPort.Visibility = Visibility.Collapsed
- LabFinishPort.Visibility = Visibility.Collapsed
- LabFinishIp.Text = ClientAddress
- BtnFinishIp.Visibility = Visibility.Visible
- LabFinishIp.Visibility = Visibility.Visible
- End If
- Update() '立即刷新
- End Sub
- '===============================
- ' 页面 UI
- '===============================
- '退出
- Private Sub BtnFinishExit_Click() Handles BtnFinishExit.Click
- TryExit(False, False)
- End Sub
- ''' <summary>
- ''' 退出联机。
- ''' 返回是否弹出了警告窗口并且玩家选择了取消。
- ''' </summary>
- Public Function TryExit(Silent As Boolean, Closing As Boolean) As Boolean
- If LinkState = LinkStates.Waiting OrElse LinkState = LinkStates.Failed Then Return False
- If Not Silent Then
- If IsServerSide AndAlso PeopleCount > 1 Then
- If MyMsgBox("你确定要关闭联机房间吗?" & vbCrLf & "所有玩家都需要重新输入邀请码才可加入游戏!", "退出联机", "确定", "取消", IsWarn:=True) = 2 Then Return True
- ElseIf Closing Then
- If MyMsgBox(If(IsServerSide, "你确定要关闭联机房间吗?", "你确定要离开联机房间吗?"), "退出联机", "确定", "取消") = 2 Then Return True
- End If
- End If
- ChangeState(LinkStates.Waiting)
- Return False
- End Function
- '复制邀请码
- Private Sub Copy() Handles BtnFinishCopy.Click
- Dim CodeText As String = $"在 PCL 启动器中输入邀请码【{GetInviteCode()}】,即可加入联机房间!"
- ClipboardSet(CodeText, SuccessHint:="已复制邀请码!")
- Settings.Set("LinkLastAutoJoinInviteCode", CodeText)
- End Sub
- Private Function GetInviteCode() As String
- Return $"{NetworkName}-{NetworkSecret}-{INVITE_CODE_VERSION.ToString.PadLeft(2, "0"c)}{ _
- If(DiscoverNodeID = -1, 0, DiscoverNodeID).ConvertRadix(16).PadLeft(3, "0"c)}"
- End Function
- '复制 IP
- Private Sub BtnFinishIp_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishIp.MouseLeftButtonUp
- ClipboardSet(ClientAddress, SuccessHint:="已复制服务器地址!")
- End Sub
- #End Region
- '===============================
- ' 后端
- '===============================
- ''' <summary>
- ''' EasyTier 所在的文件夹路径,以 \ 结尾。
- ''' </summary>
- Private PathEasyTier As String = Paths.AppDataThenName & "EasyTier\"
- ''' <summary>
- ''' 当前是服务端还是客户端。
- ''' </summary>
- Private IsServerSide As Boolean
- ''' <summary>
- ''' 服务端映射前的端口号。
- ''' </summary>
- Private ServerPort As Integer
- ''' <summary>
- ''' 客户端映射后的端口号。
- ''' </summary>
- Private ClientPort As Integer
- ''' <summary>
- ''' RPC 端口号。
- ''' </summary>
- Private RPCPort As Integer
- ''' <summary>
- ''' 在客户端映射后的地址。
- ''' 除非已作为客户端启动 EasyTier,否则一直为 Nothing。
- ''' </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
- #Region "加载"
- Private WithEvents LinkLoader As New LoaderCombo(Of Integer)("联机", {
- 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}
- })
- '1. 获取服务器配置
- Private Sub InitConfig(Task As LoaderTask(Of Integer, Integer))
- UpdateLoadingPage("正在联网获取配置……", "联网获取配置")
- If VersionBranchMain <> "Official" Then
- Throw New Exception($"$开源版无法联网获取配置。{vbCrLf}你可以在 PCL 官方版的缓存文件夹下查看 ServerConfig 的当前内容, 并在代码中进行相应修改。")
- End If
- ServerLoader.WaitForExit(LoaderToSyncProgress:=Task)
- If ServerConfig Is Nothing Then Throw New Exception("无法从服务器获取配置")
- '检查是否已禁用联机功能
- Dim DisableReason = ServerConfig("Link")?("DisableReason2")?.ToString
- If Not String.IsNullOrEmpty(DisableReason) Then Throw New Exception("$" & DisableReason) 'TODO: 可能不会显示错误原因?
- 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
- '2. 获取需要下载的文件
- Private ServerVersion As Integer
- Private Sub InitPrepareDownload(Task As LoaderTask(Of Integer, List(Of NetFile)))
- '获取 CPU 架构
- UpdateLoadingPage("正在获取 CPU 架构……", "获取 CPU 架构")
- Dim Architecture As String = GetType(String).Assembly.GetName().ProcessorArchitecture
- Select Case Architecture
- Case ProcessorArchitecture.X86
- Architecture = "i686"
- Case ProcessorArchitecture.Amd64
- Architecture = "x86_64"
- Case ProcessorArchitecture.Arm
- Architecture = "arm64"
- Case Else
- Logger.Warn($"CPU 是不支持的 {Architecture} 架构,这可能会导致联机模块无法启动!")
- Architecture = "arm64"
- End Select
- Logger.Info($"CPU 架构:{Architecture}")
- Telemetry("联机开始")
- '检查 EasyTier 版本
- UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本")
- If Not (FileUtils.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso FileUtils.Exists(PathEasyTier & "联机模块.exe") AndAlso
- FileUtils.Exists(PathEasyTier & "Packet.dll")) Then
- Settings.Set("LinkEasyTierVersion", -1)
- End If
- Dim LocalVersion As Integer = Settings.Get(Of Integer)("LinkEasyTierVersion")
- ServerVersion = ServerConfig("Link")("EasyTierVersion")
- Dim RequiredFiles As New List(Of NetFile)
- Logger.Info($"EasyTier 本地版本:{LocalVersion},需求版本:{ServerVersion}")
- If LocalVersion < ServerVersion Then
- RequiredFiles.Add(New NetFile(
- ServerConfig("Link")("Downloads").Select(Function(UrlEntry) UrlEntry.ToString.Replace("{arch}", Architecture)),
- PathEasyTier & "EasyTier.zip",
- New FileChecker With {.MinSize = 1024 * 1024 * 2}))
- End If
- '开始下载
- UpdateLoadingPage("正在下载联机模块……", "下载联机模块")
- Task.Output = RequiredFiles
- End Sub
- '3. 启动联机模块
- Private Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
- '解压文件
- UpdateLoadingPage("正在解压联机模块……", "解压联机模块")
- If FileUtils.Exists(PathEasyTier & "EasyTier.zip") Then
- '解压
- Dim ExtractPath As String = RequestTaskTempFolder()
- 'FileUtils.ExtractToDirectory(PathEasyTier & "EasyTier.zip", ExtractPath,
- ' progressHandler:=Sub(Percentage) Task.Progress = Percentage * 0.05)
- DirectoryUtils.Copy(DirectoryUtils.EnumerateDirectories(ExtractPath, True).First, PathEasyTier)
- '重命名
- FileUtils.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
- FileUtils.Move(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe")
- '清理
- FileUtils.Delete(PathEasyTier & "EasyTier.zip")
- Settings.Set("LinkEasyTierVersion", ServerVersion)
- End If
- Task.Progress = 0.07
- '获取节点列表
- UpdateLoadingPage("正在获取节点列表……", "获取节点列表")
- Dim RawPeers As List(Of String)
- Dim CustomPeers As String = Settings.Get(Of String)("LinkCustomPeer")
- If String.IsNullOrWhiteSpace(CustomPeers) Then
- If DiscoverNodeID = -2 AndAlso Not IsServerSide Then
- Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容,{vbCrLf}才能进入该房间!")
- Return
- End If
- RawPeers = GetTargetPeers()
- Else
- 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()
- Logger.Info($"使用自定义节点:{CustomPeers}")
- End If
- Task.Progress = 0.13
- '获取空闲端口
- UpdateLoadingPage("正在启动联机模块……", "启动联机模块")
- Dim FreePorts = FindFreePorts(5, ServerPort)
- ClientPort = FreePorts(0)
- RPCPort = FreePorts(1)
- Dim ListenersPort As Integer = FreePorts(2) '它会占用【当前、当前 +1、当前 +2】共三个端口
- '获取启动参数
- Dim Arguments As String = ServerConfig("Link")("Argument")
- Arguments += $" --network-name={NetworkName} --network-secret={NetworkSecret} --listeners {ListenersPort} --rpc-portal {RPCPort} --private-mode true"
- Dim HostName = If(IsServerSide, "Server-", "Client-") & Identify.GetStableHashCode().ConvertRadix(36).TrimStart("-"c).EnsureLength("0", 6)
- If IsServerSide Then
- Arguments += $" -i 10.114.114.114 --hostname={HostName} --tcp-whitelist={ServerPort} --udp-whitelist={ServerPort}"
- Else
- Arguments += $" -d --hostname={HostName} --tcp-whitelist=0 --udp-whitelist=0"
- '端口转发
- ClientAddress = $"localhost:{ClientPort}"
- Arguments += $" --port-forward tcp://[{IPAddress.IPv6Loopback}]:{ClientPort}/10.114.114.114:{ServerPort}"
- Arguments += $" --port-forward udp://[{IPAddress.IPv6Loopback}]:{ClientPort}/10.114.114.114:{ServerPort}"
- 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 RawPeers
- Arguments += $" -p=""{Peer}"""
- Next
- If Settings.Get(Of Integer)("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
- '启动进程
- ProcessStart(Arguments)
- Task.Progress = 0.15
- '等待连接
- Dim TimeoutCounter As Integer = 0
- Do
- Thread.Sleep(500) '为避免还没启动好先跑 CLI 了,先等半秒
- '刷新信息
- CheckCrash()
- RefreshPeerLoader.WaitForExit(IsForceRestart:=True)
- '查找目标节点
- Dim Ping = GetPeerPing()
- If Ping > 0 Then
- Logger.Info($"已与目标建立连接,当前 Ping 为 {Ping:0.0}ms")
- Telemetry("联机成功", "Server", IsServerSide, "NAT", NATType)
- Exit Do '退出循环
- End If
- '更新进度
- Dim LastProgress = Task.Progress
- 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 = (Task.Progress + 0.02).Clamp(0.15, 0.25)
- Case 0 'CLI 有返回,但未连接到任何节点
- UpdateLoadingPage("正在连接到节点……", "连接节点")
- Task.Progress = (Task.Progress + 0.02).Clamp(If(IsServerSide, 0.5, 0.3), If(IsServerSide, 0.95, 0.5))
- Case Else '已连接到节点,但未连接到房主
- UpdateLoadingPage("正在连接到房主……", "连接房主")
- Task.Progress = (Task.Progress + 0.02).Clamp(Math.Min(0.45 + PeerCount * 0.05, 0.65), 0.95)
- End Select
- '超时判定
- If LastProgress <> Task.Progress Then
- TimeoutCounter = 0
- ElseIf TimeoutCounter < 30 * 2 Then
- TimeoutCounter += 1
- Else '进度停滞超过 30s
- Select Case PeerCount
- Case -1 'CLI 无返回
- Panic("无法启动联机模块", "近期日志:" & vbCrLf & LogHistory.Join(vbCrLf))
- Case 0 'CLI 有返回,但未连接到任何节点
- Panic("无法连接到节点", $"请检查你的网络环境是否良好。")
- Case Else '已连接到节点,但未连接到房主
- Panic("无法连接到房主", $"可能的原因:{vbCrLf}- 你或者房主的网络环境不佳{vbCrLf}- 房主已关闭房间{vbCrLf}- 邀请码输错了")
- End Select
- End If
- Loop Until Task.IsCanceled
- If Task.IsCanceled Then Throw New OperationCanceledException
- '等待连接稳定,最多 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.IsCanceled Then Throw New OperationCanceledException
- Thread.Sleep(100)
- Next
- End Sub
- ''' <summary>
- ''' 从在线配置和 API 获取需要连接的节点列表,并更新发现节点 ID。
- ''' 根据发现节点 ID,会有以下行为变化:
- ''' -1:作为房主,根据负载均衡选择一个发现节点。
- ''' 0:作为加入者,但邀请码未提供发现节点 ID,使用回退发现节点。
- ''' >0:作为加入者,根据 ID 选择对应的发现节点;如果没有,使用回退发现节点。
- ''' </summary>
- 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 RawNodes As JObject
- Dim IsFallbackRawList As Boolean = False
- Try
- RawNodes = NetRequestByClient("https://uptime.easytier.cn/api/nodes?page=1&per_page=1000", RequireJson:=True).DeserializeJson()
- Catch exx As Exception
- Logger.Warn(exx, "从源站获取节点列表失败,将使用 CDN 缓存")
- RawNodes = NetRequestByClientRetry("https://easytier.meloong.com/?page=1&per_page=1000", RequireJson:=True).DeserializeJson()
- 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")
- '状态检查
- 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("国内") 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
- '排序
- 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
- Logger.Warn($"未找到 ID {DiscoverNodeID} 的发现节点")
- Panic("房间已过期", "请让房主重新创建房间!")
- Throw New OperationCanceledException
- End If
- End If
- If SelectedDiscoverNode Is Nothing Then '使用回退发现节点
- SelectedDiscoverNode = New JObject From {{"address", FallbackDiscoverAddress}, {"id", FallbackDiscoverID}}
- Logger.Warn("将使用回退发现节点")
- End If
- FinalPeers.Add(SelectedDiscoverNode("address").ToString())
- FinalDiscoverID = SelectedDiscoverNode("id").ToObject(Of Integer)
- Logger.Info($"发现节点:{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 Exception
- ex.ThrowIfCanceled()
- Logger.Error(ex, "获取节点列表失败,联机质量可能受到影响", LogBehavior.Toast)
- FinalPeers.AddRange(ServerConfig("Link")("Peers").Select(Function(p) p.ToString))
- If FinalDiscoverID <= 0 Then
- FinalPeers.Add(FallbackDiscoverAddress)
- FinalDiscoverID = FallbackDiscoverID
- End If
- End Try
- '版本 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
- #Region "进程与日志"
- ''' <summary>
- ''' EasyTier Core 进程。
- ''' </summary>
- Private Shared ProcessCore As Process
- Private Shared ProcessOutputHandle As AutoResetEvent, ProcessErrorHandle As AutoResetEvent
- ''' <summary>
- ''' 若程序正在运行,则结束程序进程。
- ''' 即使失败也不会抛出异常。
- ''' </summary>
- Public Shared Sub ProcessStop()
- Try
- '关闭未捕获的进程
- For Each ProcessObject In Process.GetProcesses
- If ProcessObject.Id = ProcessCore?.Id Then Continue For
- If ProcessObject.ProcessName <> "联机模块" AndAlso ProcessObject.ProcessName <> "联机模块 CLI" Then Continue For
- Try
- Logger.Info($"停止残留的联机模块,PID:{ProcessObject.Id},进程名:{ProcessObject.ProcessName}")
- ProcessObject.Kill()
- ProcessObject.Close()
- Catch exx As Exception
- Logger.Warn(exx, $"结束进程失败({ProcessObject.ProcessName},PID {ProcessObject.Id})")
- End Try
- Next
- '关闭由自身启动的进程
- If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then
- Logger.Info($"停止所启动的联机模块,PID:{ProcessCore.Id}")
- ProcessCore.Kill()
- ProcessCore.Close()
- ProcessCore = Nothing
- End If
- '释放资源
- ProcessOutputHandle?.Dispose()
- ProcessErrorHandle?.Dispose()
- Catch ex As Exception
- Logger.Warn(ex, "停止联机模块失败")
- End Try
- End Sub
- ''' <summary>
- ''' 出现意外错误,给出错误信息并结束联机。
- ''' </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))
- Else
- MyMsgBox(Detail, "联机出错:" & Brief, IsWarn:=True)
- ChangeState(LinkStates.Waiting)
- Telemetry("联机失败", "Exception", FilterUserName(Brief & ":" & Detail, "*"))
- End If
- End Sub
- ''' <summary>
- ''' 启动进程。
- ''' </summary>
- Private Sub ProcessStart(Arguments As String)
- Dim Info = New ProcessStartInfo With {
- .FileName = PathEasyTier & "联机模块.exe",
- .Arguments = Arguments,
- .UseShellExecute = False,
- .CreateNoWindow = True,
- .RedirectStandardError = True,
- .RedirectStandardOutput = True,
- .StandardOutputEncoding = Encoding.UTF8,
- .StandardErrorEncoding = Encoding.UTF8
- }
- Logger.Info($"正在启动 EasyTier:{Arguments}")
- ProcessCore = New Process With {.StartInfo = Info}
- Dim LogLineHandler =
- Sub(sender As Object, e As DataReceivedEventArgs, Handle As AutoResetEvent)
- Try
- If e.Data Is Nothing Then
- Handle.[Set]()
- Return
- End If
- ProcessLogLine(e.Data)
- Catch unused As ObjectDisposedException
- Catch ex As Exception
- Logger.Warn(ex, "读取 EasyTier 信息失败")
- End Try
- End Sub
- ProcessOutputHandle = New AutoResetEvent(False)
- AddHandler ProcessCore.OutputDataReceived, Sub(sender, e) LogLineHandler(sender, e, ProcessOutputHandle)
- ProcessErrorHandle = New AutoResetEvent(False)
- AddHandler ProcessCore.ErrorDataReceived, Sub(sender, e) LogLineHandler(sender, e, ProcessErrorHandle)
- ProcessCore.Start()
- ProcessCore.BeginOutputReadLine()
- ProcessCore.BeginErrorReadLine()
- End Sub
- Private Sub ProcessLogLine(Line As String)
- '记录日志
- Logger.Info(Line)
- LogHistory.Enqueue(Line)
- If LogHistory.Count >= 10 Then LogHistory.Dequeue()
- '检查日志内容
- If Line.ContainsIgnoreCase("new peer connection added") Then
- Logger.Warn($"已建立连接:{If(Line.RegexSeek("(?<=remote_addr.+?"")[^""}]{3,}"), Line)}")
- Update()
- ElseIf Line.ContainsIgnoreCase("peer connection removed") Then
- Logger.Warn($"已断开连接:{If(Line.RegexSeek("(?<=remote_addr.+?"")[^""}]{3,}"), Line)}")
- Update()
- End If
- End Sub
- Private LogHistory As New Queue(Of String)(10)
- #End Region
- #Region "CLI 节点信息获取"
- Private Class Peer
- ''' <summary>
- ''' 该节点的类型。
- ''' </summary>
- Public ReadOnly Type As Types
- Public Enum Types
- ''' <summary>
- ''' 客户端。
- ''' </summary>
- Client
- ''' <summary>
- ''' 服务器。
- ''' </summary>
- Server
- ''' <summary>
- ''' 公共节点。
- ''' </summary>
- Misc
- ''' <summary>
- ''' 自己,或者自己的重复(它可能返回多个自己)。
- ''' </summary>
- Self
- End Enum
- ''' <summary>
- ''' 与该节点的延迟 (ms)。
- ''' 若是自己则为 0。
- ''' </summary>
- Public ReadOnly Ping As Double
- ''' <summary>
- ''' 名称。
- ''' </summary>
- Public ReadOnly Name As String
- ''' <summary>
- ''' 是否通过中继连接。
- ''' </summary>
- Public ReadOnly Relay As Boolean
- ''' <summary>
- ''' NAT 类型。
- ''' </summary>
- Public ReadOnly NATType As NATTypes
- ''' <summary>
- ''' 从 CLI 给出的信息分析对应的数据。
- ''' </summary>
- Public Sub New(Info As JObject)
- '类别
- Dim PeerName = Info("hostname").ToString
- If Info("cost").ToString = "Local" Then
- Type = Types.Self
- ElseIf PeerName.StartsWithF("Client") Then
- Type = Types.Client
- ElseIf Info("ipv4") = "10.114.114.114" Then '只允许这个 IP 作为房主,避免网络被多个房主搞炸的情况
- Type = Types.Server
- Else
- Type = Types.Misc
- End If
- '基础信息
- Double.TryParse(Info("lat_ms"), NumberStyles.Any, CultureInfo.InvariantCulture, Ping)
- Name = PeerName
- Relay = Info("cost").ToString.ContainsIgnoreCase("relay")
- NATType = EnumUtils.FromString(Of NATTypes)(Info("nat_type"))
- End Sub
- Public Overrides Function ToString() As String
- 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 获取已连接节点信息。
- ''' 这会过滤掉尚未完成连接的其他节点以及自己。
- ''' 若在加载完成后连续获取失败 3 次,则会强制断开连接。
- ''' </summary>
- Private RefreshPeerLoader As New LoaderTask(Of Integer, List(Of Peer))("EasyTier CLI", AddressOf RefreshPeer)
- Private Sub RefreshPeer()
- 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 Logger.Info($"CLI 输出抽样:{vbCrLf}{CliResult}")
- Dim NewPeers As New List(Of Peer)
- For Each Line As JObject In CType(CliResult.DeserializeJson(), JArray)
- Try
- Dim Peer = New Peer(Line)
- If Peer.Type = Peer.Types.Self Then
- NATType = Peer.NATType '记录自己的 NAT
- Else
- NewPeers.Add(Peer)
- End If
- Catch exx As Exception
- Logger.Warn(exx, $"错误的信息({Line})")
- End Try
- Next
- '完成
- Peers = NewPeers
- FailCount = 0
- Catch ex As Exception
- Logger.Warn(ex, "获取节点信息失败")
- If LinkState = LinkStates.Finished Then
- FailCount += 1
- If FailCount >= 4 Then Panic("获取节点信息失败", ex.Message)
- End If
- End Try
- End Sub
- ''' <summary>
- ''' CLI 调用连续失败的次数。
- ''' </summary>
- Private FailCount As Integer = 0
- ''' <summary>
- ''' 根据当前的节点列表获取 Ping 值。
- ''' 服务端会返回所有节点中最低的 Ping,客户端会返回服务端的 Ping。
- ''' 0 代表尚不可用。
- ''' </summary>
- Private Function GetPeerPing() As Double
- Dim Peer = GetTargetPeer()
- If Peer Is Nothing Then Return 0
- Return Peer.Ping
- End Function
- ''' <summary>
- ''' 服务端会返回所有节点中 Ping 大于 0 最低的那一个,客户端会返回服务端。
- ''' 若没有则为 Nothing。
- ''' </summary>
- Private Function GetTargetPeer() As Peer
- If Peers Is Nothing Then Return Nothing
- Dim Targets As IEnumerable(Of Peer)
- If IsServerSide Then
- Targets = Peers.Where(Function(p) p.Ping > 0)
- Else
- Targets = Peers.Where(Function(p) p.Type = Peer.Types.Server AndAlso p.Ping > 0)
- End If
- If Not Targets.Any Then Return Nothing
- '返回 Ping 且最低的那个
- Dim MinPing = Targets.Min(Function(p) p.Ping)
- Return Targets.First(Function(p) p.Ping = MinPing)
- End Function
- ''' <summary>
- ''' 获取当前房间中的人数,包括自己。
- ''' 0 代表不可用。
- ''' </summary>
- Private ReadOnly Property PeopleCount As Integer
- Get
- If Peers Is Nothing Then Return 0
- Return Peers.Where(Function(p) p.Type <> Peer.Types.Misc).Count() + 1 '加上自己
- End Get
- End Property
- #End Region
- #Region "定时任务"
- '启动
- Private Sub StartTimerThread() Handles Me.Loaded
- Static IsTimerStarted As Boolean = False
- If IsTimerStarted Then Return
- RunInNewThread(
- Sub()
- Dim Counter As Integer = 0
- Do While True
- Try
- Thread.Sleep(200)
- Counter += 200
- '每秒执行一次
- If Counter >= 1000 Then
- Counter = 0
- Update()
- End If
- '每 200ms 更新进度条
- If LinkState = LinkStates.Loading Then RunInUi(AddressOf UpdateProgressBar)
- Catch ex As Exception
- Logger.Error(ex, "联机模块主时钟出错")
- Thread.Sleep(10000)
- End Try
- Loop
- End Sub, "Link Timer")
- End Sub
- '每秒或进入页面时触发
- 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
- '更新 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 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(Ping >= 10, $"{Ping:0} ms", $"{Ping:0.0} ms")
- End If
- '人数显示
- 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(Settings.Get(Of String)("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
- '检查核心状态
- CheckCrash()
- '检查节点状态
- If Not Peers.Any Then
- Panic("网络连接已断开", "请检查你的网络环境是否正常。")
- Return
- End If
- If Not IsServerSide AndAlso Not Peers.Any(Function(p) p.Type = Peer.Types.Server) Then
- MyMsgBox("房主已离开房间!", "联机结束")
- ChangeState(LinkStates.Waiting)
- Return
- End If
- '广播联机房间端口
- 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,
- New IPEndPoint(IPAddress.Loopback, 4445))
- Catch ex As Exception
- Logger.Warn(ex, "广播联机房间端口失败")
- End Try
- End If
- End Sub
- ''' <summary>
- ''' 检查联机模块是否崩溃。
- ''' </summary>
- Private Sub CheckCrash()
- If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then Return
- Panic("联机模块已崩溃", "近期日志:" & vbCrLf & LogHistory.Join(vbCrLf))
- End Sub
- #End Region
- End Class
|