© BigSpeed Computing Inc. - Mastering algorithms
Public Class CFMain

  'Visual Basic 2005 sample of secure video chat server
  'To keep this VB.NET example simple, we are going to support
  'only the default user account (Guest)



Dim FSettings As CFSettings




  Private Function GetUsername(ByVal aHandle As Integer) As String
    GetUsername = VidSrv.GetPeerName(aHandle)
    If GetUsername = "" Then
      GetUsername = "Guest"
    End If
  End Function




  'Update the status text
  Private Sub UpdateStatus()
    If VidSrv.Running Then
      StatusBar.Panels.Item(0).Text = "Started"
      btnStart.Enabled = False
      btnStop.Enabled = True
    Else
      StatusBar.Panels.Item(0).Text = "Stopped"
      btnStart.Enabled = True
      btnStop.Enabled = False
    End If

    If lvPeers.Items.Count = 0 Then
      StatusBar.Panels.Item(1).Text = "No active connection"
    Else
      StatusBar.Panels.Item(1).Text = Str(lvPeers.Items.Count) + " connection(s)"
    End If

    btnRemove.Enabled = lvPeers.SelectedItems.Count > 0
  End Sub



  'Set the component properties
  Private Sub SetSettings()

    VidSrv.ListeningPort = Val(FSettings.txtPort.Text)

    If FSettings.radSecret.Checked Then
      VidSrv.SecurityMode = 1
    Else
      If FSettings.radPublic.Checked Then
        VidSrv.SecurityMode = 2
      Else
        VidSrv.SecurityMode = 0
      End If
    End If

    VidSrv.SecretKey = FSettings.txtSecret.Text

    VidSrv.PublicKey = FSettings.txtPublic.Text
    VidSrv.PrivateKey = FSettings.txtPrivate.Text
    VidSrv.Fingerprints = FSettings.txtFingerprints.Text

  End Sub



'Add a message to the log
Private Sub LogMsg(ByVal aText As String)
    Dim Line As String
    If txtLog.Text > "" Then
      Line = Chr(13) & Chr(10)
    Else
      Line = ""
    End If
    Line = Line & "[" & Now.ToLongTimeString & "] : "
    Line = Line & aText
    txtLog.SelectionStart = Len(txtLog.Text)
    txtLog.SelectedText = Line
End Sub




  Private Function ItemFromHandle(ByVal aHandle As Long) As ListViewItem
    'iterate on the list
    Dim i As Integer
    For i = 0 To lvPeers.Items.Count - 1
      If lvPeers.Items(i).Tag = aHandle Then
        ItemFromHandle = lvPeers.Items(i)
        Exit Function
      End If
    Next i
    ItemFromHandle = Nothing
  End Function




  'Initializations
  Private Sub CFoMain_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
    FSettings = New CFSettings   'create the settings form
    FSettings.FMain = Me
    SetSettings()
    UpdateStatus()
  End Sub




  'Start the server
  Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
    If VidSrv.Start Then
      LogMsg(("Server is started"))
    Else
      Call MsgBox("Cannot start the server!", "Error")
    End If

    UpdateStatus()
  End Sub



  'Stop the server
  Private Sub btnStop_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles btnStop.Click
    Dim i As Integer

    VidSrv.Stop()

    For i = lvPeers.Items.Count - 1 To 0 Step -1
      VidSrv.DisconnectPeer(lvPeers.Items(i).Tag)
    Next i

    UpdateStatus()
    LogMsg("Server is stopped")
  End Sub



  'Modify the settings
  Private Sub btnSettings_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles btnSettings.Click
    If FSettings.ShowDialog <> DialogResult.OK Then Exit Sub
    SetSettings()
    UpdateStatus()
  End Sub


  'Show my IP address
  Private Sub btnIP_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnIP.Click
    MsgBox(VidSrv.LocalIPList, , "My IP address")
  End Sub


  Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click
    End
  End Sub


  'Remove a peer connection
  Private Sub btnRemove_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles btnRemove.Click
    If lvPeers.SelectedItems.Count = 0 Then Exit Sub
    VidSrv.DisconnectPeer(lvPeers.SelectedItems(0).Tag)
    UpdateStatus()
  End Sub


  'Clear the log
  Private Sub btnClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClear.Click
    txtLog.Text = ""
  End Sub

  'A list view item is clicked
  Private Sub lvPeers_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lvPeers.SelectedIndexChanged
    UpdateStatus()
  End Sub



  ' *** VidSrv events ***



  'A new peer is just connected
  Private Sub VidSrv_OnPeerConnected(ByVal sender As System.Object, ByVal e As AxbsVidChatSrv.IbsVidChatSrvXEvents_OnPeerConnectedEvent) Handles VidSrv.OnPeerConnected
    Dim LI As ListViewItem

    LI = lvPeers.Items.Add("Guest")
    LI.Tag = e.aHandle
    LI.SubItems.Add(VidSrv.GetPeerAddress(e.aHandle))
    LI.SubItems.Add(Str(VidSrv.GetPeerPort(e.aHandle)))
    LI.SubItems.Add(Now.ToLongTimeString)
    LI.SubItems.Add("Connected")

    UpdateStatus()
    LogMsg(("New peer at " + LI.SubItems(1).Text + ":" + LI.SubItems(2).Text))
  End Sub



  'A connection is broken
  Private Sub VidSrv_OnPeerDisconnected(ByVal sender As System.Object, ByVal e As AxbsVidChatSrv.IbsVidChatSrvXEvents_OnPeerDisconnectedEvent) Handles VidSrv.OnPeerDisconnected
    Dim LI As ListViewItem
    LI = ItemFromHandle(e.aHandle)
    If LI Is Nothing Then Exit Sub
    LogMsg(("Disconnected " & LI.Text & " " & VidSrv.GetPeerAddress(e.aHandle) & ":" & Str(VidSrv.GetPeerPort(e.aHandle))))
    lvPeers.Items.Remove(LI)
  End Sub



  'A connection is refused
  Private Sub VidSrv_OnPeerRejected(ByVal sender As System.Object, ByVal e As AxbsVidChatSrv.IbsVidChatSrvXEvents_OnPeerRejectedEvent) Handles VidSrv.OnPeerRejected
    LogMsg(("Rejected peer from " & VidSrv.GetPeerAddress(e.aHandle) & ":" & Str(VidSrv.GetPeerPort(e.aHandle))))
  End Sub


  'A request from a new peer
  Private Sub VidSrv_OnConnectionRequest(ByVal sender As System.Object, ByVal e As AxbsVidChatSrv.IbsVidChatSrvXEvents_OnConnectionRequestEvent) Handles VidSrv.OnConnectionRequest
    If e.aUsername = "" Then
      'this is a Guest user, go ahead
      e.aAction = 1
    Else
      'Unknown user, we accept only guests
      e.aAction = 0
    End If
  End Sub



End Class
© BigSpeed Computing Inc. - Mastering algorithms