由于联机已被禁用，公开联机部分代码

.gitignore

@@ -349,9 +349,6 @@ ModSetup.vb
 PageOtherAbout.*
 PageOtherTest.*
 PageSetupUI.*
-# 公开联机代码可能导致安全风险
-Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb
-Plain Craft Launcher 2/Pages/PageLink/PageLinkHiPer.xaml.vb
 # 开发者工具
 ModDevelop.vb
 # 不公开底层函数库，以免抄袭

Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb

@@ -0,0 +1,952 @@
+Public Class PageLinkHiper
+    Public Const RequestVersion As Char = "2"
+
+    '记录的启动情况
+    Public Shared IsServerSide As Boolean
+    Private Shared HostIp As String
+    Private Shared HostPort As Integer
+
+#Region "初始化"
+
+    '加载器初始化
+    Private Sub LoaderInit() Handles Me.Initialized
+        PageLoaderInit(Load, PanLoad, PanContent, PanAlways, InitLoader, AutoRun:=False)
+        '注册自定义的 OnStateChanged
+        AddHandler InitLoader.OnStateChangedUi, AddressOf OnLoadStateChanged
+    End Sub
+
+    Private IsLoad As Boolean = False
+    Private Sub OnLoaded() Handles Me.Loaded
+        If IsLoad Then Exit Sub
+        IsLoad = True
+        '启动监视线程
+        If Not IsWatcherStarted Then RunInNewThread(AddressOf WatcherThread, "Hiper Watcher")
+        '读取索引码
+        Try
+            Dim Time As String = Setup.Get("LinkHiperCertTime")
+            If Time = "" Then
+                Log("[HiPer] 没有缓存凭证")
+            ElseIf Date.Parse(Time) > Date.Now Then
+                TextCert.Text = Setup.Get("LinkHiperCertLast")
+                Log("[HiPer] 缓存凭证尚未过期：" & Time)
+                CurrentSubpage = Subpages.PanSelect
+            Else
+                Log("[HiPer] 缓存凭证已过期：" & Time)
+                LabCertTitle.Text = "输入索引码"
+                LabCertDesc.Text = "你的 HiPer 索引码已经过期，请输入新的索引码。" & vbCrLf & "如果实在没有索引码，可以在左侧选择 IOI 方式联机。"
+            End If
+        Catch ex As Exception
+            Log(ex, "读取缓存凭证失败")
+            Setup.Set("LinkHiperCertTime", "")
+        End Try
+    End Sub
+
+#End Region
+
+#Region "加载步骤"
+
+    Public Shared PathHiper As String = PathAppdata & "联机模块\"
+    Public Shared WithEvents InitLoader As New LoaderCombo(Of Integer)("HiPer 初始化", {
+        New LoaderTask(Of Integer, Integer)("网络环境：连通检测", AddressOf InitPingCheck) With {.Block = False, .ProgressWeight = 0.5},
+        New LoaderTask(Of Integer, Integer)("网络环境：IP 检测", AddressOf InitIpCheck) With {.Block = False, .ProgressWeight = 1},
+        New LoaderTask(Of Integer, Integer)("检查网络环境", AddressOf InitCheck) With {.ProgressWeight = 0.5},
+        New LoaderTask(Of Integer, List(Of NetFile))("获取所需文件", AddressOf InitGetFile) With {.ProgressWeight = 4},
+        New LoaderDownload("下载所需文件", New List(Of NetFile)) With {.ProgressWeight = 4},
+        New LoaderTask(Of Integer, Integer)("启动联机模块", AddressOf InitLaunch) With {.ProgressWeight = 7}
+    })
+
+    '检查网络状态
+    Private Shared Sub InitPingCheck(Task As LoaderTask(Of Integer, Integer))
+        PingTime = 0
+        Try
+            Log("[HiPer] 网络检测：连通检测开始")
+            Dim StartTime = Date.Now.Ticks
+            Dim Result As String = NetGetCodeByClient("https://www.baidu.com/duty/", Encoding.UTF8, 20000, "")
+            Dim DuringTime As Integer = (Date.Now.Ticks - StartTime) / 10000
+            If Result.Contains("百度") Then
+                Log("[HiPer] 网络检测：连通检测成功（" & DuringTime & "ms）")
+                PingTime = DuringTime
+            Else
+                Log("[HiPer] 网络检测：连通检测失败（获取的内容有误）")
+                PingTime = -1
+            End If
+        Catch ex As ThreadInterruptedException
+        Catch ex As Exception
+            Log(ex, "连通检测失败")
+            PingTime = -1
+        End Try
+    End Sub
+    Private Shared Sub InitIpCheck()
+        IpCheckStatus = LoadState.Loading
+        Try
+            Log("[HiPer] 网络检测：IP 地址检测开始")
+            Dim IpCheckResult As String = NetRequestOnce("https://ipinfo.io/json", "GET", "", "application/json", 10000)
+            Dim Country As String = GetJson(IpCheckResult)("country")
+            IpIsInChina = Country = "CN"
+            IpCheckStatus = LoadState.Finished
+            Log("[HiPer] 网络检测：IP 地址检测结果：" & Country)
+        Catch ex As ThreadInterruptedException
+            IpCheckStatus = LoadState.Aborted
+        Catch ex As Exception
+            Log(ex, "IP 地址检测失败")
+            IpCheckStatus = LoadState.Failed
+            IpIsInChina = True
+        End Try
+    End Sub
+    Private Shared PingTime As Integer, IpCheckStatus As LoadState = LoadState.Loading, IpIsInChina As Boolean
+    Private Shared Sub InitCheck(Task As LoaderTask(Of Integer, Integer))
+        '检查协议
+        If Not Setup.Get("LinkEula") Then
+Reopen:
+            Select Case MyMsgBox("PCL2 的联机服务由速聚授权提供。" & vbCrLf & "在使用前，你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
+                Case 1
+                    Setup.Set("LinkEula", True)
+                Case 2
+                    Throw New Exception("$你拒绝了用户服务协议……")
+                Case 3
+                    OpenWebsite("https://mp.weixin.qq.com/mp/appmsgalbum?__biz=MzkxMTMyODk3Mg==&action=getalbum&album_id=2585385685407514625&scene=173&from_msgid=2247483720&from_itemidx=1&count=3&nolastread=1#wechat_redirect")
+                    GoTo Reopen
+            End Select
+        End If
+        '等待网络环境检查加载器结束
+        SetLoadDesc("正在检查网络环境……", "检查网络环境")
+        Do While Task.State = LoadState.Loading AndAlso Not (PingTime <> 0 AndAlso IpCheckStatus <> LoadState.Loading)
+            Thread.Sleep(50)
+        Loop
+        '获取网络环境检查结果
+        If IpCheckStatus = LoadState.Finished AndAlso Not IpIsInChina Then
+            If MyMsgBox("检测到你的 IP 不在中国，这会导致联机变得非常不稳定。" & vbCrLf &
+                        "如果你正开着加速器或者 VPN，请先关闭它们，然后再继续……", "警告", "继续", "取消", IsWarn:=True, ForceWait:=True) = 2 Then
+                Throw New Exception("$请在关闭加速器或者 VPN 后点击重试。")
+            End If
+            Task.Progress = 0.5
+            InitIpCheck() '重新进行检查
+        End If
+        '没有联网
+        If IpCheckStatus = LoadState.Failed AndAlso PingTime = -1 Then
+            Throw New Exception("$PCL2 没法连上网……" & vbCrLf & "如果你改变了网络环境，请重启 PCL2。")
+        End If
+    End Sub
+
+    '获取所需文件
+    Private Shared Sub InitGetFile(Task As LoaderTask(Of Integer, List(Of NetFile)))
+        '初始化
+        SetLoadDesc("正在初始化……", "初始化")
+        Directory.CreateDirectory(PathHiper)
+        WriteFile(PathHiper & "HiPer 联机模块.vbs", "createobject(""wscript.shell"").run """"""" & PathHiper & "HiPer 联机模块.exe"""" v"", 0", Encoding:=Encoding.GetEncoding("GB18030")) '准备启动脚本
+        '获取索引码文件
+        SetLoadDesc("正在获取索引码文件……", "获取索引码文件")
+        Dim Cert As String = RunInUiWait(Function() FrmLinkHiper.TextCert.Text)
+        Log("[Hiper] 联机索引码：" & Cert)
+        If Cert = Setup.Get("LinkHiperCertLast") AndAlso File.Exists(PathHiper & "cert.yml") Then
+            Log("[Hiper] 索引码与上次输入的一致，跳过获取步骤")
+        Else
+            Dim CertRaw As String
+            Try
+                CertRaw = NetRequestOnce("https://cert.mcer.cn/" & Cert & ".yml", "GET", "", "")
+            Catch ex As Exception
+                If GetString(ex).Contains("(404)") Then
+                    Throw New CertOutdatedException '索引码无效或已过期
+                ElseIf GetString(ex).Contains("too many requests") Then
+                    Throw New Exception("你的尝试太频繁了，请暂时啥都别点，等两分钟后再试……")
+                Else
+                    Throw
+                End If
+            End Try
+            If Not CertRaw.Contains("WARNING <<< AUTO SYNC AREA") Then Throw New Exception("获取到的索引码文件内容有误！")
+            WriteFile(PathHiper & "cert.yml", CertRaw)
+            Setup.Set("LinkHiperCertLast", Cert)
+            Setup.Set("LinkHiperCertTime", "")
+        End If
+        Task.Progress = 0.25
+        '获取 CPU 架构
+        SetLoadDesc("正在获取 CPU 架构……", "获取 CPU 架构")
+        Dim Architecture As String
+        Select Case GetType(String).Assembly.GetName().ProcessorArchitecture
+            Case Reflection.ProcessorArchitecture.X86
+                Architecture = "386"
+            Case Reflection.ProcessorArchitecture.Amd64
+                Architecture = "amd64"
+            Case Reflection.ProcessorArchitecture.Arm
+                Architecture = "arm64"
+            Case Else
+                Architecture = "arm64"
+                Log("[Hiper] 当前 CPU 架构为 " & GetStringFromEnum(GetType(String).Assembly.GetName().ProcessorArchitecture) & "，没有最适合的项，这可能会导致联机模块无法启动！", LogLevel.Debug)
+        End Select
+        Log("[Hiper] CPU 架构：" & Architecture)
+        '检查更新：hiper.exe
+        SetLoadDesc("正在检查联机模块本体更新……", "检查联机模块本体更新")
+        Dim RequiredFiles As New List(Of NetFile)
+        Dim Checksums As String = Nothing, ChecksumHiper As String = Nothing
+        If File.Exists(PathHiper & "HiPer 联机模块.exe") Then
+            Try
+                Checksums = NetGetCodeByDownload({
+                    "http://mirror.hiper.cn.s2.the.bb/packages.sha1",
+                    "http://mirror.hiper.cn.s3.the.bb:175/packages.sha1",
+                    "https://gitcode.net/to/hiper/-/raw/master/packages.sha1",
+                    "https://cert.mcer.cn/mirror/packages.sha1"
+                })
+            Catch ex As Exception
+                Log(ex, "获取联机模块更新信息失败，将会强制启动联机模块", LogLevel.Hint)
+                GoTo FinishHiperFileCheck
+            End Try
+            ChecksumHiper = RegexSeek(Checksums, "[0-9a-f]{40}(?=  windows-" & Architecture & "/hiper.exe)")
+            If ChecksumHiper Is Nothing Then
+                Log("[Hiper] 未找到联机模块更新信息，将会强制启动联机模块", LogLevel.Hint)
+                GoTo FinishHiperFileCheck
+            End If
+            Log("[Hiper] hiper.exe 的所需 SHA1：" & ChecksumHiper)
+            If ChecksumHiper = GetAuthSHA1(PathHiper & "HiPer 联机模块.exe") Then
+                Log("[Hiper] hiper.exe 文件校验通过，无需重新下载")
+                GoTo FinishHiperFileCheck
+            End If
+        End If
+        Log("[Hiper] 需要重新下载 hiper.exe")
+        RequiredFiles.Add(New NetFile({"http://mirror.hiper.cn.s2.the.bb/windows-" & Architecture & "/hiper.exe",
+                                       "http://mirror.hiper.cn.s3.the.bb:175/windows-" & Architecture & "/hiper.exe",
+                                       "https://gitcode.net/to/hiper/-/raw/master/windows-" & Architecture & "/hiper.exe?inline=false",
+                                       "https://cert.mcer.cn/mirror/windows-" & Architecture & "/hiper.exe"},
+                                      PathHiper & "HiPer 联机模块.exe",
+                                      New FileChecker(Hash:=ChecksumHiper, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing，所以 Checksum 可以为 Nothing
+FinishHiperFileCheck:
+        Task.Progress = 0.5
+        '检查更新：wintun.dll
+        Dim ChecksumWintun As String = Nothing
+        If File.Exists(PathHiper & "wintun.dll") Then
+            Try
+                If Checksums Is Nothing Then
+                    Checksums = NetGetCodeByDownload({
+                        "http://mirror.hiper.cn.s2.the.bb/packages.sha1",
+                        "http://mirror.hiper.cn.s3.the.bb:175/packages.sha1",
+                        "https://gitcode.net/to/hiper/-/raw/master/packages.sha1",
+                        "https://cert.mcer.cn/mirror/packages.sha1"
+                    })
+                End If
+            Catch ex As Exception
+                Log(ex, "获取联机模块更新信息失败，将会强制启动联机模块", LogLevel.Hint)
+                GoTo FinishWintunFileCheck
+            End Try
+            ChecksumWintun = RegexSeek(Checksums, "[0-9a-f]{40}(?=  windows-" & Architecture & "/wintun.dll)")
+            If ChecksumWintun Is Nothing Then
+                Log("[Hiper] 未找到联机模块更新信息，将会强制启动联机模块", LogLevel.Hint)
+                GoTo FinishWintunFileCheck
+            End If
+            Log("[Hiper] wintun.dll 的所需 SHA1：" & ChecksumWintun)
+            If ChecksumWintun = GetAuthSHA1(PathHiper & "wintun.dll") Then
+                Log("[Hiper] wintun.dll 文件校验通过，无需重新下载")
+                GoTo FinishWintunFileCheck
+            End If
+        End If
+        Log("[Hiper] 需要重新下载 wintun.dll")
+        RequiredFiles.Add(New NetFile({"http://mirror.hiper.cn.s2.the.bb/windows-" & Architecture & "/wintun.dll",
+                                       "http://mirror.hiper.cn.s3.the.bb:175/windows-" & Architecture & "/wintun.dll",
+                                       "https://gitcode.net/to/hiper/-/raw/master/windows-" & Architecture & "/wintun.dll?inline=false",
+                                       "https://cert.mcer.cn/mirror/windows-" & Architecture & "/wintun.dll"},
+                                      PathHiper & "wintun.dll",
+                                      New FileChecker(Hash:=ChecksumWintun, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing，所以 Checksum 可以为 Nothing
+FinishWintunFileCheck:
+        Task.Progress = 0.75
+        '检查更新：MCB
+        If Not IsServerSide Then
+            SetLoadDesc("正在检查联机模块组件更新……", "检查联机模块组件更新")
+            Dim ChecksumMcb As String = Nothing
+            If File.Exists(PathHiper & "MCB 联机模块.exe") Then
+                Try
+                    Checksums = NetGetCodeByDownload({
+                        "http://mirror.hiper.cn.s2.the.bb/utils/minecraft-broadcast/packages.sha1",
+                        "http://mirror.hiper.cn.s3.the.bb:175/utils/minecraft-broadcast/packages.sha1",
+                        "https://gitcode.net/to/hiper/-/raw/master/utils/minecraft-broadcast/packages.sha1",
+                        "https://cert.mcer.cn/mirror/utils/minecraft-broadcast/packages.sha1"
+                    })
+                Catch ex As Exception
+                    Log(ex, "获取联机模块组件更新信息失败，将会强制启动联机模块组件", LogLevel.Hint)
+                    GoTo FinishMcbFileCheck
+                End Try
+                ChecksumMcb = RegexSeek(Checksums, "[0-9a-f]{40}(?=  mcb-windows-" & Architecture & ".exe)")
+                If ChecksumMcb Is Nothing Then
+                    Log("[Hiper] 未找到联机模块组件更新信息，将会强制启动联机模块组件", LogLevel.Hint)
+                    GoTo FinishMcbFileCheck
+                End If
+                Log("[Hiper] mcb.exe 的所需 SHA1：" & ChecksumMcb)
+                If ChecksumMcb = GetAuthSHA1(PathHiper & "MCB 联机模块.exe") Then
+                    Log("[Hiper] mcb.exe 文件校验通过，无需重新下载")
+                    GoTo FinishMcbFileCheck
+                End If
+            End If
+            Log("[Hiper] 需要重新下载 mcb.exe")
+            RequiredFiles.Add(New NetFile({
+                                       "http://mirror.hiper.cn.s2.the.bb/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe",
+                                       "http://mirror.hiper.cn.s3.the.bb:175/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe",
+                                       "https://gitcode.net/to/hiper/-/raw/master/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe?inline=false",
+                                       "https://cert.mcer.cn/mirror/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe"},
+                                      PathHiper & "MCB 联机模块.exe",
+                                      New FileChecker(Hash:=ChecksumMcb, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing，所以 Checksum 可以为 Nothing
+FinishMcbFileCheck:
+        End If
+        '添加 point.yml
+        RequiredFiles.Add(New NetFile({"https://cert.mcer.cn/point.yml"}, PathHiper & "point.yml", New FileChecker(MinSize:=200)))
+        '开始下载
+        SetLoadDesc("正在下载联机模块……", "下载联机模块")
+        Task.Output = RequiredFiles
+    End Sub
+    Public Class CertOutdatedException
+        Inherits Exception
+    End Class
+    '启动联机模块
+    Private Shared Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
+        '关闭运行中的 HiPer，然后再刷新凭证文件
+        SetLoadDesc("正在关闭运行中的联机模块……", "关闭运行中的联机模块")
+        HiperStop(True)
+        '准备凭证文件
+        SetLoadDesc("正在准备索引码文件……", "准备索引码文件")
+        Dim CertFile As String = ReadFile(PathHiper & "cert.yml")
+        '添加防火墙配置
+        If IsServerSide Then
+            CertFile += ("\n\ninbound:\n  port: " & HostPort & "\n  proto: tcp\n  host: any").Replace("\n", vbCrLf)
+        Else
+            CertFile += ("\n\noutbound:\n  port: " & HostPort & "\n  proto: tcp\n  host: " & HostIp).Replace("\n", vbCrLf)
+        End If
+        CertFile += "\nlogging:\n  format: json".Replace("\n", vbCrLf)
+        '更新 point.yml 段
+        Const SyncAreaRegex As String = "(?<=#[ ]*WARNING >>> AUTO SYNC AREA)[\s\S]+?(?=#[ ]*WARNING <<< AUTO SYNC AREA)"
+        CertFile = CertFile.Replace(RegexSeek(CertFile, SyncAreaRegex), RegexSeek(ReadFile(PathHiper & "point.yml"), SyncAreaRegex))
+        WriteFile(PathHiper & "config.yml", CertFile)
+        AllNodes = RegexSearch(CertFile.Replace(vbLf, "cr"), "(?<="")[0-9]+.[0-9]+.[0-9]+.[0-9]+(?=""( )?:( )?cr    - "")").Distinct.
+                   Where(Function(l) Not (l = "6.6.1.1" OrElse l = "6.6.2.2" OrElse l = "6.6.3.3")).ToList
+        If AllNodes.Count < 2 Then Throw New Exception("$索引码文件格式有误，未找到节点 IP！")
+        Task.Progress = 0.05
+        '尝试启动
+        HiperStart(Task) '启动失败会直接抛出异常
+        Task.Progress = 0.2
+        '检查连接情况
+        SetLoadDesc("正在连接到联机节点 (1/2)……" & If(IpIsInChina, "", vbCrLf & "由于网络不在中国，可能要花费很长时间。"), "检查联机节点")
+        If Not IsServerSide AndAlso HostIp = HiperIp Then Throw New Exception("$还搁这自己连自己？！不是吧？！")
+        Dim PingNodeResults As New List(Of Integer)
+        Dim UnpingedNodes As New List(Of String)(AllNodes)
+        Do Until PingNodeResults.Count >= 2 OrElse Task.IsAborted
+            Dim SelectedNode = RandomOne(UnpingedNodes)
+            Dim PingNode = Ping(SelectedNode, 4000)
+            If PingNode = -1 Then
+                Task.Progress += (If(PingNodeResults.Count = 0, 0.58, 0.88) - Task.Progress) * 0.3
+            Else
+                SetLoadDesc("正在连接到联机节点 (2/2)……" & If(IpIsInChina, "", vbCrLf & "由于网络不在中国，可能要花费很长时间。"), "检查联机节点")
+                Task.Progress = 0.6
+                PingNodeResults.Add(PingNode)
+                UnpingedNodes.Remove(SelectedNode)
+            End If
+        Loop
+        PingNodes = PingNodeResults.Min
+        Task.Progress = 0.9
+        '与房主 Ping 一下看看
+        If Not IsServerSide Then
+            SetLoadDesc("正在连接到房主……", "检查房主")
+            HostPing = -1 '实际上不使用本次 Ping 的结果，因为它真的偏大……
+            Do
+                Dim PingHost = Ping(HostIp, 4000, False)
+                If PingHost = -1 Then
+                    Thread.Sleep(500)
+                Else
+                    Exit Do
+                End If
+            Loop Until Task.IsAborted
+            '在等待 2 秒后再次触发 Ping，以刷新显示的 Ping
+            RunInNewThread(Sub()
+                               Thread.Sleep(2000)
+                               TaskPingHost.Start(True, IsForceRestart:=True)
+                           End Sub, "HiPer Delayed Ping")
+        End If
+        '刷新完成页面
+        SetLoadDesc("正在加载完成页面……", "加载完成页面")
+        RunInUiWait(AddressOf FrmLinkHiper.WatcherTimer1)
+    End Sub
+    Private Shared PingNodes As Integer, AllNodes As List(Of String)
+
+#End Region
+
+#Region "进程管理"
+
+    Private Shared _HiperState As LoadState = LoadState.Waiting
+    Public Shared Property HiperState As LoadState
+        Get
+            Return _HiperState
+        End Get
+        Set(value As LoadState)
+            _HiperState = value
+            RunInUi(Sub() If FrmLinkLeft IsNot Nothing Then CType(FrmLinkLeft.ItemHiper.Buttons(0), MyIconButton).Visibility = If(HiperState = LoadState.Finished OrElse HiperState = LoadState.Loading, Visibility.Visible, Visibility.Collapsed))
+        End Set
+    End Property
+    Public Shared Sub ModuleStopManually() '关闭联机模块按钮
+        HiperExit(False)
+    End Sub
+
+    Private Shared HiperIp As String = Nothing
+    Private Shared HiperProcessId As Integer = -1, McbProcessId As Integer = -1
+    Private Shared HiperCertTime As Date = Date.Now
+
+    ''' <summary>
+    ''' 若程序正在运行，则结束程序进程，同时初始化状态数据。返回是否关闭了相关进程。
+    ''' </summary>
+    Public Shared Function HiperStop(SleepWhenKilled As Boolean) As Boolean
+        HiperStop = False
+        '修改凭证
+        Dim ConfigContent As String = ReadFile(PathHiper & "config.yml")
+        If Not ConfigContent.Contains("enable: false") Then
+            WriteFile(PathHiper & "config.yml", ConfigContent & vbCrLf & "enable: false")
+        End If
+        '关闭所有进程
+        For Each ProcessObject In Process.GetProcesses
+            Dim IsHiper As Boolean = ProcessObject.ProcessName = "HiPer 联机模块"
+            Dim IsMcb As Boolean = ProcessObject.ProcessName = "MCB 联机模块"
+            If Not IsHiper AndAlso Not IsMcb Then Continue For
+            HiperStop = True
+            Try
+                If IsMcb Then
+                    ProcessObject.Kill()
+                    Log("[HiPer] 已结束进程 PID " & ProcessObject.Id & "：" & ProcessObject.ProcessName)
+                    If HiperStop AndAlso SleepWhenKilled Then Thread.Sleep(1000) '等待 1 秒确认进程已退出
+                Else 'IsHiper
+                    If SleepWhenKilled Then
+                        Thread.Sleep(4000) '等待 4 秒确认进程已退出
+                        If Not ProcessObject.HasExited Then
+                            ProcessObject.Kill()
+                            Log("[HiPer] 已结束进程 PID " & ProcessObject.Id & "：" & ProcessObject.ProcessName)
+                        End If
+                    End If
+                End If
+            Catch ex As Exception
+                Log(ex, "结束进程失败（" & ProcessObject.Id & "，" & ProcessObject.ProcessName & "）")
+            End Try
+        Next
+        '初始化
+        HiperState = LoadState.Waiting
+        HiperProcessId = -1 : McbProcessId = -1
+        HiperCertTime = Nothing
+    End Function
+    ''' <summary>
+    ''' 启动程序，并等待初始化完成后退出运行，同时更新 HiperIp。
+    ''' 若启动失败，则会直接抛出异常。
+    ''' 若程序正在运行，则会先停止其运行。
+    ''' </summary>
+    Public Shared Sub HiperStart(Task As LoaderTask(Of Integer, Integer))
+        Try
+            SetLoadDesc("正在启动联机模块……", "启动联机模块")
+            PossibleFailReason = Nothing
+            '启动 Hiper
+            Log("[Hiper] 启动 Hiper 进程")
+            DeleteDirectory(PathHiper & "logs") '清理日志
+            Dim HiperInfo = New ProcessStartInfo With {
+                .FileName = "wscript",
+                .Arguments = """" & PathHiper & "HiPer 联机模块.vbs""",
+                .Verb = "runas" '需要管理员权限
+            }
+            Dim HiperVbsProcess As New Process() With {.StartInfo = HiperInfo}
+            HiperVbsProcess.Start()
+            '查找真正的 Hiper 进程
+            SetLoadDesc("联机模块正在启动……", "联机模块加载")
+            Do
+                Dim GotProcesses = Process.GetProcesses.
+                    Where(Function(l) l.ProcessName = "HiPer 联机模块" AndAlso Math.Abs((l.StartTime - Date.Now).TotalMinutes) < 1)
+                If GotProcesses.Count > 0 Then
+                    HiperProcessId = GotProcesses.First.Id
+                    Log("[Hiper] 已发现 Hiper 进程，PID：" & HiperProcessId)
+                    Exit Do
+                End If
+                Thread.Sleep(50)
+            Loop While Task.State = LoadState.Loading AndAlso Not Task.IsAborted
+            If HiperProcessId = -1 Then Throw New Exception("联机模块未能成功启动！")
+            HiperState = LoadState.Loading
+            Task.Progress = 0.15
+            '抓取日志
+            Dim LogLine As Integer = 0
+            Do
+                Thread.Sleep(100)
+                If Not File.Exists(PathHiper & "logs\hiper.log") Then Continue Do
+                Dim LogLines As String() = ReadFile(PathHiper & "logs\hiper.log").TrimEnd(vbLf).Split(vbLf)
+                For i = LogLine To LogLines.Count - 1
+                    HiperLogLine(LogLines(i), Task)
+                Next
+                LogLine = LogLines.Count
+            Loop While HiperState = LoadState.Loading AndAlso Not Task.IsAborted AndAlso Process.GetProcesses.Any(Function(l) l.Id = HiperProcessId)
+            '输出
+            If HiperState = LoadState.Finished Then
+                Log("[Hiper] Hiper 启动完成")
+            ElseIf PossibleFailReason IsNot Nothing AndAlso PossibleFailReason.Contains("索引码已过期") Then
+                Throw New CertOutdatedException()
+            Else
+                Throw New Exception(If(PossibleFailReason, "联机模块因未知原因启动失败！"))
+            End If
+            '启动 MCB
+            Task.Progress = 0.25
+            If Not IsServerSide Then
+                Try
+                    Log("[Hiper] 启动 MCB 进程")
+                    Dim McbInfo = New ProcessStartInfo With {
+                        .FileName = PathHiper & "MCB 联机模块.exe", .WorkingDirectory = PathHiper,
+                        .UseShellExecute = False, .CreateNoWindow = True,
+                        .RedirectStandardError = True, .RedirectStandardOutput = True,
+                        .Arguments = "-addr " & HostIp & ":" & HostPort & " -motd ""PCL2 联机房间"""
+                    }
+                    Dim McbProcess As New Process() With {.StartInfo = McbInfo}
+                    McbProcess.Start()
+                    McbProcessId = McbProcess.Id
+                Catch ex As Exception
+                    Throw New Exception("联机模块组件启动失败", ex)
+                End Try
+            End If
+        Catch ex As Exception
+            Try
+                HiperStop(True) '由于启动失败停止进程
+            Catch
+            End Try
+            HiperState = LoadState.Failed
+            Throw
+        End Try
+    End Sub
+
+    'Hiper 日志
+    Private Shared Sub HiperLogLine(Content As String, Task As LoaderTask(Of Integer, Integer))
+
+        '检查报错
+        Dim ContentTest As String = Content.ToLower
+        Dim ErrorMessage As String = Nothing
+        Dim ContentJson As JObject = Nothing
+        If Content.StartsWith("{""") AndAlso Content.EndsWith("}") Then
+            ContentJson = GetJson(Content)
+            ContentTest = If(ContentJson("error"), ContentJson("msg")).ToString.ToLower
+            ErrorMessage = ContentJson("error")
+        End If
+        If ContentTest.Contains("hiper certificate for this host is expired") Then
+            PossibleFailReason = "$你的索引码已过期，请更换新的索引码！"
+        ElseIf ContentTest.Contains("error creating interface: access is denied") Then
+            PossibleFailReason = "$没有获得管理员权限，无法创建网络通道！"
+        ElseIf ContentTest.Contains("cannot create a file when that file already exists") Then
+            PossibleFailReason = "$请不要重复开启多个联机模块！"
+        ElseIf Content.Contains("failed to load config") Then
+            PossibleFailReason = "$索引码文件内容存在错误！"
+        ElseIf Content.Contains("system cannot find the file specified") Then
+            PossibleFailReason = "$创建网络通道失败！" & vbCrLf & "如果你曾启动过 VPN 软件，请先打开那个软件，然后关掉它，最后再重试。虽然不知道为啥，但这样大概管用……"
+        End If
+        If PossibleFailReason Is Nothing AndAlso ErrorMessage IsNot Nothing Then PossibleFailReason = ErrorMessage
+
+        '检查结束
+        If ContentJson IsNot Nothing Then
+            Dim Message As String = ContentJson("msg")
+            If Message = "HiPer interface is active" Then
+                HiperIp = ContentJson("network").ToString.Split("/").First
+                If IsServerSide Then HostIp = HiperIp
+                Log("[Hiper] Hiper 启动完成，IP：" & HiperIp)
+                HiperState = LoadState.Finished
+            ElseIf Message = "Validity of client certificate" Then
+                Dim VaildTime As String = ContentJson("valid")
+                Date.TryParseExact(VaildTime, "yyyy-MM-dd HH:mm:ss", Globalization.CultureInfo.InvariantCulture, Globalization.DateTimeStyles.None, HiperCertTime)
+                Log("[Hiper] 索引码到期时间：" & HiperCertTime.ToString)
+                Setup.Set("LinkHiperCertTime", HiperCertTime.ToString)
+            End If
+        End If
+
+        '写入日志
+        If ModeDebug OrElse Content.Contains("""error""") Then Log("[Hiper] " & Content)
+
+    End Sub
+    Private Shared PossibleFailReason As String = Nothing
+
+#End Region
+
+#Region "监视线程"
+
+    '主 Timer 线程
+    Private IsWatcherStarted As Boolean = False
+    Private Sub WatcherThread()
+        Dim Sec15 As Integer = 0
+        Do While True
+            Try
+                For i = 1 To 5
+                    Thread.Sleep(200)
+                    If InitLoader.State = LoadState.Loading Then
+                        RunInUi(AddressOf UpdateProgress)
+                    End If
+                Next
+                Thread.Sleep(1000)
+                Sec15 += 1
+                WatcherTimer1()
+                If Sec15 = 15 Then
+                    Sec15 = 0
+                    WatcherTimer15()
+                End If
+            Catch ex As Exception
+                Log(ex, "联机模块主时钟出错", LogLevel.Feedback)
+                Thread.Sleep(20000)
+            End Try
+        Loop
+    End Sub
+
+    '每 1 秒执行的 Timer
+    Private Sub WatcherTimer1()
+        If HiperState <> LoadState.Finished Then Exit Sub
+        RunInUi(Sub()
+                    '索引码剩余时间
+                    Dim Span As TimeSpan = HiperCertTime - Date.Now
+                    If Span.TotalDays >= 30 Then
+                        LabFinishTime.Text = "> 30 天"
+                    ElseIf Span.TotalDays >= 4 Then
+                        LabFinishTime.Text = Span.Days & " 天"
+                    ElseIf Span.TotalDays >= 1 Then
+                        LabFinishTime.Text = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
+                    ElseIf Span.TotalMinutes >= 10 Then
+                        LabFinishTime.Text = Span.Hours & ":" & Span.Minutes.ToString.PadLeft(2, "0") & "'"
+                    Else
+                        LabFinishTime.Text = Span.Minutes & "'" & Span.Seconds.ToString.PadLeft(2, "0") & """"
+                    End If
+                    '提示索引码即将到期
+                    If Span.TotalSeconds <= 5 * 60 AndAlso Span.TotalSeconds > 5 * 60 - 1 AndAlso Setup.Get("LinkHiperCertWarn") Then
+                        MyMsgBox("你的索引码还有不到 5 分钟就要过期了！" & vbCrLf & "你可以在设置中关闭这个提示……", "索引码即将过期", "我知道了……")
+                        ShowWindowToTop(Handle)
+                        Beep()
+                    End If
+                    '检查索引码到期
+                    If Span.TotalSeconds < 2 Then
+                        LabCertTitle.Text = "索引码已过期"
+                        LabCertDesc.Text = "你的 HiPer 索引码已经过期，请输入新的索引码。" & vbCrLf & "如果实在没有索引码，可以在左侧选择 IOI 方式联机。"
+                        TextCert.Text = ""
+                        HiperExit(True)
+                        ShowWindowToTop(Handle)
+                        Beep()
+                        Exit Sub
+                    End If
+                    '网络质量
+                    Dim QualityScore As Integer = If(IpIsInChina, 0, -2)
+                    QualityScore -= Math.Ceiling((Math.Min(PingTime, 600) + Math.Min(PingNodes, 600)) / 80)
+                    Select Case QualityScore
+                        Case Is >= -1
+                            LabFinishQuality.Text = "优秀"
+                        Case Is >= -2
+                            LabFinishQuality.Text = "优良"
+                        Case Is >= -3
+                            LabFinishQuality.Text = "良好"
+                        Case Is >= -5
+                            LabFinishQuality.Text = "一般"
+                        Case Is >= -7
+                            LabFinishQuality.Text = "较差"
+                        Case Else
+                            LabFinishQuality.Text = "很差"
+                    End Select
+                    'Ping
+                    If HostPing <> -1 Then
+                        If FrmLinkHiper IsNot Nothing AndAlso FrmLinkHiper.LabFinishPing.IsLoaded Then
+                            FrmLinkHiper.LabFinishPing.Text = HostPing & "ms"
+                        End If
+                    End If
+                End Sub)
+    End Sub
+    '每 15 秒执行的 Timer
+    Private Shared HostPing As Integer = -1
+    Private Sub WatcherTimer15()
+        If Not (HiperState = LoadState.Finished OrElse HiperState = LoadState.Loading) Then Exit Sub
+        '检查 HiPer 崩溃
+        Try
+            Process.GetProcessById(HiperProcessId)
+        Catch
+            Dim LogLines = ReadFile(PathHiper & "logs\hiper.log").TrimEnd(vbLf).Split(vbLf)
+            HiperExit(False)
+            MyMsgBox("由于联机模块异常退出，已退出联机房间。" & vbCrLf & vbCrLf &
+                     "联机模块最后的日志：" & vbCrLf & Join(LogLines.Skip(LogLines.Count - 3).ToList, vbCrLf), "联机断开")
+        End Try
+        '下面的部分需要完全完成加载
+        If HiperState <> LoadState.Finished Then Exit Sub
+        '检查 MCB 崩溃
+        Try
+            If Not IsServerSide Then Process.GetProcessById(McbProcessId)
+        Catch
+            HiperExit(False)
+            MyMsgBox("由于 MCB 联机模块异常退出，已退出联机房间。", "联机断开")
+        End Try
+        '重新检查 Ping
+        If Not IsServerSide Then
+            Dim PingHostFailedCount As Integer = 0
+            Do
+                TaskPingHost.WaitForExit(True, IsForceRestart:=True)
+                If TaskPingHost.Output = -1 Then
+                    PingHostFailedCount += 1
+                    Log("[HiPer] Ping 房主失败（第 " & PingHostFailedCount & " 次）")
+                    If PingHostFailedCount >= 3 Then
+                        HiperExit(False) : MyMsgBox("与房主断开连接，已退出联机房间。", "联机断开") : Exit Sub
+                    End If
+                Else
+                    If PingHostFailedCount > 0 Then Log("[HiPer] Ping 房主已恢复成功（" & HostPing & "ms）")
+                    Exit Do
+                End If
+            Loop While True
+        End If
+    End Sub
+
+#End Region
+
+#Region "PanCert | 索引码输入页面"
+
+    '检测输入
+    Private Sub TextCert_ValidateChanged(sender As Object, e As EventArgs) Handles TextCert.ValidateChanged
+        BtnCertDone.IsEnabled = TextCert.ValidateResult = ""
+    End Sub
+    Private Sub TextCert_KeyUp(sender As Object, e As KeyEventArgs) Handles TextCert.KeyUp
+        If e.Key = Key.Enter AndAlso BtnCertDone.IsEnabled Then BtnCertDone_Click() '允许回车确认
+    End Sub
+
+    '确认
+    Private Sub BtnCertDone_Click() Handles BtnCertDone.Click
+        CurrentSubpage = Subpages.PanSelect
+    End Sub
+
+#End Region
+
+#Region "PanSelect | 种类选择页面"
+
+    '返回
+    Private Sub BtnSelectReturn_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectReturn.MouseLeftButtonUp
+        LabCertTitle.Text = "输入索引码"
+        LabCertDesc.Text = "你需要获取索引码才能使用 HiPer。" & vbCrLf & "如果实在没有索引码，可以在左侧选择 IOI 方式联机。"
+        CurrentSubpage = Subpages.PanCert
+    End Sub
+
+    '创建房间
+    Private Sub BtnSelectCreate_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectCreate.MouseLeftButtonUp
+        '获取端口号
+        Dim PortInput As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {
+                                                   New ValidateInteger(2, 65535),
+                                                   New ValidateExceptSame({"55555", "55557"}, "端口不能为 %！")
+                                               }, "在 MC 的暂停画面选择【对局域网开放】", "输入端口号", "确定", "取消")
+        If PortInput Is Nothing Then Exit Sub
+        '开始
+        RoomCreate(Val(PortInput))
+    End Sub
+    Private Sub RoomCreate(Port As Integer)
+        '记录信息
+        HostIp = Nothing : HostPort = Port
+        IsServerSide = True
+        '启动
+        InitLoader.Start(IsForceRestart:=True)
+    End Sub
+
+    '加入房间
+    Private Sub BtnSelectJoin_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectJoin.MouseLeftButtonUp
+        '获取信息
+        Dim Code As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateLength(8, 99)}, "",
+                                           "输入联机码", "确定", "取消")
+        If Code Is Nothing Then Exit Sub
+        '记录信息
+        If Not Code.EndsWith(RequestVersion) OrElse Not Code.StartsWith("P") Then GoTo WrongCode
+        Dim Ip As String, Port As Integer
+        Try
+            Dim IpAndPort As Long = RadixConvert(Code.Substring(1, Code.Length - 2).ToUpper, 36, 10)
+            'IpAndPort = HostPort + IpParts(0) * 65536 + IpParts(1) * 65536 * 256 + IpParts(2) * 65536 * 256 * 256 + IpParts(3) * 65536 * 256 * 256 * 256
+            Ip = Math.Floor(IpAndPort / (65536L * 256 * 256 * 256))
+            IpAndPort = IpAndPort Mod (65536L * 256 * 256 * 256)
+            Ip = Math.Floor(IpAndPort / (65536L * 256 * 256)) & "." & Ip
+            IpAndPort = IpAndPort Mod (65536L * 256 * 256)
+            Ip = Math.Floor(IpAndPort / (65536L * 256)) & "." & Ip
+            IpAndPort = IpAndPort Mod (65536L * 256)
+            Ip = Math.Floor(IpAndPort / (65536L)) & "." & Ip
+            Port = IpAndPort Mod 65536
+        Catch
+            GoTo WrongCode
+        End Try
+        '启动
+        RoomJoin(Ip, Port)
+        Exit Sub
+WrongCode:
+        If Not Code.StartsWith("P") AndAlso Code.Length >= 49 Then Hint("你输入的可能是 IOI 的联机码，请在左侧的联机方式中选择 IOI！", HintType.Critical) : Exit Sub
+        If Code.StartsWith("P") AndAlso Not Code.EndsWith(RequestVersion) Then Hint("你的 PCL2 版本与房主的 PCL2 版本不一致！", HintType.Critical) : Exit Sub
+        Hint("你输入的联机码无效！", HintType.Critical)
+    End Sub
+    Private Sub RoomJoin(Ip As String, Port As Integer)
+        '记录信息
+        HostIp = Ip : HostPort = Port
+        IsServerSide = False
+        '启动
+        InitLoader.Start(IsForceRestart:=True)
+    End Sub
+
+#End Region
+
+#Region "PanLoad | 加载中页面"
+
+    '承接状态切换的 UI 改变
+    Private Sub OnLoadStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
+        Select Case NewState
+            Case LoadState.Loading
+                UpdateProgress(0)
+                If IsServerSide Then
+                    LabLoadTitle.Text = "正在创建联机房间"
+                    Log("[Hiper] 正在创建联机房间，端口 " & HostPort)
+                Else
+                    LabLoadTitle.Text = "正在加入联机房间"
+                    Log("[Hiper] 正在加入联机房间，目标 IP " & HostIp & ":" & HostPort)
+                End If
+                LabLoadDesc.Text = "正在初始化……"
+                LoadStep = "准备初始化"
+            Case LoadState.Failed
+                UpdateProgress(1)
+                If IsServerSide Then
+                    LabLoadTitle.Text = "创建联机房间失败"
+                Else
+                    LabLoadTitle.Text = "加入联机房间失败"
+                End If
+                Dim RealException As Exception = If(Loader.Error.InnerException, Loader.Error)
+                If TypeOf RealException Is CertOutdatedException Then
+                    LabCertTitle.Text = "索引码无效"
+                    LabCertDesc.Text = "你的 HiPer 索引码无效或者已经过期！" & vbCrLf & "请重新输入索引码。"
+                    HiperExit(True)
+                ElseIf RealException.Message.StartsWith("$") Then
+                    LabLoadDesc.Text = RealException.Message.TrimStart("$") & vbCrLf &
+                                       "点击镐子重试，或者点击灰色的 × 取消。"
+                Else
+                    LabLoadDesc.Text = LoadStep & "失败：" & GetString(RealException) & vbCrLf &
+                                       "点击镐子重试，或者点击灰色的 × 取消。"
+                End If
+                Log(Loader.Error, "HiPer 联机尝试失败")
+            Case LoadState.Finished
+                UpdateProgress(1)
+                CurrentSubpage = Subpages.PanFinish
+                BtnFinishPing.Visibility = If(IsServerSide, Visibility.Collapsed, Visibility.Visible)
+                LineFinishPing.Visibility = If(IsServerSide, Visibility.Collapsed, Visibility.Visible)
+                BtnFinishCopy.Visibility = If(IsServerSide, Visibility.Visible, Visibility.Collapsed)
+                If IsServerSide Then
+                    LabFinishTitle.Text = "已创建联机房间"
+                    LabFinishDesc.Text = "已在端口 " & HostPort & " 创建了联机房间。" & vbCrLf & "点击下方的复制联机码按钮，然后把联机码发给朋友吧！"
+                Else
+                    LabFinishTitle.Text = "已加入联机房间"
+                    LabFinishDesc.Text = "启动游戏，进入多人游戏页面后稍等片刻，房间就会出现在服务器列表的最下方。" & vbCrLf & "如果提示无效会话，不要退出联机房间，重新启动游戏即可！"
+                End If
+                LabFinishIp.Text = HostIp & ":" & HostPort
+                Log("[Hiper] 已完成连接")
+        End Select
+    End Sub
+    Private Shared LoadStep As String = "准备初始化"
+    Private Shared Sub SetLoadDesc(Intro As String, [Step] As String)
+        Log("[Hiper] 连接步骤：" & Intro)
+        LoadStep = [Step]
+        RunInUiWait(Sub()
+                        If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.LabLoadDesc.IsLoaded Then Exit Sub
+                        FrmLinkHiper.LabLoadDesc.Text = Intro
+                        FrmLinkHiper.UpdateProgress()
+                    End Sub)
+    End Sub
+
+    '承接重试
+    Private Sub CardLoad_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles CardLoad.MouseLeftButtonUp
+        If Not InitLoader.State = LoadState.Failed Then Exit Sub
+        InitLoader.Start(IsForceRestart:=True)
+    End Sub
+
+    '取消加载
+    Private Sub CancelLoad() Handles BtnLoadCancel.Click
+        If InitLoader.State = LoadState.Loading Then
+            CurrentSubpage = Subpages.PanSelect
+            InitLoader.Abort()
+        Else
+            InitLoader.State = LoadState.Waiting
+        End If
+        HiperStop(False)
+    End Sub
+
+    '进度改变
+    Private Sub UpdateProgress(Optional Value As Double = -1)
+        If Value = -1 Then Value = InitLoader.Progress
+        Dim DisplayingProgress As Double = ColumnProgressA.Width.Value
+        If Math.Round(Value - DisplayingProgress, 3) = 0 Then Exit Sub
+        If DisplayingProgress > Value Then
+            ColumnProgressA.Width = New GridLength(Value, GridUnitType.Star)
+            ColumnProgressB.Width = New GridLength(1 - Value, GridUnitType.Star)
+            AniStop("Hiper Progress")
+        Else
+            Dim NewProgress As Double = If(Value = 1, 1, (Value - DisplayingProgress) * 0.2 + DisplayingProgress)
+            AniStart({
+                AaGridLengthWidth(ColumnProgressA, NewProgress - ColumnProgressA.Width.Value, 300, Ease:=New AniEaseOutFluent),
+                AaGridLengthWidth(ColumnProgressB, (1 - NewProgress) - ColumnProgressB.Width.Value, 300, Ease:=New AniEaseOutFluent)
+            }, "Hiper Progress")
+        End If
+    End Sub
+    Private Sub CardResized() Handles CardLoad.SizeChanged
+        RectProgressClip.Rect = New Rect(0, 0, CardLoad.ActualWidth, 12)
+    End Sub
+
+#End Region
+
+#Region "PanFinish | 加载完成页面"
+
+    '复制 IP
+    Private Sub BtnFinishIp_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishIp.MouseLeftButtonUp
+        ClipboardSet(LabFinishIp.Text)
+    End Sub
+
+    '退出
+    Private Sub BtnFinishExit_Click(sender As Object, e As EventArgs) Handles BtnFinishExit.Click
+        If IsServerSide AndAlso MyMsgBox("你确定要关闭联机房间吗？", "确认退出", "确定", "取消", IsWarn:=True) = 2 Then Exit Sub
+        HiperExit(False)
+    End Sub
+
+    '复制联机码
+    Private Sub BtnFinishCopy_Click(sender As Object, e As EventArgs) Handles BtnFinishCopy.Click
+        Dim IpParts = HostIp.Split(".").Select(Function(l) Val(l)).ToList
+        Dim IpAndPort As Long = HostPort + IpParts(0) * 65536 + IpParts(1) * 65536 * 256 + IpParts(2) * 65536 * 256 * 256 + IpParts(3) * 65536 * 256 * 256 * 256
+        ClipboardSet("P" & RadixConvert(IpAndPort, 10, 36) & RequestVersion, False)
+        Hint("已复制联机码！", HintType.Finish)
+    End Sub
+
+    'Ping 房主
+    Private Sub BtnFinishPing_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishPing.MouseLeftButtonUp
+        LabFinishPing.Text = "检测中"
+        If TaskPingHost.State = LoadState.Loading Then Exit Sub
+        TaskPingHost.Start(True, IsForceRestart:=True)
+    End Sub
+    Private Shared TaskPingHost As New LoaderTask(Of Boolean, Integer)("HiPer Ping Host",
+    Sub(Task As LoaderTask(Of Boolean, Integer))
+        HostPing = -1
+        HostPing = Ping(HostIp, 5000, Task.Input)
+    End Sub)
+
+#End Region
+
+#Region "子页面管理"
+
+    Public Enum Subpages
+        PanCert
+        PanSelect
+        PanFinish
+    End Enum
+    Private _CurrentSubpage As Subpages = Subpages.PanCert
+    Public Property CurrentSubpage As Subpages
+        Get
+            Return _CurrentSubpage
+        End Get
+        Set(value As Subpages)
+            If _CurrentSubpage = value Then Exit Property
+            _CurrentSubpage = value
+            Log("[Hiper] 子页面更改为 " & GetStringFromEnum(value))
+            PageOnContentExit()
+            If value = Subpages.PanSelect Then
+                LabSelectCode.Text = "(" & TextCert.Text.Substring(0, Math.Min(TextCert.Text.Length, 3)) & "…)"
+            End If
+        End Set
+    End Property
+
+    Private Sub PageLinkHiper_OnPageEnter() Handles Me.PageEnter
+        FrmLinkHiper.PanCert.Visibility = If(CurrentSubpage = Subpages.PanCert, Visibility.Visible, Visibility.Collapsed)
+        FrmLinkHiper.PanSelect.Visibility = If(CurrentSubpage = Subpages.PanSelect, Visibility.Visible, Visibility.Collapsed)
+        FrmLinkHiper.PanFinish.Visibility = If(CurrentSubpage = Subpages.PanFinish, Visibility.Visible, Visibility.Collapsed)
+    End Sub
+
+    Private Shared Sub HiperExit(ExitToCertPage As Boolean)
+        Log("[Hiper] 要求退出 Hiper（当前加载器状态为 " & GetStringFromEnum(InitLoader.State) & "）")
+        HiperStop(False)
+        If InitLoader.State = LoadState.Loading Then InitLoader.Abort()
+        If InitLoader.State = LoadState.Failed Then InitLoader.State = LoadState.Waiting
+        RunInUi(Sub()
+                    If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.IsLoaded Then Exit Sub
+                    FrmLinkHiper.CurrentSubpage = If(ExitToCertPage, Subpages.PanCert, Subpages.PanSelect)
+                    FrmLinkHiper.PageOnContentExit()
+                End Sub)
+    End Sub
+
+#End Region
+
+End Class

Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb

@@ -0,0 +1,1262 @@
+Imports System.Net
+Imports System.Net.Sockets
+
+Public Class PageLinkIoi
+    Public Const RequestVersion As Integer = 4
+    Public Const IoiVersion As Integer = 10 '由于已关闭更新渠道，在提升 IoiVersion 时必须提升 RequestVersion
+    Public Shared PathIoi As String = PathAppdata & "联机模块\IOI 联机模块.exe"
+
+#Region "初始化"
+
+    '页面初始化
+    Private IsLoad As Boolean = False
+    Private Sub MeLoaded() Handles Me.Loaded
+
+        '重复加载部分
+        PanBack.ScrollToHome()
+        RefreshUi()
+
+        '非重复加载部分
+        If IsLoad Then Exit Sub
+        IsLoad = True
+
+        '更新线程
+        RunInNewThread(Sub()
+                           Do While True
+                               Thread.Sleep(200)
+                               If FrmMain.PageCurrent.Page = FormMain.PageType.Link AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.LinkIoi Then RunInUiWait(Sub() FrmLinkIoi.RefreshUi())
+                               RefreshWorker()
+                           Loop
+                       End Sub, "Link Timer")
+
+    End Sub
+
+    '加载器初始化与左边栏处理
+    Private Sub LoaderInit() Handles Me.Initialized
+        PageLoaderInit(Load, PanLoad, PanBack, PanAlways, InitLoader, Sub()
+                                                                      End Sub)
+    End Sub
+
+    '初始化加载器与步骤
+    Public Shared WithEvents InitLoader As New LoaderCombo(Of Integer)("联机模块初始化", {
+        New LoaderTask(Of Integer, Integer)("端口检查", AddressOf InitPortCheck) With {.ProgressWeight = 1},
+        New LoaderTask(Of Integer, Integer)("启动请求核心", AddressOf StartSocketListener) With {.ProgressWeight = 1},
+        New LoaderTask(Of Integer, List(Of NetFile))("初次启动尝试", AddressOf InitFirst) With {.ProgressWeight = 4},
+        New LoaderDownload("下载更新文件", New List(Of NetFile)) With {.ProgressWeight = 6},
+        New LoaderTask(Of List(Of NetFile), Boolean)("二次启动尝试", AddressOf InitSecond) With {.ProgressWeight = 3},
+        New LoaderTask(Of Boolean, Boolean)("创建请求核心房间", AddressOf InitRequest) With {.ProgressWeight = 2}
+    })
+    '判断端口是否被占用
+    Private Shared Sub InitPortCheck()
+        '检查协议
+        If Not Setup.Get("LinkEula") Then
+Reopen:
+            Select Case MyMsgBox("PCL2 的联机服务由速聚授权提供。" & vbCrLf & "在使用前，你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
+                Case 1
+                    Setup.Set("LinkEula", True)
+                Case 2
+                    Throw New Exception("你拒绝了用户服务协议……")
+                Case 3
+                    OpenWebsite("https://mp.weixin.qq.com/mp/appmsgalbum?__biz=MzkxMTMyODk3Mg==&action=getalbum&album_id=2585385685407514625&scene=173&from_msgid=2247483720&from_itemidx=1&count=3&nolastread=1#wechat_redirect")
+                    GoTo Reopen
+            End Select
+        End If
+        '先掐死
+        IoiStop(True)
+        '检查端口
+        Dim HasConflict As Boolean = False
+        For Each Port In Net.NetworkInformation.IPGlobalProperties.GetIPGlobalProperties().GetActiveTcpListeners()
+            If Port.Port <> 55555 AndAlso Port.Port <> 55557 Then Continue For
+            Log("[IOI] 发现端口 " & Port.Port & " 被占用")
+            HasConflict = True
+        Next
+        If Not HasConflict Then Exit Sub
+        '对应的报错
+        For Each Line As String In ShellAndGetOutput("netstat", "-ano", 30000).Split({vbCrLf}, StringSplitOptions.RemoveEmptyEntries)
+            If Not (Line.Contains("127.0.0.1:55555") OrElse Line.Contains("127.0.0.1:55557")) Then Continue For
+            Dim ProcessName As String
+            Try
+                ProcessName = Process.GetProcessById(Line.Split(" ").Last).ProcessName
+            Catch ex As Exception
+                Log(ex, "获取占用端口的进程信息失败，假定进程已结束")
+                Continue For
+            End Try
+            If ProcessName = "联机模块" Then
+                Throw New Exception("由于一个已知问题，请在重启电脑后再尝试使用联机功能")
+            ElseIf ProcessName = "Idle" Then
+                '不知道为啥反正又没占用了
+                Log("[IOI] 未发现占用此端口的程序，继续执行")
+            Else
+                Throw New Exception("端口被程序 " & ProcessName & " 占用，无法启动联机模块，请在任务管理器关闭此程序后再试")
+            End If
+        Next
+    End Sub
+    '下载更新前尝试启动
+    Private Shared Sub InitFirst(Task As LoaderTask(Of Integer, List(Of NetFile)))
+        '初次启动尝试
+        If IoiVersion <> Setup.Get("LinkIoiVersion") Then
+            Log("[IOI] 设置版本强制要求联机模块更新")
+            Setup.Set("LinkIoiVersion", IoiVersion)
+        ElseIf File.Exists(PathIoi) Then
+            Task.Progress = 0.2
+            CheckFirewall()
+            If IoiStart() Then
+                '已完成启动与初始化
+                Task.Output = New List(Of NetFile)
+                Exit Sub
+            Else
+                '需要更新
+                IoiStop(True)
+                File.Delete(PathIoi)
+                GoTo StartDownload
+            End If
+            '如果抛出异常则直接使加载器失败
+        End If
+        '开始下载
+StartDownload:
+        Task.Progress = 0.8
+        Log("[IOI] 需要下载联机模块")
+        If File.Exists(PathTemp & "联机模块.zip") Then File.Delete(PathTemp & "联机模块.zip")
+        Task.Output = New List(Of NetFile) From {New NetFile(
+            {"https://gitcode.net/to/cato_bin/-/raw/master/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip",
+             "http://mirror.hiper.cn.s2.the.bb/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip",
+             "http://mirror.hiper.cn.s3.the.bb:175/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip",
+             "https://pcl2-server-1253424809.file.myqcloud.com/link/ioi_v2_x" & If(Is32BitSystem, 32, 64) & ".zip{CDN}"},
+            PathTemp & "联机模块.zip")}
+    End Sub
+    '下载更新后尝试启动
+    Private Shared Sub InitSecond(Task As LoaderTask(Of List(Of NetFile), Boolean))
+        '若首次尝试已经成功，则直接跳过
+        If IoiState = LoadState.Finished Then Exit Sub
+        '解压更新包
+        Log("[IOI] 解压联机模块以完成下载")
+        If File.Exists(PathTemp & "ioi.exe") Then File.Delete(PathTemp & "ioi.exe")
+        If File.Exists(PathIoi) Then File.Delete(PathIoi)
+        Compression.ZipFile.ExtractToDirectory(PathTemp & "联机模块.zip", PathTemp)
+        File.Delete(PathTemp & "联机模块.zip")
+        CopyFile(PathTemp & "ioi.exe", PathIoi)
+        File.Delete(PathTemp & "ioi.exe")
+        Task.Progress = 0.4
+        '再次尝试启动
+        CheckFirewall()
+        If IoiStart() Then Exit Sub
+        IoiStop(True)
+        Throw New Exception("联机模块初始化失败")
+    End Sub
+    '在 IOI 启动后建立 55557 房间
+    Private Shared Sub InitRequest()
+        Try
+            Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/port?proto=tcp&port=55557" & "&password=" & IoiPassword, "PUT", "", "", 100000))
+            If Result("msg") IsNot Nothing Then Throw New InvalidOperationException(Result("msg").ToString)
+        Catch ex As InvalidOperationException
+            'API 返回的错误
+            Log("创建请求核心房间失败：" & ex.Message, LogLevel.Msgbox)
+        Catch ex As Exception
+            '常规错误
+            Log(ex, "创建请求核心房间失败", LogLevel.Msgbox)
+        End Try
+    End Sub
+
+    '检查防火墙权限，并添加对应的权限
+    Private Shared Sub CheckFirewall()
+        Try
+            Log("[IOI] Windows 防火墙：检测开始")
+            If Not PageLinkLeft.FirewallIsBlock(PathIoi) Then Exit Try
+            If PageLinkLeft.FirewallPolicy.CurrentProfile.ExceptionsNotAllowed Then
+                '禁止白名单
+                MyMsgBox("由于 Windows 防火墙阻止了所有传入连接，PCL2 无法获取防火墙通行权限。" & vbCrLf &
+                         "联机会有很大概率失败，就算连上了，延迟也会变高……" & vbCrLf & vbCrLf &
+                         "请先关闭 Windows 防火墙中的 " & vbLQ & "阻止所有传入连接" & vbRQ & " 选项，然后重启 PCL2。", "遭到防火墙拦截")
+            ElseIf IsAdmin() Then
+                '有管理员权限
+                Log("[IOI] Windows 防火墙：尝试添加防火墙通行权限")
+                Try
+                    PageLinkLeft.FirewallAddAuthorized("Plain Craft Launcher 启动器（IOI 联机模块）", PathIoi)
+                Catch ex As Exception
+                    Log(ex, "无法将联机模块添加至防火墙白名单，可能导致联机失败", LogLevel.Msgbox)
+                End Try
+            Else
+                '无管理员权限
+                If MyMsgBox("由于你开启了 Windows 防火墙，PCL2 需要获取防火墙通行权限。" & vbCrLf & vbCrLf &
+                            "若继续，PCL2 将尝试以管理员权限重新启动。" & vbCrLf &
+                            "若拒绝，联机模块可能会被防火墙拦截，联机会有很大概率失败。", "需要管理员权限", "继续", "拒绝") = 1 Then
+                    Log("[IOI] Windows 防火墙：尝试提升权限")
+                    If RerunAsAdmin("--link ioi") Then
+                        FrmMain.EndProgram(False) '已重新运行
+                    Else
+                        Hint("获取管理员权限失败，请尝试右键 PCL2，选择 " & vbLQ & "以管理员身份运行" & vbRQ & "，然后再进入联机页面！", HintType.Critical)
+                    End If
+                Else
+                    Hint("在没有防火墙权限的情况下尝试联机，很可能会导致联机失败！", HintType.Critical)
+                End If
+            End If
+            Log("[IOI] Windows 防火墙：无防火墙通行权限")
+        Catch ex As Exception
+            Log(ex, "无法检测防火墙状态，可能导致联机失败", LogLevel.Msgbox)
+        End Try
+    End Sub
+
+#End Region
+
+#Region "进程管理"
+
+    Private Shared IoiId As String, IoiPassword As String
+    Private Shared IoiProcess As Process = Nothing
+    Private Shared IoiState As LoadState = LoadState.Waiting
+
+    ''' <summary>
+    ''' 若 Ioi 正在运行，则结束 Ioi 进程，同时初始化状态数据。返回是否关闭了对应进程。
+    ''' </summary>
+    Public Shared Function IoiStop(SleepWhenKilled As Boolean) As Boolean
+        IoiStop = False
+        '发送断开信息
+        Try
+            If IoiProcess IsNot Nothing AndAlso Not IoiProcess.HasExited Then
+                For i = 0 To UserList.Count - 1
+                    If i > UserList.Count - 1 Then Exit For
+                    Dim User = UserList.Values(i)
+                    SendDisconnectRequest(User)
+                Next
+            End If
+        Catch ex As Exception
+            Log(ex, "结束 IOI 进程时发送 Disconnect 信息失败")
+        End Try
+        '关闭所有 Ioi 进程
+        For Each ProcessObject In Process.GetProcesses
+            If ProcessObject.ProcessName <> "IOI 联机模块" Then Continue For
+            IoiStop = True
+            Try
+                ProcessObject.Kill()
+                Log("[IOI] 已关闭联机模块：" & ProcessObject.Id)
+                If SleepWhenKilled Then Thread.Sleep(3000) '等待 3 秒确认进程已退出
+            Catch ex As Exception
+                Log(ex, "关闭联机模块失败（" & ProcessObject.Id & "）")
+            End Try
+        Next
+        '初始化
+        IoiProcess = Nothing
+        IoiId = Nothing
+        IoiPassword = Nothing
+        IoiState = LoadState.Waiting
+        UserList = New Dictionary(Of String, LinkUserIoi)
+        RoomListForMe = New List(Of RoomEntry)
+    End Function
+    ''' <summary>
+    ''' 启动 Ioi，并等待初始化完成后退出运行，同时更新 IoiId 与 IoiPassword。
+    ''' 正常初始化返回 True，需要更新返回 False，其余情况抛出异常。
+    ''' 若 Ioi 正在运行，则会先停止其运行。
+    ''' </summary>
+    Public Shared Function IoiStart() As Boolean
+        IoiStop(True)
+        Log("[IOI] 启动联机模块进程")
+        Dim Info = New ProcessStartInfo With {
+            .FileName = PathIoi,
+            .UseShellExecute = False,
+            .CreateNoWindow = True,
+            .RedirectStandardError = True,
+            .RedirectStandardOutput = True,
+            .WorkingDirectory = PathTemp
+        }
+        IoiProcess = New Process() With {.StartInfo = Info}
+        Using outputWaitHandle As New AutoResetEvent(False)
+            Using errorWaitHandle As New AutoResetEvent(False)
+                AddHandler IoiProcess.OutputDataReceived, Function(sender, e)
+                                                              Try
+                                                                  If e.Data Is Nothing Then
+                                                                      outputWaitHandle.[Set]()
+                                                                  Else
+                                                                      IoiLogLine(e.Data)
+                                                                  End If
+                                                              Catch ex As ObjectDisposedException
+                                                              Catch ex As Exception
+                                                                  Log(ex, "读取联机模块信息失败")
+                                                                  IoiState = LoadState.Failed
+                                                              End Try
+                                                              Return Nothing
+                                                          End Function
+                AddHandler IoiProcess.ErrorDataReceived, Function(sender, e)
+                                                             Try
+                                                                 If e.Data Is Nothing Then
+                                                                     errorWaitHandle.[Set]()
+                                                                 Else
+                                                                     IoiLogLine(e.Data)
+                                                                 End If
+                                                             Catch ex As ObjectDisposedException
+                                                             Catch ex As Exception
+                                                                 Log(ex, "读取联机模块错误信息失败")
+                                                                 IoiState = LoadState.Failed
+                                                             End Try
+                                                             Return Nothing
+                                                         End Function
+                IoiProcess.Start()
+                IoiState = LoadState.Loading
+                IoiProcess.BeginOutputReadLine()
+                IoiProcess.BeginErrorReadLine()
+                '等待
+                Do Until IoiProcess.HasExited OrElse IoiState <> LoadState.Loading
+                    Thread.Sleep(10)
+                Loop
+                '输出
+                If IoiState = LoadState.Finished Then
+                    Log("[IOI] 联机模块启动成功")
+                    Return True
+                Else
+                    Throw New Exception("联机模块启动失败")
+                End If
+                'Select Case IoiState
+                '    Case LoadState.Finished
+                '        Log("[IOI] 联机模块启动成功")
+                '        Return True
+                '    Case LoadState.Aborted
+                '        Log("[IOI] 联机模块要求更新")
+                '        Return False
+                '    Case LoadState.Failed
+                '        Log("[IOI] 联机模块启动出现异常")
+                '        Return False
+                '    Case Else 'LoadState.Loading
+                '        Throw New Exception("联机模块启动失败，请检查你的网络连接")
+                'End Select
+            End Using
+        End Using
+    End Function
+
+    'Ioi 日志
+    Private Shared Sub IoiLogLine(Content As String)
+
+        '初始化
+        If Content.Contains(" > http://127.0.0.1:55555/") Then Exit Sub
+        If Content.Contains("All done") Then
+            If IoiId IsNot Nothing AndAlso IoiPassword IsNot Nothing Then
+                IoiState = LoadState.Finished
+            Else
+                Log("[IOI] 联机模块汇报初始化完成，但未提供账户信息")
+                IoiState = LoadState.Failed
+            End If
+            Exit Sub
+        End If
+        If Content.Contains("Password :: ") Then
+            IoiPassword = Content.Split({"Password :: "}, StringSplitOptions.None)(1)
+            Exit Sub '为保证安全不记录密码到 Log
+        End If
+
+        '初始化
+        If Content.Contains("ID :: ") Then IoiId = Content.Split({"ID :: "}, StringSplitOptions.None)(1)
+        If Content.Contains("Initialization failed") OrElse Content.Contains("The version is ") Then IoiState = LoadState.Aborted
+
+        '系统回应
+        If Content.Contains("'portssub' from ") Then LastPortsId = Content.Split(" ").Last
+        If Content.Contains("Listening tcp ") Then
+            If UserList.ContainsKey(LastPortsId) Then
+                DictionaryAdd(UserList(LastPortsId).Ports, Content.Split(" ").Last, RegexSeek(Content, "(?<=Listening tcp )[^:]+"))
+            Else
+                Log("[IOI] 未在列表中的用户出现意料外的连接信息")
+                NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & LastPortsId & "&password=" & IoiPassword, "DELETE", "", "", 500)
+            End If
+        End If
+
+        '断开连接
+        If Content.Contains("Closed tcp connection from ") AndAlso Content.Contains(":55557") Then
+            For i = 0 To UserList.Count - 1
+                Dim User = UserList.Values(i)
+                If Not Content.Contains(User.Ports(55557)) OrElse User.IsDisposed Then Continue For
+                Log("[IOI] 检测到 55557 端口断开（" & User.DisplayName & "）")
+                UserRemove(User, True)
+                Exit For
+            Next
+        End If
+
+        '写入日志
+        If Not Content.Contains("read /dev/stdin: The handle is invalid.") AndAlso LogLinesCount < If(ModeDebug, 10000, 1000) Then
+            LogLinesCount += 1
+            Log("[IOI] " & Content)
+        End If
+
+    End Sub
+    Private Shared LogLinesCount As Integer = 0
+    Private Shared LastPortsId As String = "" '上一个收到 portssub 的 ID，用于记录端口
+
+#End Region
+
+#Region "时钟"
+
+    'UI 线程刷新
+    Private Shared UserListIdentifyCache As String = ""
+    Private Shared RoomListIdentifyCache As String = ""
+    Public Sub RefreshUi()
+        Try
+            '确认用户列表缓存
+            Dim UserListIdentify As String = Join(UserList, vbCrLf)
+            If UserListIdentify <> UserListIdentifyCache Then
+                UserListIdentifyCache = UserListIdentify
+                '刷新列表项
+                PanUserList.Children.Clear()
+                For i = 0 To UserList.Count - 1
+                    If i > UserList.Count - 1 Then Exit For
+                    PanUserList.Children.Add(UserList.Values(i).ToListItem)
+                Next
+                '刷新列表标题
+                CardUser.Title = "已连接的玩家 (" & PanUserList.Children.Count & ")"
+            End If
+            '刷新用户列表项
+            For Each UserItem As MyListItem In PanUserList.Children
+                CType(UserItem.Tag, LinkUserIoi).RefreshUi(UserItem)
+            Next
+            '确认房间列表缓存
+            Dim RoomListIdentify As String = Join(GetRoomList(), vbCrLf)
+            If RoomListIdentify <> RoomListIdentifyCache Then
+                RoomListIdentifyCache = RoomListIdentify
+                '刷新列表项
+                PanRoom.Children.Clear()
+                For Each Room In GetRoomList()
+                    PanRoom.Children.Add(Room.ToListItem)
+                Next
+            End If
+            '刷新房间列表项
+            For Each RoomItem As MyListItem In PanRoom.Children
+                CType(RoomItem.Tag, RoomEntry).RefreshUi(RoomItem)
+            Next
+            '刷新操作提示
+            If UserList.Count = 0 Then
+                If RoomListForMe.Count = 0 Then
+                    LabHint.Text = "若想创建房间，请点击创建房间按钮，并按说明进行操作。" & vbCrLf & "若想加入他人的房间，请点击建立连接，然后输入对方的联机码。"
+                Else
+                    LabHint.Text = "若想让其他人加入你的房间，请点击复制联机码，然后让你的朋友输入你的联机码以建立连接。"
+                End If
+            Else
+                If GetRoomList.Count = 0 Then
+                    LabHint.Text = "若想创建房间，请点击创建房间按钮，然后输入对局域网开放后 MC 显示的端口号，或本地服务端的端口号。"
+                ElseIf RoomListForMe.Count = 0 Then
+                    '已有连接，本人没有房间，对方有房间
+                    LabHint.Text = "若想加入某个房间，直接点击该房间即可获取说明。"
+                Else
+                    '已有连接，且本人有房间
+                    LabHint.Text = "指向你所创建的房间，能在右侧找到修改房间名称、关闭房间等选项。" &
+                                   If(RoomListForMe.Count <> GetRoomList.Count, vbCrLf & "若想加入其他人的房间，直接点击该房间即可获取说明。", "")
+                End If
+            End If
+        Catch ex As Exception
+            Log(ex, "联机模块 UI 时钟运行失败", LogLevel.Feedback)
+        End Try
+    End Sub
+
+    '工作线程刷新
+    Public Sub RefreshWorker()
+        Try
+            '检测退出
+            If InitLoader.State = LoadState.Finished AndAlso IoiProcess.HasExited Then
+                Log("[IOI] 联机模块出现异常！", LogLevel.Hint)
+                ModuleStopManually()
+            End If
+            '检测用户
+            For i = 0 To UserList.Values.Count - 1
+                If i > UserList.Values.Count - 1 Then Exit For
+                Dim User = UserList.Values(i)
+                If User.Progress < 1 Then Continue For '跳过连接中的用户
+                '发送心跳包
+                If Date.Now - User.LastSend > New TimeSpan(0, 0, RandomInteger(50, 30)) Then
+                    RunInNewThread(Sub()
+                                       Try
+                                           SendUpdateRequest(User, 1)
+                                       Catch ex As Exception
+                                           Log(ex, "心跳包发送失败（" & User.DisplayName & "）", LogLevel.Normal)
+                                       End Try
+                                   End Sub, "Link Heartbeat " & User.Id)
+                End If
+                '检测被动离线
+                If Date.Now - User.LastReceive > New TimeSpan(0, 2, 0) Then
+                    SendDisconnectRequest(User)
+                    Hint("与 " & User.DisplayName & " 的连接已中断！", HintType.Critical)
+                End If
+            Next
+        Catch ex As Exception
+            Log(ex, "联机模块工作时钟运行失败", LogLevel.Feedback)
+        End Try
+    End Sub
+
+#End Region
+
+#Region "发送请求"
+
+    ''' <summary>
+    ''' 发送 Portsub 请求并等待获取控制台端口。进度将从 0 变化至 80%。
+    ''' </summary>
+    Private Shared Sub SendPortsubRequest(User As LinkUserIoi)
+        Log("[IOI] 尝试建立连接：" & User.Id)
+        '向对方发送 portsub 请求
+        Dim Retry As Integer = 0
+RetryLink:
+        Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "PUT", "", "", 100000))
+        '失败与重试
+        If Result("msg") IsNot Nothing Then
+            Dim ErrorMessage As String = Result("msg").ToString
+            Select Case ErrorMessage
+                Case "failed to find any peer in table"
+                    Retry += 1
+                    ErrorMessage = "我方网络环境不佳，连接失败。" '初始化对等机列表超时
+                    Log("[IOI] 尝试建立连接结果：未找到对等机，第 " & Retry & " 级重试")
+                Case "routing: not found"
+                    Retry += 4
+                    ErrorMessage = "我方或对方网络环境不佳，或对方已关闭联机模块，未找到路由。" '未知情况
+                    Log("[IOI] 尝试建立连接结果：无法连接到路由，第 " & Retry & " 级重试")
+                Case "you are already connected to specified host"
+                    If User.IsDisposed Then Throw New ThreadInterruptedException("用户对象已被释放")
+                    Log("[IOI] 尝试建立连接结果：已与对方连接")
+                    GoTo Done
+                    'Retry += 1
+                    'NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 100000)
+                    'ErrorMessage = "已与对方连接。" '双向连接偶尔导致
+                    'Log("[IOI] 已与对方连接，尝试中断现有连接，第 " & Retry & " 级重试")
+                Case "dial backoff"
+                    Retry += 20
+                    ErrorMessage = "对方网络环境不佳，或对方已关闭联机模块。请尝试让对方主动连接你，而不是你去连接对方。" 'NAT2 连 NAT4 导致
+                    Log("[IOI] 尝试建立连接结果：NAT 异常，第 " & Retry & " 级重试")
+                Case Else
+                    If ErrorMessage.Contains("all dials failed") Then
+                        Retry += 8
+                        ErrorMessage = "我方或对方网络环境不佳，或对方已关闭联机模块，连接失败。" '网络不佳，或对方已关闭模块
+                        Log("[IOI] 尝试建立连接结果：连接失败，第 " & Retry & " 级重试")
+                    Else
+                        Retry += 8
+                        Log("[IOI] 尝试建立连接结果：未知错误（" & ErrorMessage & "），第 " & Retry & " 级重试")
+                    End If
+            End Select
+            If User.IsDisposed Then Throw New ThreadInterruptedException("用户对象已被释放")
+            If Retry <= 64 Then
+                User.Progress = Retry * 0.01 + 0.05
+                Thread.Sleep(3000)
+                GoTo RetryLink
+            Else
+                Throw New InvalidOperationException(ErrorMessage)
+            End If
+        End If
+        Log("[IOI] 尝试建立连接结果：成功")
+        '等待获取对方端口
+Done:
+        Dim WaitCount As Integer = 0
+        Do Until User.Ports.ContainsKey(55555) AndAlso User.Ports.ContainsKey(55557)
+            WaitCount += 1
+            User.Progress = 0.7 + WaitCount / 200 * 0.1 '70% ~ 80%
+            If WaitCount = 100 Then Throw New Exception("连接超时，请尝试重新连接（未收到端口回报）！")
+            Thread.Sleep(150)
+        Loop
+        User.Progress = 0.8
+    End Sub
+
+    ''' <summary>
+    ''' 向控制台发送 Connect 请求。
+    ''' </summary>
+    Private Shared Sub SendConnectRequest(User As LinkUserIoi)
+        Dim RawJson As New JObject()
+        RawJson("version") = RequestVersion
+        RawJson("name") = GetPlayerName()
+        RawJson("id") = IoiId
+        RawJson("type") = "connect"
+        User.Send(RawJson)
+    End Sub
+
+    ''' <summary>
+    ''' 向控制台发送 Update 请求。
+    ''' </summary>
+    Private Shared Sub SendUpdateRequest(User As LinkUserIoi, Stage As Integer, Optional Unique As Long = -1)
+        If Unique = -1 Then Unique = GetTimeTick()
+        Dim RawJson As New JObject
+        RawJson("name") = GetPlayerName()
+        RawJson("id") = IoiId
+        RawJson("type") = "update"
+        RawJson("stage") = Stage
+        RawJson("unique") = Unique
+        If Stage < 3 Then
+            Dim Rooms As New JArray
+            For Each Room In RoomListForMe
+                Dim RoomObject As New JObject
+                RoomObject("name") = Room.DisplayName
+                RoomObject("port") = Room.Port
+                Rooms.Add(RoomObject)
+            Next
+            RawJson("rooms") = Rooms
+            DictionaryAdd(User.PingPending, Unique, Date.Now)
+        End If
+        User.Send(RawJson)
+    End Sub
+
+    ''' <summary>
+    ''' 尝试发送断开请求，并将其从用户列表中移除。
+    ''' </summary>
+    Private Shared Sub SendDisconnectRequest(User As LinkUserIoi, Optional Message As String = Nothing, Optional IsError As Boolean = False)
+        Dim RawJson As New JObject()
+        RawJson("id") = IoiId
+        RawJson("type") = "disconnect"
+        If Message IsNot Nothing Then
+            RawJson("message") = Message
+            RawJson("isError") = IsError
+        End If
+        Try
+            User.Send(RawJson)
+            Thread.Sleep(50)
+        Catch
+        End Try
+        NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
+        User.Dispose()
+    End Sub
+
+#End Region
+
+#Region "左边栏操作"
+
+    '刷新连接
+    Private Shared Sub BtnListRefresh_Click(sender As MyIconButton, e As EventArgs)
+        Dim User As LinkUserIoi = sender.Tag
+        User.PingRecord.Clear()
+        FrmLinkIoi.RefreshUi()
+        RunInThread(Sub()
+                        Try
+                            SendUpdateRequest(User, 1)
+                        Catch ex As Exception
+                            If InitLoader.State = LoadState.Finished Then Log(ex, "刷新与 " & User.DisplayName & " 的连接失败", LogLevel.Hint)
+                        End Try
+                    End Sub)
+    End Sub
+    '断开连接
+    Private Shared Sub BtnListDisconnect_Click(sender As MyIconButton, e As EventArgs)
+        Dim User As LinkUserIoi = sender.Tag
+        sender.IsEnabled = False
+        RunInThread(Sub()
+                        If User.Progress < 1 AndAlso User.RelativeThread IsNot Nothing AndAlso User.RelativeThread.IsAlive Then
+                            NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
+                            User.Dispose()
+                        Else
+                            SendDisconnectRequest(User, GetPlayerName() & " 主动断开了连接！")
+                        End If
+                    End Sub)
+    End Sub
+    '复制联机码
+    Public Shared Sub BtnLeftCopy_Click() Handles BtnLeftCopy.Click
+        ClipboardSet(IoiId.Substring(4) & SecretEncrypt(GetPlayerName), False)
+        Hint("已复制联机码！", HintType.Finish)
+    End Sub
+
+#End Region
+
+#Region "玩家名"
+
+    ''' <summary>
+    ''' 获取当前的玩家名。
+    ''' </summary>
+    Public Shared Function GetPlayerName() As String
+        '自动生成玩家名
+        If AutogenPlayerName Is Nothing Then
+            If IsPlayerNameValid(McLoginName) Then
+                AutogenPlayerName = McLoginName()
+            Else
+                AutogenPlayerName = "玩家 " & CType(GetHash(If(UniqueAddress, "")) Mod 1048576, Integer).ToString("x5").ToUpper
+            End If
+        End If
+        '获取玩家自定义的名称
+        Dim CustomName As String = Setup.Get("LinkName").ToString.Trim()
+        If CustomName <> "" Then
+            If IsPlayerNameValid(CustomName) Then
+                Return CustomName.Trim
+            Else
+                Hint("你所设置的玩家名存在异常，已被重置！", HintType.Critical)
+                Setup.Set("LinkName", "")
+            End If
+        End If
+        '使用自动生成的玩家名
+        Return AutogenPlayerName
+    End Function
+    Private Shared AutogenPlayerName As String = Nothing '并非由玩家自定义，而是自动生成的玩家名
+    ''' <summary>
+    ''' 检查某个玩家名是否合法。
+    ''' </summary>
+    Private Shared Function IsPlayerNameValid(Name As String) As Boolean
+        For Each ValidateRule As Validate In {New ValidateNullOrWhiteSpace, New ValidateLength(0, 20), New ValidateFilter}
+            If Not String.IsNullOrEmpty(ValidateRule.Validate(Name)) Then Return False
+        Next
+        Return True
+    End Function
+
+#End Region
+
+#Region "请求核心"
+
+    Private Shared Listener As Socket = Nothing
+    ''' <summary>
+    ''' 启动 Socket 监听核心。
+    ''' </summary>
+    Public Shared Sub StartSocketListener()
+        If Listener IsNot Nothing Then Exit Sub '已经启动过了
+        Listener = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) With {.ReceiveTimeout = 1000000000, .SendTimeout = 1000000000}
+        Listener.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReuseAddress, True)
+        Try
+            Listener.Bind(New IPEndPoint(IPAddress.Any, 55557))
+        Catch ex As Exception
+            Log(ex, "初次启动 Socket 监听核心失败，开始重试")
+            Thread.Sleep(1000)
+            Listener.Bind(New IPEndPoint(IPAddress.Any, 55557))
+        End Try
+        Listener.Listen(100)
+        Log("[IOI] 已启动 Socket 监听核心")
+        RunInNewThread(Sub()
+                           While True
+                               Try
+                                   '获取新的 Socket
+                                   Dim bytes(1024) As Byte
+                                   Dim ClientSocket As Socket = Listener.Accept()
+                                   '获取初始输入信息
+                                   Dim RequestInput As String = Encoding.UTF8.GetString(bytes, 0, ClientSocket.Receive(bytes))
+                                   If Not RequestInput.StartsWith("PCL - ") Then Exit Sub
+                                   Dim RawData As String
+                                   Try
+                                       RawData = SecretDecrypt(WebUtility.UrlDecode(RequestInput.Substring(6)))
+                                       Log("[IOI] 接收到新的 Socket：" & RawData)
+                                       PageLinkIoi.ReceiveJson(GetJson(RawData), ClientSocket)
+                                   Catch ex As Exception
+                                       Log(ex, "新的 Socket 处理出错（内容：" & RequestInput & "）")
+                                   End Try
+                               Catch ex As Exception
+                                   Log(ex, "Socket 监听出错")
+                                   Thread.Sleep(3000) '防止死循环出错
+                               End Try
+                           End While
+                       End Sub, "Socket Listener")
+    End Sub
+
+#End Region
+
+#Region "用户核心"
+
+    '用户基类
+    Public MustInherit Class LinkUserBase
+        Implements IDisposable
+
+        '基础数据
+        Public Uuid As Integer = GetUuid()
+        Public Id As String
+        Public DisplayName As String
+
+        '请求管理
+        Public Socket As Socket = Nothing
+        Public Sub Send(Request As JObject)
+            If Socket Is Nothing Then Throw New Exception("该用户尚未绑定 Socket")
+            Dim Data As String = Request.ToString(Newtonsoft.Json.Formatting.None)
+            If ModeDebug Then Log("[IOI] 发送联机数据包（" & DisplayName & "）：" & Data)
+            Data = "PCL - " & WebUtility.UrlEncode(SecretEncrypt(Data))
+            Me.LastSend = Date.Now
+            Socket.Send(Encoding.UTF8.GetBytes(Data))
+        End Sub
+        Public ListenerThread As Thread = Nothing
+        Public Sub StartListener()
+            If ListenerThread IsNot Nothing Then Exit Sub
+            '启动监听
+            ListenerThread = RunInNewThread(Sub()
+                                                Try
+                                                    Dim bytes(1024) As Byte
+                                                    While PageLinkIoi.UserList.ContainsValue(Me)
+                                                        Dim RequestInput As String = Encoding.UTF8.GetString(bytes, 0, Socket.Receive(bytes))
+                                                        If Not RequestInput.StartsWith("PCL - ") Then Exit Sub
+                                                        Dim RawData As String = SecretDecrypt(WebUtility.UrlDecode(RequestInput.Substring(6)))
+                                                        If ModeDebug Then Log("[IOI] 接收联机数据包（" & DisplayName & "）：" & RawData)
+                                                        PageLinkIoi.ReceiveJson(GetJson(RawData)) '调用去实际的联机模块
+                                                    End While
+                                                Catch ex As ThreadInterruptedException
+                                                    Log("[IOI] 用户监听已中断（" & DisplayName & "）")
+                                                Catch ex As Exception
+                                                    If IsDisposed Then Exit Sub
+                                                    If ex.GetType.Equals(GetType(SocketException)) AndAlso CType(ex, SocketException).SocketErrorCode = 10053 Then
+                                                        Log("[IOI] 客户端已关闭（" & DisplayName & "）")
+                                                        PageLinkIoi.UserRemove(CType(Me, PageLinkIoi.LinkUserIoi), True)
+                                                        Exit Sub
+                                                    End If
+                                                    Log(ex, "用户监听出错（" & DisplayName & "）")
+                                                    PageLinkIoi.UserRemove(CType(Me, PageLinkIoi.LinkUserIoi), True)
+                                                End Try
+                                            End Sub, "Link Listener " & DisplayName)
+        End Sub
+        Public Sub BindSocket(Socket As Socket)
+            If Me.Socket IsNot Nothing Then Throw New Exception("该用户已经绑定了 Socket")
+            Me.Socket = Socket
+            StartListener()
+        End Sub
+
+        'Ping
+        '0：与 Ping 计算无关，不回应
+        '1：A to B，2：B to A，3：A to B
+        Public PingPending As New Dictionary(Of Long, Date)
+        Public PingRecord As New Queue(Of Integer)
+
+        '心跳包
+        Public LastSend As Date = Date.Now
+        Public LastReceive As Date = Date.Now
+
+        '类型转换
+        Public Sub New(Id As String, DisplayName As String)
+            Me.Id = Id
+            Me.DisplayName = DisplayName
+            Log("[IOI] 无通信包的新用户对象：" & ToString())
+        End Sub
+        Public Sub New(Id As String, DisplayName As String, Socket As Socket)
+            Me.Id = Id
+            Me.DisplayName = DisplayName
+            Me.Socket = Socket
+            Log("[IOI] 新用户对象：" & ToString())
+            StartListener()
+        End Sub
+        Public Overrides Function ToString() As String
+            Return DisplayName & " @ " & Id & " #" & Uuid
+        End Function
+        Public Shared Widening Operator CType(User As LinkUserBase) As String
+            Return User.ToString
+        End Operator
+
+        '释放资源
+        Public IsDisposed As Boolean = False
+        Protected Overridable Sub Dispose(IsDisposing As Boolean)
+            If Socket IsNot Nothing Then Socket.Dispose()
+            If ListenerThread IsNot Nothing AndAlso ListenerThread.IsAlive Then ListenerThread.Interrupt()
+        End Sub
+        Public Sub Dispose() Implements IDisposable.Dispose
+            If Not IsDisposed Then
+                IsDisposed = True
+                Dispose(True)
+            End If
+            GC.SuppressFinalize(Me)
+        End Sub
+    End Class
+
+    '用户对象
+    Public Shared UserList As New Dictionary(Of String, LinkUserIoi)
+    Public Class LinkUserIoi
+        Inherits LinkUserBase
+        Public Sub New(Id As String, DisplayName As String, Socket As Socket)
+            MyBase.New(Id, DisplayName, Socket)
+        End Sub
+        Public Sub New(Id As String, DisplayName As String)
+            MyBase.New(Id, DisplayName)
+        End Sub
+
+        '基础数据
+        Public Ports As New Dictionary(Of Integer, String)
+        Public Rooms As New List(Of RoomEntry)
+
+        '进度与 UI
+        Public Progress As Double = 0
+        Public RelativeThread As Thread = Nothing
+
+        Public Function GetDescription() As String
+            Return If(Progress < 1,
+                "正在连接，" & Math.Round(Progress * 100) & "%",
+                "已连接，" & If(PingRecord.Count = 0, "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
+        End Function
+        Public Function ToListItem() As MyListItem
+            Dim Item As New MyListItem With {
+                .Title = DisplayName, .Height = 42, .Tag = Me, .Type = MyListItem.CheckType.None,
+                .PaddingRight = 60,
+                .Logo = "pack://application:,,,/images/Blocks/Grass.png"}
+            '绑定图标按钮
+            Dim BtnRefresh As New MyIconButton With {.Logo = Logo.IconButtonRefresh, .LogoScale = 0.85, .ToolTip = "刷新", .Tag = Me}
+            AddHandler BtnRefresh.Click, AddressOf BtnListRefresh_Click
+            ToolTipService.SetPlacement(BtnRefresh, Primitives.PlacementMode.Bottom)
+            ToolTipService.SetHorizontalOffset(BtnRefresh, -10)
+            ToolTipService.SetVerticalOffset(BtnRefresh, 5)
+            ToolTipService.SetShowDuration(BtnRefresh, 2333333)
+            ToolTipService.SetInitialShowDelay(BtnRefresh, 200)
+            Dim BtnClose As New MyIconButton With {.Logo = Logo.IconButtonCross, .LogoScale = 0.85, .ToolTip = "断开", .Tag = Me}
+            AddHandler BtnClose.Click, AddressOf BtnListDisconnect_Click
+            ToolTipService.SetPlacement(BtnClose, Primitives.PlacementMode.Bottom)
+            ToolTipService.SetHorizontalOffset(BtnClose, -10)
+            ToolTipService.SetVerticalOffset(BtnClose, 5)
+            ToolTipService.SetShowDuration(BtnClose, 2333333)
+            ToolTipService.SetInitialShowDelay(BtnClose, 200)
+            Item.Buttons = {BtnRefresh, BtnClose}
+            '刷新并返回
+            RefreshUi(Item)
+            Return Item
+        End Function
+        Public Sub RefreshUi(RelatedListItem As MyListItem)
+            RelatedListItem.Title = DisplayName
+            RelatedListItem.Info = GetDescription()
+            RelatedListItem.Buttons(0).Visibility = If(Progress = 1, Visibility.Visible, Visibility.Collapsed)
+        End Sub
+
+        '释放
+        Protected Overrides Sub Dispose(IsDisposing As Boolean)
+            Log("[IOI] 用户资源释放（IOI, " & DisplayName & "）")
+            If RelativeThread IsNot Nothing AndAlso RelativeThread.IsAlive Then RelativeThread.Interrupt()
+            UserList.Remove(Id)
+            MyBase.Dispose(IsDisposing)
+        End Sub
+    End Class
+
+    '房间对象
+    Private Shared RoomListForMe As New List(Of RoomEntry)
+
+    Private Function GetRoomList() As List(Of RoomEntry)
+        Dim RoomList As New List(Of RoomEntry)(RoomListForMe)
+        For i = 0 To UserList.Count - 1
+            If i > UserList.Count - 1 Then Exit For
+            RoomList.AddRange(UserList.Values(i).Rooms)
+        Next
+        Return RoomList
+    End Function
+    Public Class RoomEntry
+
+        '基础数据
+        Public Port As Integer
+        Public DisplayName As String
+        Public User As LinkUserIoi = Nothing '若 IsOwner = True，则此项为 Nothing
+        Public IsOwner As Boolean
+        Public ReadOnly Property Ip As String
+            Get
+                If IsOwner Then
+                    Return "localhost:" & Port
+                Else
+                    Return User.Ports(Port) & ":" & Port
+                End If
+            End Get
+        End Property
+
+        '类型转换
+        Public Sub New(Port As Integer, DisplayName As String, Optional User As LinkUserIoi = Nothing)
+            Me.IsOwner = User Is Nothing
+            Me.User = User
+            Me.DisplayName = DisplayName
+            Me.Port = Port
+        End Sub
+        Public Overrides Function ToString() As String
+            Return DisplayName & " - " & Port & " - " & IsOwner
+        End Function
+        Public Shared Widening Operator CType(Room As RoomEntry) As String
+            Return Room.ToString
+        End Operator
+        Public Shared Function SelectPort(Room As RoomEntry) As Integer
+            Return Room.Port
+        End Function
+
+        'UI
+        Public Function GetDescription() As String
+            If IsOwner Then
+                Return "由我创建，端口 " & Port
+            Else
+                Return "由 " & User.DisplayName & " 创建，端口 " & Port
+            End If
+        End Function
+        Public Function ToListItem() As MyListItem
+            Dim Item As New MyListItem With {
+                .Title = DisplayName, .Height = 42, .Info = GetDescription(), .Tag = Me, .PaddingRight = If(IsOwner, 60, 0),
+                .Type = If(IsOwner, MyListItem.CheckType.None, MyListItem.CheckType.Clickable),
+                .Logo = "pack://application:,,,/images/Blocks/" & If(IsOwner, "GrassPath", "Grass") & ".png"}
+            If IsOwner Then
+                '绑定图标按钮
+                Dim BtnEdit As New MyIconButton With {.Logo = Logo.IconButtonEdit, .LogoScale = 1, .ToolTip = "修改名称", .Tag = Me}
+                AddHandler BtnEdit.Click, AddressOf BtnRoomEdit_Click
+                ToolTipService.SetPlacement(BtnEdit, Primitives.PlacementMode.Bottom)
+                ToolTipService.SetHorizontalOffset(BtnEdit, -22)
+                ToolTipService.SetVerticalOffset(BtnEdit, 5)
+                ToolTipService.SetShowDuration(BtnEdit, 2333333)
+                ToolTipService.SetInitialShowDelay(BtnEdit, 200)
+                Dim BtnClose As New MyIconButton With {.Logo = Logo.IconButtonCross, .LogoScale = 0.85, .ToolTip = "关闭", .Tag = Me}
+                AddHandler BtnClose.Click, AddressOf BtnRoomClose_Click
+                ToolTipService.SetPlacement(BtnClose, Primitives.PlacementMode.Bottom)
+                ToolTipService.SetHorizontalOffset(BtnClose, -10)
+                ToolTipService.SetVerticalOffset(BtnClose, 5)
+                ToolTipService.SetShowDuration(BtnClose, 2333333)
+                ToolTipService.SetInitialShowDelay(BtnClose, 200)
+                Item.Buttons = {BtnEdit, BtnClose}
+            Else
+                '绑定点击事件
+                AddHandler Item.Click, AddressOf BtnRoom_Click
+            End If
+            Return Item
+        End Function
+        Public Sub RefreshUi(RelatedListItem As MyListItem)
+            RelatedListItem.Title = DisplayName
+            RelatedListItem.Info = GetDescription()
+        End Sub
+
+    End Class
+
+#End Region
+
+    '正向与反向连接
+    Public Shared Sub BtnLeftCreate_Click() Handles BtnLeftCreate.Click
+        '获取信息
+        Dim Code As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateLength(9, 99999)}, "", "输入对方的联机码", "确定", "取消")
+        If Code Is Nothing Then Exit Sub
+        '检查
+        If Code.StartsWith("P") AndAlso Code.Length < 48 Then
+            Hint("你输入的可能是 HiPer 的联机码，请在左侧的联机方式中选择 HiPer！", HintType.Critical) : Exit Sub
+        End If
+        Dim Id As String, DisplayName As String
+        Try '解密失败检查
+            Id = "12D3" & Code.Substring(0, 48)
+            DisplayName = SecretDecrypt(Code.Substring(48))
+        Catch
+            Hint("你输入的联机码有误！", HintType.Critical)
+            Exit Sub
+        End Try
+        If Id = IoiId Then '自我连接检查
+            Hint("我连我自己？搁这卡 Bug 呢？", HintType.Critical)
+            Exit Sub
+        End If
+        '开始
+        Dim User As New LinkUserIoi(Id, DisplayName)
+        User.RelativeThread = RunInNewThread(Sub()
+                                                 Dim WaitCount As Integer = 0
+                                                 Try
+                                                     '加入列表
+                                                     If UserList.ContainsKey(Id) Then
+                                                         Hint(UserList(Id).DisplayName & " 已在列表中，无需再次连接！")
+                                                         Exit Sub
+                                                     Else
+                                                         UserList.Add(Id, User)
+                                                     End If
+                                                     '发送 portsub 请求（0% -> 80%）
+                                                     SendPortsubRequest(User)
+                                                     '构建 Socket（81% -> 82%）
+                                                     Dim ClientSocket As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) With {.ReceiveTimeout = 1000000000, .SendTimeout = 1000000000}
+                                                     ClientSocket.Connect(New IPEndPoint(IPAddress.Parse(User.Ports(55557)), 55557))
+                                                     User.BindSocket(ClientSocket)
+                                                     User.Progress = 0.82
+                                                     '发送 connect 请求（83% -> 85%）
+                                                     SendConnectRequest(User)
+                                                     User.Progress = 0.85
+                                                     '等待对方向自己请求
+                                                     Log("[IOI] 加入成功，等待反向请求")
+                                                     Do While User.Progress < 0.9999
+                                                         User.Progress += 0.0002
+                                                         If User.Progress > 0.98 AndAlso User.Progress < 0.9999 Then Throw New Exception("对方未回应连接请求！")
+                                                         Thread.Sleep(100)
+                                                     Loop
+                                                     Hint("已连接到 " & User.DisplayName & "！", HintType.Finish)
+                                                 Catch ex As ThreadInterruptedException
+                                                     Log("[IOI] 已中断主动发起的连接（" & User.DisplayName & "）")
+                                                 Catch ex As InvalidOperationException
+                                                     'API 返回的错误
+                                                     NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
+                                                     User.Dispose()
+                                                     If InitLoader.State = LoadState.Finished Then Log("与 " & DisplayName & " 建立连接失败：" & ex.Message, LogLevel.Msgbox)
+                                                 Catch ex As Exception
+                                                     '常规错误
+                                                     NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
+                                                     User.Dispose()
+                                                     If ex.InnerException IsNot Nothing AndAlso TypeOf ex.InnerException Is ThreadInterruptedException Then Exit Sub
+                                                     If InitLoader.State = LoadState.Finished Then Log(ex, "与 " & DisplayName & " 建立连接失败", LogLevel.Msgbox)
+                                                 End Try
+                                             End Sub, "Link Create " & DisplayName)
+    End Sub
+    Private Shared Sub SendPortsubBack(User As LinkUserIoi, TargetVersion As Integer)
+        Try
+            SendPortsubRequest(User)
+            User.Progress = 0.9
+            If TargetVersion > RequestVersion Then
+                SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & "：对方的 PCL2 版本过低！", True)
+                Throw New InvalidOperationException("你的 PCL2 版本过低！")
+            ElseIf TargetVersion < RequestVersion Then
+                SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & "：你的 PCL2 版本过低！", True)
+                Throw New InvalidOperationException("对方的 PCL2 版本过低！")
+            Else
+                SendUpdateRequest(User, 1)
+                User.Progress = 1
+                Hint(User.DisplayName & " 已与你建立连接！")
+            End If
+        Catch ex As ThreadInterruptedException
+            Log("[IOI] 已中断被动建立的连接（" & User.DisplayName & "）")
+        Catch ex As InvalidOperationException
+            'API 返回的错误
+            NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
+            User.Dispose()
+            If InitLoader.State = LoadState.Finished Then Log("与 " & User.DisplayName & " 建立连接失败：" & ex.Message, LogLevel.Hint)
+        Catch ex As Exception
+            '常规错误
+            NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
+            User.Dispose()
+            If InitLoader.State = LoadState.Finished Then Log(ex, "与 " & User.DisplayName & " 建立连接失败", LogLevel.Hint)
+        End Try
+    End Sub
+
+    '创建房间
+    Private Sub LinkCreate() Handles BtnCreate.Click
+        If MyMsgBox("请先进入 MC 并暂停游戏，在暂停页面选择对局域网开放，然后在下一个窗口输入 MC 显示的端口号。" & vbCrLf & "若使用服务端开服，则直接在下一个窗口输入服务器配置中的端口号即可。", "提示", "继续", "取消") = 2 Then Exit Sub
+        '获取端口号
+        Dim Port As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {
+                                                   New ValidateInteger(0, 65535),
+                                                   New ValidateExceptSame({"55555", "55557"}, "端口不能为 %！"),
+                                                   New ValidateExceptSame(RoomListForMe.Select(AddressOf RoomEntry.SelectPort), "端口 % 已创建过房间，请在删除该房间后继续！")
+                                               }, "", "输入端口号", "确定", "取消")
+        If Port Is Nothing Then Exit Sub
+        '获取显示名称
+        Dim DisplayName As String = MyMsgBoxInput(GetPlayerName() & " 的房间 - " & Port, New ObjectModel.Collection(Of Validate) From {
+                                                   New ValidateNullOrWhiteSpace(), New ValidateLength(1, 40), New ValidateFilter()
+                                               }, "", "输入房间名（建议包含游戏版本等信息）", "确定", "取消")
+        If DisplayName Is Nothing Then Exit Sub
+        DisplayName = DisplayName.Trim
+        '开始
+        RunInThread(Sub()
+                        Try
+                            '请求
+                            Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/port?proto=tcp&port=" & Port & "&password=" & IoiPassword, "PUT", "", "", 100000))
+                            If Result("msg") IsNot Nothing Then Throw New InvalidOperationException(Result("msg").ToString)
+                            '成功
+                            RoomListForMe.Add(New RoomEntry(Port, DisplayName))
+                            Hint("房间 " & DisplayName & " 已创建！", HintType.Finish)
+                            SendUpdateRequestToAllUsers()
+                        Catch ex As InvalidOperationException
+                            'API 返回的错误
+                            Log("创建房间失败：" & ex.Message, LogLevel.Msgbox)
+                        Catch ex As Exception
+                            '常规错误
+                            Log(ex, "创建房间失败", LogLevel.Msgbox)
+                        End Try
+                    End Sub)
+    End Sub
+    Private Shared Sub SendUpdateRequestToAllUsers()
+        For i = 0 To UserList.Count - 1
+            If i > UserList.Count - 1 Then Exit For
+            Dim User = UserList.Values(i)
+            If User.Progress < 1 Then Continue For
+            Try
+                SendUpdateRequest(User, 1) '不需要使用多线程，发送实际会瞬间完成
+            Catch ex As Exception
+                Log(ex, "发送全局刷新请求失败（" & User.DisplayName & "）")
+            End Try
+        Next
+    End Sub
+    '修改房间名称
+    Private Shared Sub BtnRoomEdit_Click(sender As MyIconButton, e As EventArgs)
+        Dim Room As RoomEntry = sender.Tag
+        '获取房间名
+        Dim DisplayName As String = MyMsgBoxInput(Room.DisplayName, New ObjectModel.Collection(Of Validate) From {
+                                                   New ValidateNullOrWhiteSpace(),
+                                                   New ValidateLength(1, 40)
+                                               }, "", "输入房间名（建议包含游戏版本等信息）", "确定", "取消")
+        If DisplayName Is Nothing Then Exit Sub
+        DisplayName = DisplayName.Trim
+        '修改
+        Room.DisplayName = DisplayName
+        FrmLinkIoi.RefreshUi()
+        SendUpdateRequestToAllUsers()
+    End Sub
+    '加入房间
+    Private Shared Sub BtnRoom_Click(sender As MyListItem, e As EventArgs)
+        Dim Room As RoomEntry = sender.Tag
+        If MyMsgBox("请在多人游戏页面点击直接连接，输入 " & Room.Ip & " 以进入服务器！", "加入房间", "复制地址", "确定") = 1 Then
+            ClipboardSet(Room.Ip)
+        End If
+    End Sub
+    '关闭房间
+    Private Shared Sub BtnRoomClose_Click(sender As MyIconButton, e As EventArgs)
+        Dim Room As RoomEntry = sender.Tag
+        RunInThread(Sub()
+                        Try
+                            '远程移除
+                            Dim Result As JObject = GetJson(NetRequestOnce("http://127.0.0.1:55555/api/port?proto=tcp&port=" & Room.Port & "&password=" & IoiPassword, "DELETE", "", "", 100000))
+                            If Result("msg") IsNot Nothing Then Throw New InvalidOperationException(Result("msg").ToString)
+                            '本地移除
+                            RoomListForMe.Remove(Room)
+                            '成功
+                            RunInUi(Sub() FrmLinkIoi.RefreshUi())
+                            SendUpdateRequestToAllUsers()
+                        Catch ex As InvalidOperationException
+                            'API 返回的错误
+                            If InitLoader.State = LoadState.Finished Then Log("移除房间失败：" & ex.Message, LogLevel.Msgbox)
+                        Catch ex As Exception
+                            '常规错误
+                            If InitLoader.State = LoadState.Finished Then Log(ex, "移除房间失败", LogLevel.Msgbox)
+                        End Try
+                    End Sub)
+    End Sub
+
+    '获取数据包
+    Public Shared Sub ReceiveJson(JsonData As JObject, Optional NewSocket As Socket = Nothing)
+        '获取数据
+        Dim Id As String = JsonData("id"), Type As String = JsonData("type")
+        Select Case Type
+            Case "connect"
+                Dim DisplayName As String = JsonData("name")
+                Dim User As New LinkUserIoi(Id, DisplayName, NewSocket)
+                '如果发生了双向连接
+                If UserList.ContainsKey(Id) Then
+                    If Id > IoiId Then
+                        Log("[IOI] 双向连接，应当抛弃当前用户（" & DisplayName & "）")
+                        For Each Pair In UserList(User.Id).Ports.ToList
+                            DictionaryAdd(User.Ports, Pair.Key, Pair.Value)
+                        Next
+                        UserList(Id).Dispose()
+                    Else
+                        '应当保留当前用户
+                        Log("[IOI] 双向连接，应当保留当前用户（" & DisplayName & "）")
+                        NewSocket.Dispose()
+                        Exit Sub
+                    End If
+                End If
+                '加入列表
+                UserList.Add(Id, User)
+                '返回请求
+                User.RelativeThread = RunInNewThread(Sub()
+                                                         SendPortsubBack(User, JsonData("version").ToObject(Of Integer))
+                                                     End Sub, "Link Connect " & DisplayName)
+                '更新时间
+                User.LastReceive = Date.Now
+            Case "update"
+                If Not UserList.ContainsKey(Id) Then Throw New Exception("未在列表中的用户发送了更新请求：" & Id)
+                Dim User = UserList(Id)
+                '拉满进度（该请求也作为反向连接回应出现，用于向正向连接方传达连接已完成信号）
+                User.Progress = 1
+                '更新名称
+                Dim DisplayName As String = JsonData("name")
+                User.DisplayName = DisplayName
+                '更新房间列表
+                If JsonData("rooms") IsNot Nothing Then
+                    User.Rooms = New List(Of RoomEntry)
+                    For Each RoomObject In JsonData("rooms")
+                        User.Rooms.Add(New RoomEntry(RoomObject("port"), RoomObject("name"), User))
+                    Next
+                End If
+                '更新 Ping
+                Dim Stage As Integer = JsonData("stage"), Unique As Long = JsonData("unique")
+                If Stage > 1 Then
+                    User.PingRecord.Enqueue((Date.Now - User.PingPending(Unique)).TotalMilliseconds / 2)
+                    If User.PingRecord.Count > 5 Then User.PingRecord.Dequeue()
+                    User.PingPending.Remove(Unique)
+                End If
+                '返回请求
+                If Stage > 0 AndAlso Stage < 3 Then RunInNewThread(Sub()
+                                                                       Try
+                                                                           SendUpdateRequest(User, Stage + 1, Unique)
+                                                                       Catch ex As Exception
+                                                                           Log(ex, "发送回程请求失败")
+                                                                       End Try
+                                                                   End Sub, "Link Update " & DisplayName)
+                '更新时间
+                User.LastReceive = Date.Now
+            Case "disconnect"
+                '断开连接
+                If Not UserList.ContainsKey(Id) Then Exit Sub
+                UserRemove(UserList(Id), ShowLeaveMessage:=JsonData("message") Is Nothing)
+                If JsonData("message") IsNot Nothing Then Hint(JsonData("message").ToString, If(JsonData("isError").ToObject(Of Boolean), HintType.Critical, HintType.Info))
+            Case Else
+                Throw New Exception("未知的操作种类：" & Type)
+        End Select
+    End Sub
+    ''' <summary>
+    ''' 从用户列表中移除一位用户。提示信息视作该用户主动离开。
+    ''' </summary>
+    Public Shared Sub UserRemove(User As LinkUserIoi, ShowLeaveMessage As Boolean)
+        If Not UserList.ContainsKey(User.Id) Then Exit Sub
+        If ShowLeaveMessage Then Hint(User.DisplayName & " 已离开！")
+        NetRequestOnce("http://127.0.0.1:55555/api/link?id=" & User.Id & "&password=" & IoiPassword, "DELETE", "", "", 500)
+        User.Dispose()
+    End Sub
+
+    '关闭联机模块按钮
+    Private Shared Sub ModuleStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) Handles InitLoader.OnStateChangedUi
+        If FrmLinkLeft IsNot Nothing Then CType(FrmLinkLeft.ItemIoi.Buttons(0), MyIconButton).Visibility = If(NewState = LoadState.Finished, Visibility.Visible, Visibility.Collapsed)
+    End Sub
+    Public Shared Sub ModuleStopManually()
+        IoiStop(False)
+        InitLoader.Error = New Exception("联机模块已关闭，点击以重新启动")
+        InitLoader.State = LoadState.Failed
+        IoiState = LoadState.Failed
+    End Sub
+
+End Class