| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395 |
- 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
- FormMain.EndProgramForce(Result.Aborted)
- 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))
- End Sub
- Private Shared Sub InitIpCheck()
- 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))
- End Sub
- '获取所需文件
- Private Shared Sub InitGetFile(Task As LoaderTask(Of Integer, List(Of NetFile)))
- End Sub
- Public Class CertOutdatedException
- Inherits Exception
- End Class
- '启动联机模块
- Private Shared Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
- 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
- Return False
- End Function
- ''' <summary>
- ''' 启动程序,并等待初始化完成后退出运行,同时更新 HiperIp。
- ''' 若启动失败,则会直接抛出异常。
- ''' 若程序正在运行,则会先停止其运行。
- ''' </summary>
- Public Shared Sub HiperStart(Task As LoaderTask(Of Integer, Integer))
- End Sub
- 'Hiper 日志
- Private Shared Sub HiperLogLine(Content As String, Task As LoaderTask(Of Integer, Integer))
- 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()
- 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_KeyDown(sender As Object, e As KeyEventArgs) Handles TextCert.KeyDown
- 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
- 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
- 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)
- 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
- 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
|