PageLinkHiper.xaml.vb 49 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954
  1. Public Class PageLinkHiper
  2. Public Const RequestVersion As Char = "2"
  3. '记录的启动情况
  4. Public Shared IsServerSide As Boolean
  5. Private Shared HostIp As String
  6. Private Shared HostPort As Integer
  7. #Region "初始化"
  8. '加载器初始化
  9. Private Sub LoaderInit() Handles Me.Initialized
  10. PageLoaderInit(Load, PanLoad, PanContent, PanAlways, InitLoader, AutoRun:=False)
  11. '注册自定义的 OnStateChanged
  12. AddHandler InitLoader.OnStateChangedUi, AddressOf OnLoadStateChanged
  13. End Sub
  14. Private IsLoad As Boolean = False
  15. Private Sub OnLoaded() Handles Me.Loaded
  16. FormMain.EndProgramForce(Result.Aborted)
  17. If IsLoad Then Exit Sub
  18. IsLoad = True
  19. '启动监视线程
  20. If Not IsWatcherStarted Then RunInNewThread(AddressOf WatcherThread, "Hiper Watcher")
  21. '读取索引码
  22. Try
  23. Dim Time As String = Setup.Get("LinkHiperCertTime")
  24. If Time = "" Then
  25. Log("[HiPer] 没有缓存凭证")
  26. ElseIf Date.Parse(Time) > Date.Now Then
  27. TextCert.Text = Setup.Get("LinkHiperCertLast")
  28. Log("[HiPer] 缓存凭证尚未过期:" & Time)
  29. CurrentSubpage = Subpages.PanSelect
  30. Else
  31. Log("[HiPer] 缓存凭证已过期:" & Time)
  32. LabCertTitle.Text = "输入索引码"
  33. LabCertDesc.Text = "你的 HiPer 索引码已经过期,请输入新的索引码。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
  34. End If
  35. Catch ex As Exception
  36. Log(ex, "读取缓存凭证失败")
  37. Setup.Set("LinkHiperCertTime", "")
  38. End Try
  39. End Sub
  40. #End Region
  41. #Region "加载步骤"
  42. Public Shared PathHiper As String = PathAppdata & "联机模块\"
  43. Public Shared WithEvents InitLoader As New LoaderCombo(Of Integer)("HiPer 初始化", {
  44. New LoaderTask(Of Integer, Integer)("网络环境:连通检测", AddressOf InitPingCheck) With {.Block = False, .ProgressWeight = 0.5},
  45. New LoaderTask(Of Integer, Integer)("网络环境:IP 检测", AddressOf InitIpCheck) With {.Block = False, .ProgressWeight = 1},
  46. New LoaderTask(Of Integer, Integer)("检查网络环境", AddressOf InitCheck) With {.ProgressWeight = 0.5},
  47. New LoaderTask(Of Integer, List(Of NetFile))("获取所需文件", AddressOf InitGetFile) With {.ProgressWeight = 4},
  48. New LoaderDownload("下载所需文件", New List(Of NetFile)) With {.ProgressWeight = 4},
  49. New LoaderTask(Of Integer, Integer)("启动联机模块", AddressOf InitLaunch) With {.ProgressWeight = 7}
  50. })
  51. '检查网络状态
  52. Private Shared Sub InitPingCheck(Task As LoaderTask(Of Integer, Integer))
  53. PingTime = 0
  54. Try
  55. Log("[HiPer] 网络检测:连通检测开始")
  56. Dim StartTime = Date.Now.Ticks
  57. Dim Result As String = NetGetCodeByClient("https://www.baidu.com/duty/", Encoding.UTF8, 20000, "")
  58. Dim DuringTime As Integer = (Date.Now.Ticks - StartTime) / 10000
  59. If Result.Contains("百度") Then
  60. Log("[HiPer] 网络检测:连通检测成功(" & DuringTime & "ms)")
  61. PingTime = DuringTime
  62. Else
  63. Log("[HiPer] 网络检测:连通检测失败(获取的内容有误)")
  64. PingTime = -1
  65. End If
  66. Catch ex As ThreadInterruptedException
  67. Catch ex As Exception
  68. Log(ex, "连通检测失败")
  69. PingTime = -1
  70. End Try
  71. End Sub
  72. Private Shared Sub InitIpCheck()
  73. IpCheckStatus = LoadState.Loading
  74. Try
  75. Log("[HiPer] 网络检测:IP 地址检测开始")
  76. Dim IpCheckResult As String = NetRequestOnce("https://ipinfo.io/json", "GET", "", "application/json", 10000)
  77. Dim Country As String = GetJson(IpCheckResult)("country")
  78. IpIsInChina = Country = "CN"
  79. IpCheckStatus = LoadState.Finished
  80. Log("[HiPer] 网络检测:IP 地址检测结果:" & Country)
  81. Catch ex As ThreadInterruptedException
  82. IpCheckStatus = LoadState.Aborted
  83. Catch ex As Exception
  84. Log(ex, "IP 地址检测失败")
  85. IpCheckStatus = LoadState.Failed
  86. IpIsInChina = True
  87. End Try
  88. End Sub
  89. Private Shared PingTime As Integer, IpCheckStatus As LoadState = LoadState.Loading, IpIsInChina As Boolean
  90. Private Shared Sub InitCheck(Task As LoaderTask(Of Integer, Integer))
  91. '检查协议
  92. If Not Setup.Get("LinkEula") Then
  93. Reopen:
  94. Select Case MyMsgBox("PCL 的联机服务由速聚授权提供。" & vbCrLf & "在使用前,你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
  95. Case 1
  96. Setup.Set("LinkEula", True)
  97. Case 2
  98. Throw New Exception("$你拒绝了用户服务协议……")
  99. Case 3
  100. 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")
  101. GoTo Reopen
  102. End Select
  103. End If
  104. '等待网络环境检查加载器结束
  105. SetLoadDesc("正在检查网络环境……", "检查网络环境")
  106. Do While Task.State = LoadState.Loading AndAlso Not (PingTime <> 0 AndAlso IpCheckStatus <> LoadState.Loading)
  107. Thread.Sleep(50)
  108. Loop
  109. '获取网络环境检查结果
  110. If IpCheckStatus = LoadState.Finished AndAlso Not IpIsInChina Then
  111. If MyMsgBox("检测到你的 IP 不在中国,这会导致联机变得非常不稳定。" & vbCrLf &
  112. "如果你正开着加速器或者 VPN,请先关闭它们,然后再继续……", "警告", "继续", "取消", IsWarn:=True, ForceWait:=True) = 2 Then
  113. Throw New Exception("$请在关闭加速器或者 VPN 后点击重试。")
  114. End If
  115. Task.Progress = 0.5
  116. InitIpCheck() '重新进行检查
  117. End If
  118. '没有联网
  119. If IpCheckStatus = LoadState.Failed AndAlso PingTime = -1 Then
  120. Throw New Exception("$PCL 没法连上网……" & vbCrLf & "如果你改变了网络环境,请重启 PCL。")
  121. End If
  122. End Sub
  123. '获取所需文件
  124. Private Shared Sub InitGetFile(Task As LoaderTask(Of Integer, List(Of NetFile)))
  125. '初始化
  126. SetLoadDesc("正在初始化……", "初始化")
  127. Directory.CreateDirectory(PathHiper)
  128. WriteFile(PathHiper & "HiPer 联机模块.vbs", "createobject(""wscript.shell"").run """"""" & PathHiper & "HiPer 联机模块.exe"""" v"", 0", Encoding:=Encoding.GetEncoding("GB18030")) '准备启动脚本
  129. '获取索引码文件
  130. SetLoadDesc("正在获取索引码文件……", "获取索引码文件")
  131. Dim Cert As String = RunInUiWait(Function() FrmLinkHiper.TextCert.Text)
  132. Log("[Hiper] 联机索引码:" & Cert)
  133. If Cert = Setup.Get("LinkHiperCertLast") AndAlso File.Exists(PathHiper & "cert.yml") Then
  134. Log("[Hiper] 索引码与上次输入的一致,跳过获取步骤")
  135. Else
  136. Dim CertRaw As String
  137. Try
  138. CertRaw = NetRequestOnce("https://cert.mcer.cn/" & Cert & ".yml", "GET", "", "")
  139. Catch ex As Exception
  140. If GetExceptionSummary(ex).Contains("(404)") Then
  141. Throw New CertOutdatedException '索引码无效或已过期
  142. ElseIf GetExceptionSummary(ex).Contains("too many requests") Then
  143. Throw New Exception("你的尝试太频繁了,请暂时啥都别点,等两分钟后再试……")
  144. Else
  145. Throw
  146. End If
  147. End Try
  148. If Not CertRaw.Contains("WARNING <<< AUTO SYNC AREA") Then Throw New Exception("获取到的索引码文件内容有误!")
  149. WriteFile(PathHiper & "cert.yml", CertRaw)
  150. Setup.Set("LinkHiperCertLast", Cert)
  151. Setup.Set("LinkHiperCertTime", "")
  152. End If
  153. Task.Progress = 0.25
  154. '获取 CPU 架构
  155. SetLoadDesc("正在获取 CPU 架构……", "获取 CPU 架构")
  156. Dim Architecture As String
  157. Select Case GetType(String).Assembly.GetName().ProcessorArchitecture
  158. Case Reflection.ProcessorArchitecture.X86
  159. Architecture = "386"
  160. Case Reflection.ProcessorArchitecture.Amd64
  161. Architecture = "amd64"
  162. Case Reflection.ProcessorArchitecture.Arm
  163. Architecture = "arm64"
  164. Case Else
  165. Architecture = "arm64"
  166. Log("[Hiper] 当前 CPU 架构为 " & GetStringFromEnum(GetType(String).Assembly.GetName().ProcessorArchitecture) & ",没有最适合的项,这可能会导致联机模块无法启动!", LogLevel.Debug)
  167. End Select
  168. Log("[Hiper] CPU 架构:" & Architecture)
  169. '检查更新:hiper.exe
  170. SetLoadDesc("正在检查联机模块本体更新……", "检查联机模块本体更新")
  171. Dim RequiredFiles As New List(Of NetFile)
  172. Dim Checksums As String = Nothing, ChecksumHiper As String = Nothing
  173. If File.Exists(PathHiper & "HiPer 联机模块.exe") Then
  174. Try
  175. Checksums = NetGetCodeByDownload({
  176. "http://mirror.hiper.cn.s2.the.bb/packages.sha1",
  177. "http://mirror.hiper.cn.s3.the.bb:175/packages.sha1",
  178. "https://gitcode.net/to/hiper/-/raw/master/packages.sha1",
  179. "https://cert.mcer.cn/mirror/packages.sha1"
  180. })
  181. Catch ex As Exception
  182. Log(ex, "获取联机模块更新信息失败,将会强制启动联机模块", LogLevel.Hint)
  183. GoTo FinishHiperFileCheck
  184. End Try
  185. ChecksumHiper = RegexSeek(Checksums, "[0-9a-f]{40}(?= windows-" & Architecture & "/hiper.exe)")
  186. If ChecksumHiper Is Nothing Then
  187. Log("[Hiper] 未找到联机模块更新信息,将会强制启动联机模块", LogLevel.Hint)
  188. GoTo FinishHiperFileCheck
  189. End If
  190. Log("[Hiper] hiper.exe 的所需 SHA1:" & ChecksumHiper)
  191. If ChecksumHiper = GetAuthSHA1(PathHiper & "HiPer 联机模块.exe") Then
  192. Log("[Hiper] hiper.exe 文件校验通过,无需重新下载")
  193. GoTo FinishHiperFileCheck
  194. End If
  195. End If
  196. Log("[Hiper] 需要重新下载 hiper.exe")
  197. RequiredFiles.Add(New NetFile({"http://mirror.hiper.cn.s2.the.bb/windows-" & Architecture & "/hiper.exe",
  198. "http://mirror.hiper.cn.s3.the.bb:175/windows-" & Architecture & "/hiper.exe",
  199. "https://gitcode.net/to/hiper/-/raw/master/windows-" & Architecture & "/hiper.exe?inline=false",
  200. "https://cert.mcer.cn/mirror/windows-" & Architecture & "/hiper.exe"},
  201. PathHiper & "HiPer 联机模块.exe",
  202. New FileChecker(Hash:=ChecksumHiper, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing,所以 Checksum 可以为 Nothing
  203. FinishHiperFileCheck:
  204. Task.Progress = 0.5
  205. '检查更新:wintun.dll
  206. Dim ChecksumWintun As String = Nothing
  207. If File.Exists(PathHiper & "wintun.dll") Then
  208. Try
  209. If Checksums Is Nothing Then
  210. Checksums = NetGetCodeByDownload({
  211. "http://mirror.hiper.cn.s2.the.bb/packages.sha1",
  212. "http://mirror.hiper.cn.s3.the.bb:175/packages.sha1",
  213. "https://gitcode.net/to/hiper/-/raw/master/packages.sha1",
  214. "https://cert.mcer.cn/mirror/packages.sha1"
  215. })
  216. End If
  217. Catch ex As Exception
  218. Log(ex, "获取联机模块更新信息失败,将会强制启动联机模块", LogLevel.Hint)
  219. GoTo FinishWintunFileCheck
  220. End Try
  221. ChecksumWintun = RegexSeek(Checksums, "[0-9a-f]{40}(?= windows-" & Architecture & "/wintun.dll)")
  222. If ChecksumWintun Is Nothing Then
  223. Log("[Hiper] 未找到联机模块更新信息,将会强制启动联机模块", LogLevel.Hint)
  224. GoTo FinishWintunFileCheck
  225. End If
  226. Log("[Hiper] wintun.dll 的所需 SHA1:" & ChecksumWintun)
  227. If ChecksumWintun = GetAuthSHA1(PathHiper & "wintun.dll") Then
  228. Log("[Hiper] wintun.dll 文件校验通过,无需重新下载")
  229. GoTo FinishWintunFileCheck
  230. End If
  231. End If
  232. Log("[Hiper] 需要重新下载 wintun.dll")
  233. RequiredFiles.Add(New NetFile({"http://mirror.hiper.cn.s2.the.bb/windows-" & Architecture & "/wintun.dll",
  234. "http://mirror.hiper.cn.s3.the.bb:175/windows-" & Architecture & "/wintun.dll",
  235. "https://gitcode.net/to/hiper/-/raw/master/windows-" & Architecture & "/wintun.dll?inline=false",
  236. "https://cert.mcer.cn/mirror/windows-" & Architecture & "/wintun.dll"},
  237. PathHiper & "wintun.dll",
  238. New FileChecker(Hash:=ChecksumWintun, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing,所以 Checksum 可以为 Nothing
  239. FinishWintunFileCheck:
  240. Task.Progress = 0.75
  241. '检查更新:MCB
  242. If Not IsServerSide Then
  243. SetLoadDesc("正在检查联机模块组件更新……", "检查联机模块组件更新")
  244. Dim ChecksumMcb As String = Nothing
  245. If File.Exists(PathHiper & "MCB 联机模块.exe") Then
  246. Try
  247. Checksums = NetGetCodeByDownload({
  248. "http://mirror.hiper.cn.s2.the.bb/utils/minecraft-broadcast/packages.sha1",
  249. "http://mirror.hiper.cn.s3.the.bb:175/utils/minecraft-broadcast/packages.sha1",
  250. "https://gitcode.net/to/hiper/-/raw/master/utils/minecraft-broadcast/packages.sha1",
  251. "https://cert.mcer.cn/mirror/utils/minecraft-broadcast/packages.sha1"
  252. })
  253. Catch ex As Exception
  254. Log(ex, "获取联机模块组件更新信息失败,将会强制启动联机模块组件", LogLevel.Hint)
  255. GoTo FinishMcbFileCheck
  256. End Try
  257. ChecksumMcb = RegexSeek(Checksums, "[0-9a-f]{40}(?= mcb-windows-" & Architecture & ".exe)")
  258. If ChecksumMcb Is Nothing Then
  259. Log("[Hiper] 未找到联机模块组件更新信息,将会强制启动联机模块组件", LogLevel.Hint)
  260. GoTo FinishMcbFileCheck
  261. End If
  262. Log("[Hiper] mcb.exe 的所需 SHA1:" & ChecksumMcb)
  263. If ChecksumMcb = GetAuthSHA1(PathHiper & "MCB 联机模块.exe") Then
  264. Log("[Hiper] mcb.exe 文件校验通过,无需重新下载")
  265. GoTo FinishMcbFileCheck
  266. End If
  267. End If
  268. Log("[Hiper] 需要重新下载 mcb.exe")
  269. RequiredFiles.Add(New NetFile({
  270. "http://mirror.hiper.cn.s2.the.bb/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe",
  271. "http://mirror.hiper.cn.s3.the.bb:175/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe",
  272. "https://gitcode.net/to/hiper/-/raw/master/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe?inline=false",
  273. "https://cert.mcer.cn/mirror/utils/minecraft-broadcast/mcb-windows-" & Architecture & ".exe"},
  274. PathHiper & "MCB 联机模块.exe",
  275. New FileChecker(Hash:=ChecksumMcb, MinSize:=1024 * 200))) 'Hash 的默认值即为 Nothing,所以 Checksum 可以为 Nothing
  276. FinishMcbFileCheck:
  277. End If
  278. '添加 point.yml
  279. RequiredFiles.Add(New NetFile({"https://cert.mcer.cn/point.yml"}, PathHiper & "point.yml", New FileChecker(MinSize:=200)))
  280. '开始下载
  281. SetLoadDesc("正在下载联机模块……", "下载联机模块")
  282. Task.Output = RequiredFiles
  283. End Sub
  284. Public Class CertOutdatedException
  285. Inherits Exception
  286. End Class
  287. '启动联机模块
  288. Private Shared Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
  289. '关闭运行中的 HiPer,然后再刷新凭证文件
  290. SetLoadDesc("正在关闭运行中的联机模块……", "关闭运行中的联机模块")
  291. HiperStop(True)
  292. '准备凭证文件
  293. SetLoadDesc("正在准备索引码文件……", "准备索引码文件")
  294. Dim CertFile As String = ReadFile(PathHiper & "cert.yml")
  295. '添加防火墙配置
  296. If IsServerSide Then
  297. CertFile += ("\n\ninbound:\n port: " & HostPort & "\n proto: tcp\n host: any").Replace("\n", vbCrLf)
  298. Else
  299. CertFile += ("\n\noutbound:\n port: " & HostPort & "\n proto: tcp\n host: " & HostIp).Replace("\n", vbCrLf)
  300. End If
  301. CertFile += "\nlogging:\n format: json".Replace("\n", vbCrLf)
  302. '更新 point.yml 段
  303. Const SyncAreaRegex As String = "(?<=#[ ]*WARNING >>> AUTO SYNC AREA)[\s\S]+?(?=#[ ]*WARNING <<< AUTO SYNC AREA)"
  304. CertFile = CertFile.Replace(RegexSeek(CertFile, SyncAreaRegex), RegexSeek(ReadFile(PathHiper & "point.yml"), SyncAreaRegex))
  305. WriteFile(PathHiper & "config.yml", CertFile)
  306. AllNodes = RegexSearch(CertFile.Replace(vbLf, "cr"), "(?<="")[0-9]+.[0-9]+.[0-9]+.[0-9]+(?=""( )?:( )?cr - "")").Distinct.
  307. Where(Function(l) Not (l = "6.6.1.1" OrElse l = "6.6.2.2" OrElse l = "6.6.3.3")).ToList
  308. If AllNodes.Count < 2 Then Throw New Exception("$索引码文件格式有误,未找到节点 IP!")
  309. Task.Progress = 0.05
  310. '尝试启动
  311. HiperStart(Task) '启动失败会直接抛出异常
  312. Task.Progress = 0.2
  313. '检查连接情况
  314. SetLoadDesc("正在连接到联机节点 (1/2)……" & If(IpIsInChina, "", vbCrLf & "由于网络不在中国,可能要花费很长时间。"), "检查联机节点")
  315. If Not IsServerSide AndAlso HostIp = HiperIp Then Throw New Exception("$还搁这自己连自己?!不是吧?!")
  316. Dim PingNodeResults As New List(Of Integer)
  317. Dim UnpingedNodes As New List(Of String)(AllNodes)
  318. Do Until PingNodeResults.Count >= 2 OrElse Task.IsAborted
  319. Dim SelectedNode = RandomOne(UnpingedNodes)
  320. Dim PingNode = Ping(SelectedNode, 4000)
  321. If PingNode = -1 Then
  322. Task.Progress += (If(PingNodeResults.Count = 0, 0.58, 0.88) - Task.Progress) * 0.3
  323. Else
  324. SetLoadDesc("正在连接到联机节点 (2/2)……" & If(IpIsInChina, "", vbCrLf & "由于网络不在中国,可能要花费很长时间。"), "检查联机节点")
  325. Task.Progress = 0.6
  326. PingNodeResults.Add(PingNode)
  327. UnpingedNodes.Remove(SelectedNode)
  328. End If
  329. Loop
  330. PingNodes = PingNodeResults.Min
  331. Task.Progress = 0.9
  332. '与房主 Ping 一下看看
  333. If Not IsServerSide Then
  334. SetLoadDesc("正在连接到房主……", "检查房主")
  335. HostPing = -1 '实际上不使用本次 Ping 的结果,因为它真的偏大……
  336. Do
  337. Dim PingHost = Ping(HostIp, 4000, False)
  338. If PingHost = -1 Then
  339. Thread.Sleep(500)
  340. Else
  341. Exit Do
  342. End If
  343. Loop Until Task.IsAborted
  344. '在等待 2 秒后再次触发 Ping,以刷新显示的 Ping
  345. RunInNewThread(Sub()
  346. Thread.Sleep(2000)
  347. TaskPingHost.Start(True, IsForceRestart:=True)
  348. End Sub, "HiPer Delayed Ping")
  349. End If
  350. '刷新完成页面
  351. SetLoadDesc("正在加载完成页面……", "加载完成页面")
  352. RunInUiWait(AddressOf FrmLinkHiper.WatcherTimer1)
  353. End Sub
  354. Private Shared PingNodes As Integer, AllNodes As List(Of String)
  355. #End Region
  356. #Region "进程管理"
  357. Private Shared _HiperState As LoadState = LoadState.Waiting
  358. Public Shared Property HiperState As LoadState
  359. Get
  360. Return _HiperState
  361. End Get
  362. Set(value As LoadState)
  363. _HiperState = value
  364. 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))
  365. End Set
  366. End Property
  367. Public Shared Sub ModuleStopManually() '关闭联机模块按钮
  368. HiperExit(False)
  369. End Sub
  370. Private Shared HiperIp As String = Nothing
  371. Private Shared HiperProcessId As Integer = -1, McbProcessId As Integer = -1
  372. Private Shared HiperCertTime As Date = Date.Now
  373. ''' <summary>
  374. ''' 若程序正在运行,则结束程序进程,同时初始化状态数据。返回是否关闭了相关进程。
  375. ''' </summary>
  376. Public Shared Function HiperStop(SleepWhenKilled As Boolean) As Boolean
  377. Return False
  378. HiperStop = False
  379. '修改凭证
  380. Dim ConfigContent As String = ReadFile(PathHiper & "config.yml")
  381. If Not ConfigContent.Contains("enable: false") Then
  382. WriteFile(PathHiper & "config.yml", ConfigContent & vbCrLf & "enable: false")
  383. End If
  384. '关闭所有进程
  385. For Each ProcessObject In Process.GetProcesses
  386. Dim IsHiper As Boolean = ProcessObject.ProcessName = "HiPer 联机模块"
  387. Dim IsMcb As Boolean = ProcessObject.ProcessName = "MCB 联机模块"
  388. If Not IsHiper AndAlso Not IsMcb Then Continue For
  389. HiperStop = True
  390. Try
  391. If IsMcb Then
  392. ProcessObject.Kill()
  393. Log("[HiPer] 已结束进程 PID " & ProcessObject.Id & ":" & ProcessObject.ProcessName)
  394. If HiperStop AndAlso SleepWhenKilled Then Thread.Sleep(1000) '等待 1 秒确认进程已退出
  395. Else 'IsHiper
  396. If SleepWhenKilled Then
  397. Thread.Sleep(4000) '等待 4 秒确认进程已退出
  398. If Not ProcessObject.HasExited Then
  399. ProcessObject.Kill()
  400. Log("[HiPer] 已结束进程 PID " & ProcessObject.Id & ":" & ProcessObject.ProcessName)
  401. End If
  402. End If
  403. End If
  404. Catch ex As Exception
  405. Log(ex, "结束进程失败(" & ProcessObject.Id & "," & ProcessObject.ProcessName & ")")
  406. End Try
  407. Next
  408. '初始化
  409. HiperState = LoadState.Waiting
  410. HiperProcessId = -1 : McbProcessId = -1
  411. HiperCertTime = Nothing
  412. End Function
  413. ''' <summary>
  414. ''' 启动程序,并等待初始化完成后退出运行,同时更新 HiperIp。
  415. ''' 若启动失败,则会直接抛出异常。
  416. ''' 若程序正在运行,则会先停止其运行。
  417. ''' </summary>
  418. Public Shared Sub HiperStart(Task As LoaderTask(Of Integer, Integer))
  419. Try
  420. SetLoadDesc("正在启动联机模块……", "启动联机模块")
  421. PossibleFailReason = Nothing
  422. '启动 Hiper
  423. Log("[Hiper] 启动 Hiper 进程")
  424. DeleteDirectory(PathHiper & "logs") '清理日志
  425. Dim HiperInfo = New ProcessStartInfo With {
  426. .FileName = "wscript",
  427. .Arguments = """" & PathHiper & "HiPer 联机模块.vbs""",
  428. .Verb = "runas" '需要管理员权限
  429. }
  430. Dim HiperVbsProcess As New Process() With {.StartInfo = HiperInfo}
  431. HiperVbsProcess.Start()
  432. '查找真正的 Hiper 进程
  433. SetLoadDesc("联机模块正在启动……", "联机模块加载")
  434. Do
  435. Dim GotProcesses = Process.GetProcesses.
  436. Where(Function(l) l.ProcessName = "HiPer 联机模块" AndAlso Math.Abs((l.StartTime - Date.Now).TotalMinutes) < 1)
  437. If GotProcesses.Count > 0 Then
  438. HiperProcessId = GotProcesses.First.Id
  439. Log("[Hiper] 已发现 Hiper 进程,PID:" & HiperProcessId)
  440. Exit Do
  441. End If
  442. Thread.Sleep(50)
  443. Loop While Task.State = LoadState.Loading AndAlso Not Task.IsAborted
  444. If HiperProcessId = -1 Then Throw New Exception("联机模块未能成功启动!")
  445. HiperState = LoadState.Loading
  446. Task.Progress = 0.15
  447. '抓取日志
  448. Dim LogLine As Integer = 0
  449. Do
  450. Thread.Sleep(100)
  451. If Not File.Exists(PathHiper & "logs\hiper.log") Then Continue Do
  452. Dim LogLines As String() = ReadFile(PathHiper & "logs\hiper.log").TrimEnd(vbLf).Split(vbLf)
  453. For i = LogLine To LogLines.Count - 1
  454. HiperLogLine(LogLines(i), Task)
  455. Next
  456. LogLine = LogLines.Count
  457. Loop While HiperState = LoadState.Loading AndAlso Not Task.IsAborted AndAlso Process.GetProcesses.Any(Function(l) l.Id = HiperProcessId)
  458. '输出
  459. If HiperState = LoadState.Finished Then
  460. Log("[Hiper] Hiper 启动完成")
  461. ElseIf PossibleFailReason IsNot Nothing AndAlso PossibleFailReason.Contains("索引码已过期") Then
  462. Throw New CertOutdatedException()
  463. Else
  464. Throw New Exception(If(PossibleFailReason, "联机模块因未知原因启动失败!"))
  465. End If
  466. '启动 MCB
  467. Task.Progress = 0.25
  468. If Not IsServerSide Then
  469. Try
  470. Log("[Hiper] 启动 MCB 进程")
  471. Dim McbInfo = New ProcessStartInfo With {
  472. .FileName = PathHiper & "MCB 联机模块.exe", .WorkingDirectory = PathHiper,
  473. .UseShellExecute = False, .CreateNoWindow = True,
  474. .RedirectStandardError = True, .RedirectStandardOutput = True,
  475. .Arguments = "-addr " & HostIp & ":" & HostPort & " -motd ""PCL 联机房间"""
  476. }
  477. Dim McbProcess As New Process() With {.StartInfo = McbInfo}
  478. McbProcess.Start()
  479. McbProcessId = McbProcess.Id
  480. Catch ex As Exception
  481. Throw New Exception("联机模块组件启动失败", ex)
  482. End Try
  483. End If
  484. Catch ex As Exception
  485. Try
  486. HiperStop(True) '由于启动失败停止进程
  487. Catch
  488. End Try
  489. HiperState = LoadState.Failed
  490. Throw
  491. End Try
  492. End Sub
  493. 'Hiper 日志
  494. Private Shared Sub HiperLogLine(Content As String, Task As LoaderTask(Of Integer, Integer))
  495. '检查报错
  496. Dim ContentTest As String = Content.ToLower
  497. Dim ErrorMessage As String = Nothing
  498. Dim ContentJson As JObject = Nothing
  499. If Content.StartsWith("{""") AndAlso Content.EndsWith("}") Then
  500. ContentJson = GetJson(Content)
  501. ContentTest = If(ContentJson("error"), ContentJson("msg")).ToString.ToLower
  502. ErrorMessage = ContentJson("error")
  503. End If
  504. If ContentTest.Contains("hiper certificate for this host is expired") Then
  505. PossibleFailReason = "$你的索引码已过期,请更换新的索引码!"
  506. ElseIf ContentTest.Contains("error creating interface: access is denied") Then
  507. PossibleFailReason = "$没有获得管理员权限,无法创建网络通道!"
  508. ElseIf ContentTest.Contains("cannot create a file when that file already exists") Then
  509. PossibleFailReason = "$请不要重复开启多个联机模块!"
  510. ElseIf Content.Contains("failed to load config") Then
  511. PossibleFailReason = "$索引码文件内容存在错误!"
  512. ElseIf Content.Contains("system cannot find the file specified") Then
  513. PossibleFailReason = "$创建网络通道失败!" & vbCrLf & "如果你曾启动过 VPN 软件,请先打开那个软件,然后关掉它,最后再重试。虽然不知道为啥,但这样大概管用……"
  514. End If
  515. If PossibleFailReason Is Nothing AndAlso ErrorMessage IsNot Nothing Then PossibleFailReason = ErrorMessage
  516. '检查结束
  517. If ContentJson IsNot Nothing Then
  518. Dim Message As String = ContentJson("msg")
  519. If Message = "HiPer interface is active" Then
  520. HiperIp = ContentJson("network").ToString.Split("/").First
  521. If IsServerSide Then HostIp = HiperIp
  522. Log("[Hiper] Hiper 启动完成,IP:" & HiperIp)
  523. HiperState = LoadState.Finished
  524. ElseIf Message = "Validity of client certificate" Then
  525. Dim VaildTime As String = ContentJson("valid")
  526. Date.TryParseExact(VaildTime, "yyyy-MM-dd HH:mm:ss", Globalization.CultureInfo.InvariantCulture, Globalization.DateTimeStyles.None, HiperCertTime)
  527. Log("[Hiper] 索引码到期时间:" & HiperCertTime.ToString)
  528. Setup.Set("LinkHiperCertTime", HiperCertTime.ToString)
  529. End If
  530. End If
  531. '写入日志
  532. If ModeDebug OrElse Content.Contains("""error""") Then Log("[Hiper] " & Content)
  533. End Sub
  534. Private Shared PossibleFailReason As String = Nothing
  535. #End Region
  536. #Region "监视线程"
  537. '主 Timer 线程
  538. Private IsWatcherStarted As Boolean = False
  539. Private Sub WatcherThread()
  540. Dim Sec15 As Integer = 0
  541. Do While True
  542. Try
  543. For i = 1 To 5
  544. Thread.Sleep(200)
  545. If InitLoader.State = LoadState.Loading Then
  546. RunInUi(AddressOf UpdateProgress)
  547. End If
  548. Next
  549. Thread.Sleep(1000)
  550. Sec15 += 1
  551. WatcherTimer1()
  552. If Sec15 = 15 Then
  553. Sec15 = 0
  554. WatcherTimer15()
  555. End If
  556. Catch ex As Exception
  557. Log(ex, "联机模块主时钟出错", LogLevel.Feedback)
  558. Thread.Sleep(20000)
  559. End Try
  560. Loop
  561. End Sub
  562. '每 1 秒执行的 Timer
  563. Private Sub WatcherTimer1()
  564. If HiperState <> LoadState.Finished Then Exit Sub
  565. RunInUi(Sub()
  566. '索引码剩余时间
  567. Dim Span As TimeSpan = HiperCertTime - Date.Now
  568. If Span.TotalDays >= 30 Then
  569. LabFinishTime.Text = "> 30 天"
  570. ElseIf Span.TotalDays >= 4 Then
  571. LabFinishTime.Text = Span.Days & " 天"
  572. ElseIf Span.TotalDays >= 1 Then
  573. LabFinishTime.Text = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
  574. ElseIf Span.TotalMinutes >= 10 Then
  575. LabFinishTime.Text = Span.Hours & ":" & Span.Minutes.ToString.PadLeft(2, "0") & "'"
  576. Else
  577. LabFinishTime.Text = Span.Minutes & "'" & Span.Seconds.ToString.PadLeft(2, "0") & """"
  578. End If
  579. '提示索引码即将到期
  580. If Span.TotalSeconds <= 5 * 60 AndAlso Span.TotalSeconds > 5 * 60 - 1 AndAlso Setup.Get("LinkHiperCertWarn") Then
  581. MyMsgBox("你的索引码还有不到 5 分钟就要过期了!" & vbCrLf & "你可以在设置中关闭这个提示……", "索引码即将过期", "我知道了……")
  582. ShowWindowToTop(Handle)
  583. Beep()
  584. End If
  585. '检查索引码到期
  586. If Span.TotalSeconds < 2 Then
  587. LabCertTitle.Text = "索引码已过期"
  588. LabCertDesc.Text = "你的 HiPer 索引码已经过期,请输入新的索引码。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
  589. TextCert.Text = ""
  590. HiperExit(True)
  591. ShowWindowToTop(Handle)
  592. Beep()
  593. Exit Sub
  594. End If
  595. '网络质量
  596. Dim QualityScore As Integer = If(IpIsInChina, 0, -2)
  597. QualityScore -= Math.Ceiling((Math.Min(PingTime, 600) + Math.Min(PingNodes, 600)) / 80)
  598. Select Case QualityScore
  599. Case Is >= -1
  600. LabFinishQuality.Text = "优秀"
  601. Case Is >= -2
  602. LabFinishQuality.Text = "优良"
  603. Case Is >= -3
  604. LabFinishQuality.Text = "良好"
  605. Case Is >= -5
  606. LabFinishQuality.Text = "一般"
  607. Case Is >= -7
  608. LabFinishQuality.Text = "较差"
  609. Case Else
  610. LabFinishQuality.Text = "很差"
  611. End Select
  612. 'Ping
  613. If HostPing <> -1 Then
  614. If FrmLinkHiper IsNot Nothing AndAlso FrmLinkHiper.LabFinishPing.IsLoaded Then
  615. FrmLinkHiper.LabFinishPing.Text = HostPing & "ms"
  616. End If
  617. End If
  618. End Sub)
  619. End Sub
  620. '每 15 秒执行的 Timer
  621. Private Shared HostPing As Integer = -1
  622. Private Sub WatcherTimer15()
  623. If Not (HiperState = LoadState.Finished OrElse HiperState = LoadState.Loading) Then Exit Sub
  624. '检查 HiPer 崩溃
  625. Try
  626. Process.GetProcessById(HiperProcessId)
  627. Catch
  628. Dim LogLines = ReadFile(PathHiper & "logs\hiper.log").TrimEnd(vbLf).Split(vbLf)
  629. HiperExit(False)
  630. MyMsgBox("由于联机模块异常退出,已退出联机房间。" & vbCrLf & vbCrLf &
  631. "联机模块最后的日志:" & vbCrLf & Join(LogLines.Skip(LogLines.Count - 3).ToList, vbCrLf), "联机断开")
  632. End Try
  633. '下面的部分需要完全完成加载
  634. If HiperState <> LoadState.Finished Then Exit Sub
  635. '检查 MCB 崩溃
  636. Try
  637. If Not IsServerSide Then Process.GetProcessById(McbProcessId)
  638. Catch
  639. HiperExit(False)
  640. MyMsgBox("由于 MCB 联机模块异常退出,已退出联机房间。", "联机断开")
  641. End Try
  642. '重新检查 Ping
  643. If Not IsServerSide Then
  644. Dim PingHostFailedCount As Integer = 0
  645. Do
  646. TaskPingHost.WaitForExit(True, IsForceRestart:=True)
  647. If TaskPingHost.Output = -1 Then
  648. PingHostFailedCount += 1
  649. Log("[HiPer] Ping 房主失败(第 " & PingHostFailedCount & " 次)")
  650. If PingHostFailedCount >= 3 Then
  651. HiperExit(False) : MyMsgBox("与房主断开连接,已退出联机房间。", "联机断开") : Exit Sub
  652. End If
  653. Else
  654. If PingHostFailedCount > 0 Then Log("[HiPer] Ping 房主已恢复成功(" & HostPing & "ms)")
  655. Exit Do
  656. End If
  657. Loop While True
  658. End If
  659. End Sub
  660. #End Region
  661. #Region "PanCert | 索引码输入页面"
  662. '检测输入
  663. Private Sub TextCert_ValidateChanged(sender As Object, e As EventArgs) Handles TextCert.ValidateChanged
  664. BtnCertDone.IsEnabled = TextCert.ValidateResult = ""
  665. End Sub
  666. Private Sub TextCert_KeyDown(sender As Object, e As KeyEventArgs) Handles TextCert.KeyDown
  667. If e.Key = Key.Enter AndAlso BtnCertDone.IsEnabled Then BtnCertDone_Click() '允许回车确认
  668. End Sub
  669. '确认
  670. Private Sub BtnCertDone_Click() Handles BtnCertDone.Click
  671. CurrentSubpage = Subpages.PanSelect
  672. End Sub
  673. #End Region
  674. #Region "PanSelect | 种类选择页面"
  675. '返回
  676. Private Sub BtnSelectReturn_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectReturn.MouseLeftButtonUp
  677. LabCertTitle.Text = "输入索引码"
  678. LabCertDesc.Text = "你需要获取索引码才能使用 HiPer。" & vbCrLf & "如果实在没有索引码,可以在左侧选择 IOI 方式联机。"
  679. CurrentSubpage = Subpages.PanCert
  680. End Sub
  681. '创建房间
  682. Private Sub BtnSelectCreate_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectCreate.MouseLeftButtonUp
  683. ''获取端口号
  684. 'Dim PortInput As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {
  685. ' New ValidateInteger(2, 65535),
  686. ' New ValidateExceptSame({"55555", "55557"}, "端口不能为 %!")
  687. ' }, "在 MC 的暂停画面选择【对局域网开放】", "输入端口号", "确定", "取消")
  688. 'If PortInput Is Nothing Then Exit Sub
  689. ''开始
  690. 'RoomCreate(Val(PortInput))
  691. End Sub
  692. Private Sub RoomCreate(Port As Integer)
  693. '记录信息
  694. HostIp = Nothing : HostPort = Port
  695. IsServerSide = True
  696. '启动
  697. InitLoader.Start(IsForceRestart:=True)
  698. End Sub
  699. '加入房间
  700. Private Sub BtnSelectJoin_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnSelectJoin.MouseLeftButtonUp
  701. ' '获取信息
  702. ' Dim Code As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateLength(8, 99)}, "",
  703. ' "输入联机码", "确定", "取消")
  704. ' If Code Is Nothing Then Exit Sub
  705. ' '记录信息
  706. ' If Not Code.EndsWith(RequestVersion) OrElse Not Code.StartsWith("P") Then GoTo WrongCode
  707. ' Dim Ip As String, Port As Integer
  708. ' Try
  709. ' Dim IpAndPort As Long = RadixConvert(Code.Substring(1, Code.Length - 2).ToUpper, 36, 10)
  710. ' 'IpAndPort = HostPort + IpParts(0) * 65536 + IpParts(1) * 65536 * 256 + IpParts(2) * 65536 * 256 * 256 + IpParts(3) * 65536 * 256 * 256 * 256
  711. ' Ip = Math.Floor(IpAndPort / (65536L * 256 * 256 * 256))
  712. ' IpAndPort = IpAndPort Mod (65536L * 256 * 256 * 256)
  713. ' Ip = Math.Floor(IpAndPort / (65536L * 256 * 256)) & "." & Ip
  714. ' IpAndPort = IpAndPort Mod (65536L * 256 * 256)
  715. ' Ip = Math.Floor(IpAndPort / (65536L * 256)) & "." & Ip
  716. ' IpAndPort = IpAndPort Mod (65536L * 256)
  717. ' Ip = Math.Floor(IpAndPort / (65536L)) & "." & Ip
  718. ' Port = IpAndPort Mod 65536
  719. ' Catch
  720. ' GoTo WrongCode
  721. ' End Try
  722. ' '启动
  723. ' RoomJoin(Ip, Port)
  724. ' Exit Sub
  725. 'WrongCode:
  726. ' If Not Code.StartsWith("P") AndAlso Code.Length >= 49 Then Hint("你输入的可能是 IOI 的联机码,请在左侧的联机方式中选择 IOI!", HintType.Critical) : Exit Sub
  727. ' If Code.StartsWith("P") AndAlso Not Code.EndsWith(RequestVersion) Then Hint("你的 PCL 版本与房主的 PCL 版本不一致!", HintType.Critical) : Exit Sub
  728. ' Hint("你输入的联机码无效!", HintType.Critical)
  729. End Sub
  730. Private Sub RoomJoin(Ip As String, Port As Integer)
  731. '记录信息
  732. HostIp = Ip : HostPort = Port
  733. IsServerSide = False
  734. '启动
  735. InitLoader.Start(IsForceRestart:=True)
  736. End Sub
  737. #End Region
  738. #Region "PanLoad | 加载中页面"
  739. '承接状态切换的 UI 改变
  740. Private Sub OnLoadStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState)
  741. Select Case NewState
  742. Case LoadState.Loading
  743. UpdateProgress(0)
  744. If IsServerSide Then
  745. LabLoadTitle.Text = "正在创建联机房间"
  746. Log("[Hiper] 正在创建联机房间,端口 " & HostPort)
  747. Else
  748. LabLoadTitle.Text = "正在加入联机房间"
  749. Log("[Hiper] 正在加入联机房间,目标 IP " & HostIp & ":" & HostPort)
  750. End If
  751. LabLoadDesc.Text = "正在初始化……"
  752. LoadStep = "准备初始化"
  753. Case LoadState.Failed
  754. UpdateProgress(1)
  755. If IsServerSide Then
  756. LabLoadTitle.Text = "创建联机房间失败"
  757. Else
  758. LabLoadTitle.Text = "加入联机房间失败"
  759. End If
  760. Dim RealException As Exception = If(Loader.Error.InnerException, Loader.Error)
  761. If TypeOf RealException Is CertOutdatedException Then
  762. LabCertTitle.Text = "索引码无效"
  763. LabCertDesc.Text = "你的 HiPer 索引码无效或者已经过期!" & vbCrLf & "请重新输入索引码。"
  764. HiperExit(True)
  765. ElseIf RealException.Message.StartsWith("$") Then
  766. LabLoadDesc.Text = RealException.Message.TrimStart("$") & vbCrLf &
  767. "点击镐子重试,或者点击灰色的 × 取消。"
  768. Else
  769. LabLoadDesc.Text = LoadStep & "失败:" & GetExceptionSummary(RealException) & vbCrLf &
  770. "点击镐子重试,或者点击灰色的 × 取消。"
  771. End If
  772. Log(Loader.Error, "HiPer 联机尝试失败")
  773. Case LoadState.Finished
  774. UpdateProgress(1)
  775. CurrentSubpage = Subpages.PanFinish
  776. BtnFinishPing.Visibility = If(IsServerSide, Visibility.Collapsed, Visibility.Visible)
  777. LineFinishPing.Visibility = If(IsServerSide, Visibility.Collapsed, Visibility.Visible)
  778. BtnFinishCopy.Visibility = If(IsServerSide, Visibility.Visible, Visibility.Collapsed)
  779. If IsServerSide Then
  780. LabFinishTitle.Text = "已创建联机房间"
  781. LabFinishDesc.Text = "已在端口 " & HostPort & " 创建了联机房间。" & vbCrLf & "点击下方的复制联机码按钮,然后把联机码发给朋友吧!"
  782. Else
  783. LabFinishTitle.Text = "已加入联机房间"
  784. LabFinishDesc.Text = "启动游戏,进入多人游戏页面后稍等片刻,房间就会出现在服务器列表的最下方。" & vbCrLf & "如果提示无效会话,不要退出联机房间,重新启动游戏即可!"
  785. End If
  786. LabFinishIp.Text = HostIp & ":" & HostPort
  787. Log("[Hiper] 已完成连接")
  788. End Select
  789. End Sub
  790. Private Shared LoadStep As String = "准备初始化"
  791. Private Shared Sub SetLoadDesc(Intro As String, [Step] As String)
  792. Log("[Hiper] 连接步骤:" & Intro)
  793. LoadStep = [Step]
  794. RunInUiWait(Sub()
  795. If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.LabLoadDesc.IsLoaded Then Exit Sub
  796. FrmLinkHiper.LabLoadDesc.Text = Intro
  797. FrmLinkHiper.UpdateProgress()
  798. End Sub)
  799. End Sub
  800. '承接重试
  801. Private Sub CardLoad_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles CardLoad.MouseLeftButtonUp
  802. If Not InitLoader.State = LoadState.Failed Then Exit Sub
  803. InitLoader.Start(IsForceRestart:=True)
  804. End Sub
  805. '取消加载
  806. Private Sub CancelLoad() Handles BtnLoadCancel.Click
  807. If InitLoader.State = LoadState.Loading Then
  808. CurrentSubpage = Subpages.PanSelect
  809. InitLoader.Abort()
  810. Else
  811. InitLoader.State = LoadState.Waiting
  812. End If
  813. HiperStop(False)
  814. End Sub
  815. '进度改变
  816. Private Sub UpdateProgress(Optional Value As Double = -1)
  817. If Value = -1 Then Value = InitLoader.Progress
  818. Dim DisplayingProgress As Double = ColumnProgressA.Width.Value
  819. If Math.Round(Value - DisplayingProgress, 3) = 0 Then Exit Sub
  820. If DisplayingProgress > Value Then
  821. ColumnProgressA.Width = New GridLength(Value, GridUnitType.Star)
  822. ColumnProgressB.Width = New GridLength(1 - Value, GridUnitType.Star)
  823. AniStop("Hiper Progress")
  824. Else
  825. Dim NewProgress As Double = If(Value = 1, 1, (Value - DisplayingProgress) * 0.2 + DisplayingProgress)
  826. AniStart({
  827. AaGridLengthWidth(ColumnProgressA, NewProgress - ColumnProgressA.Width.Value, 300, Ease:=New AniEaseOutFluent),
  828. AaGridLengthWidth(ColumnProgressB, (1 - NewProgress) - ColumnProgressB.Width.Value, 300, Ease:=New AniEaseOutFluent)
  829. }, "Hiper Progress")
  830. End If
  831. End Sub
  832. Private Sub CardResized() Handles CardLoad.SizeChanged
  833. RectProgressClip.Rect = New Rect(0, 0, CardLoad.ActualWidth, 12)
  834. End Sub
  835. #End Region
  836. #Region "PanFinish | 加载完成页面"
  837. '复制 IP
  838. Private Sub BtnFinishIp_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishIp.MouseLeftButtonUp
  839. ClipboardSet(LabFinishIp.Text)
  840. End Sub
  841. '退出
  842. Private Sub BtnFinishExit_Click(sender As Object, e As EventArgs) Handles BtnFinishExit.Click
  843. If IsServerSide AndAlso MyMsgBox("你确定要关闭联机房间吗?", "确认退出", "确定", "取消", IsWarn:=True) = 2 Then Exit Sub
  844. HiperExit(False)
  845. End Sub
  846. '复制联机码
  847. Private Sub BtnFinishCopy_Click(sender As Object, e As EventArgs) Handles BtnFinishCopy.Click
  848. Dim IpParts = HostIp.Split(".").Select(Function(l) Val(l)).ToList
  849. Dim IpAndPort As Long = HostPort + IpParts(0) * 65536 + IpParts(1) * 65536 * 256 + IpParts(2) * 65536 * 256 * 256 + IpParts(3) * 65536 * 256 * 256 * 256
  850. ClipboardSet("P" & RadixConvert(IpAndPort, 10, 36) & RequestVersion, False)
  851. Hint("已复制联机码!", HintType.Finish)
  852. End Sub
  853. 'Ping 房主
  854. Private Sub BtnFinishPing_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishPing.MouseLeftButtonUp
  855. LabFinishPing.Text = "检测中"
  856. If TaskPingHost.State = LoadState.Loading Then Exit Sub
  857. TaskPingHost.Start(True, IsForceRestart:=True)
  858. End Sub
  859. Private Shared TaskPingHost As New LoaderTask(Of Boolean, Integer)("HiPer Ping Host",
  860. Sub(Task As LoaderTask(Of Boolean, Integer))
  861. HostPing = -1
  862. HostPing = Ping(HostIp, 5000, Task.Input)
  863. End Sub)
  864. #End Region
  865. #Region "子页面管理"
  866. Public Enum Subpages
  867. PanCert
  868. PanSelect
  869. PanFinish
  870. End Enum
  871. Private _CurrentSubpage As Subpages = Subpages.PanCert
  872. Public Property CurrentSubpage As Subpages
  873. Get
  874. Return _CurrentSubpage
  875. End Get
  876. Set(value As Subpages)
  877. If _CurrentSubpage = value Then Exit Property
  878. _CurrentSubpage = value
  879. Log("[Hiper] 子页面更改为 " & GetStringFromEnum(value))
  880. PageOnContentExit()
  881. If value = Subpages.PanSelect Then
  882. LabSelectCode.Text = "(" & TextCert.Text.Substring(0, Math.Min(TextCert.Text.Length, 3)) & "…)"
  883. End If
  884. End Set
  885. End Property
  886. Private Sub PageLinkHiper_OnPageEnter() Handles Me.PageEnter
  887. FrmLinkHiper.PanCert.Visibility = If(CurrentSubpage = Subpages.PanCert, Visibility.Visible, Visibility.Collapsed)
  888. FrmLinkHiper.PanSelect.Visibility = If(CurrentSubpage = Subpages.PanSelect, Visibility.Visible, Visibility.Collapsed)
  889. FrmLinkHiper.PanFinish.Visibility = If(CurrentSubpage = Subpages.PanFinish, Visibility.Visible, Visibility.Collapsed)
  890. End Sub
  891. Private Shared Sub HiperExit(ExitToCertPage As Boolean)
  892. Log("[Hiper] 要求退出 Hiper(当前加载器状态为 " & GetStringFromEnum(InitLoader.State) & ")")
  893. HiperStop(False)
  894. If InitLoader.State = LoadState.Loading Then InitLoader.Abort()
  895. If InitLoader.State = LoadState.Failed Then InitLoader.State = LoadState.Waiting
  896. RunInUi(Sub()
  897. If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.IsLoaded Then Exit Sub
  898. FrmLinkHiper.CurrentSubpage = If(ExitToCertPage, Subpages.PanCert, Subpages.PanSelect)
  899. FrmLinkHiper.PageOnContentExit()
  900. End Sub)
  901. End Sub
  902. #End Region
  903. End Class