© 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