InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

2.6.14

Browse Source
This commit is contained in:
龙腾猫跃
2024-02-22 00:04:00 +08:00
parent 63d48b09e3
commit 83ebc61d8a
37 changed files with 3234 additions and 3401 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb
-559
View File
@@ -58,307 +58,21 @@
'检查网络状态
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("PCL 的联机服务由速聚授权提供。" & 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("$PCL 没法连上网……" & vbCrLf & "如果你改变了网络环境，请重启 PCL。")
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 = GetFileSHA1(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 = GetFileSHA1(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 = GetFileSHA1(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)
@@ -389,40 +103,6 @@ FinishMcbFileCheck:
''' </summary>
Public Shared Function HiperStop(SleepWhenKilled As Boolean) As Boolean
Return False
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。
@@ -430,125 +110,10 @@ FinishMcbFileCheck:
''' 若程序正在运行，则会先停止其运行。
''' </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 ""PCL 联机房间"""
}
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
@@ -643,42 +208,6 @@ FinishMcbFileCheck:
'每 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
@@ -711,14 +240,6 @@ FinishMcbFileCheck:
'创建房间
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)
'记录信息
@@ -730,34 +251,6 @@ FinishMcbFileCheck:
'加入房间
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("你的 PCL 版本与房主的 PCL 版本不一致！", HintType.Critical) : Exit Sub
' Hint("你输入的联机码无效！", HintType.Critical)
End Sub
Private Sub RoomJoin(Ip As String, Port As Integer)
'记录信息
@@ -773,54 +266,6 @@ FinishMcbFileCheck:
'承接状态切换的 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)
@@ -888,10 +333,6 @@ FinishMcbFileCheck:
'复制联机码
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 房主