由于联机已被禁用,公开联机部分代码
This commit is contained in:
@@ -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
|
||||
# 不公开底层函数库,以免抄袭
|
||||
|
||||
@@ -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
|
||||
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user