| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952 |
- 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 GetExceptionSummary(ex).Contains("(404)") Then
- Throw New CertOutdatedException '索引码无效或已过期
- ElseIf GetExceptionSummary(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 & "失败:" & GetExceptionSummary(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
|