CHAT, VIDEOCONFERENCIA

 UDP Basico con Visual Basic (VB.NET)

Se trata de una pequeña aplicacion para tratar de ayudar a entender la Transmision via UDP entre dos aplicaciones Cliente- Servidor en Visual Basic.

 

Codigo:

 SERVIDOR

Form1:

Imports System.Net.Sockets
Imports System.Net
Imports System.Text.Encoding
Public Class Form1

    Dim PUERTO As Integer = 3000
    Dim RECEPTORMENSAJES As New UdpClient(PUERTO) ' MENSAJES

    Private Sub ButtonCONECTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONECTAR.Click
        Try
            RECEPTORMENSAJES.Client.Blocking = False 'SOCKET NO BLOQUEADO
            Timer1.Interval = 1000
            Timer1.Enabled = True
            ButtonCONECTAR.Visible = False
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        Try
            Dim IP As IPEndPoint = New IPEndPoint(IPAddress.Any, 0) 'RECIBIRA DESDE CUALQUIER IP, POR CUALQUIER PUERTO
            Dim RECIBEMENSAJE As Byte() = RECEPTORMENSAJES.Receive(IP) 'RECIBE EL MENSAJE EN BYTES
            LabelRECIBIDO.Text = UTF7.GetString(RECIBEMENSAJE)  'DECODIFICA EL MENSAJE A STRING
        Catch ex As Exception
            'SI HAY MENSAJE LO REGISTRA, SI NO LO HAY NO HACE NADA
        End Try
    End Sub
End Class
 

CLIENTE

Form1:

 Imports System.Net.Sockets
Imports System.Text.Encoding
Imports System.Net

Public Class Form1
    Dim ENVIANTEMENSAJES As New UdpClient() ' MENSAJES

    Private Sub BTNENVIAR_Click(sender As System.Object, e As System.EventArgs) Handles BTNENVIAR.Click
        Try
            Dim IP As IPEndPoint = New IPEndPoint(IPAddress.Parse(TextBoxIP.Text), TextBoxPUERTO.Text) 'DIRECCION RECEPTOR
            Dim FRASE As String = TextBoxMENSAJE.Text
            Dim MENSAJE As Byte() = UTF7.GetBytes(FRASE) 'CODIFICA EN BYTES
            ENVIANTEMENSAJES.Connect(IP) 'SE CONECTA CON EL RECEPTOR
            ENVIANTEMENSAJES.Send(MENSAJE, MENSAJE.Length) 'ENVIA EL MENSAJE
            TextBoxMENSAJE.Text = ""
            TextBoxMENSAJE.Focus()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try   
    End Sub
End Class

 

TCP Basico con Visual Basic (VB.NET)

Se trata de una pequeña aplicacion para tratar de ayudar a entender la Transmision via TCP entre dos aplicaciones Cliente- Servidor en Visual Basic.

 

Codigo:

SERVIDOR

Form1:

Imports System.Net.Sockets
Imports System.Text
Public Class Form1
    Dim SERVIDOR As TcpListener ' Must listen on correct port- must be same as port client wants to connect on.
    Private Sub ButtonCONECTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONECTAR.Click
        Try
            SERVIDOR = New TcpListener(8000)
            SERVIDOR.Start()
            Timer1.Interval = 2000
            Timer1.Enabled = True
            ButtonCONECTAR.Visible = False
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        Try
            Dim CLIENTE As TcpClient = SERVIDOR.AcceptTcpClient() 'Accept the pending client connection and return a TcpClient initialized for communication.
            Dim NS As NetworkStream = CLIENTE.GetStream() ' Get the stream
            Dim bytes(CLIENTE.ReceiveBufferSize) As Byte ' Read the stream into a byte array
            NS.Read(bytes, 0, CInt(CLIENTE.ReceiveBufferSize))
            Dim MENSAJE As String = Encoding.UTF7.GetString(bytes) ' Return the data received from the client
            LabelMENSAJE.Text = MENSAJE
            If LabelMENSAJE.Text <> "#CLIENTE DESCONECTADO" Then 'SI EL CLIENTE NO SE HA DESCONECTADO....
                LabelMENSAJE.Text = MENSAJE
            Else 'SI EL CLIENTE SE HA DESCONECTADO
                SERVIDOR.Stop() 'PARA EL SERVIDOR
            End If
        Catch ex As Exception 'NO HACE NADA
        End Try
    End Sub
End Class

CLIENTE

Form1:

Imports System.Net.Sockets
Imports System.Text
Public Class Form1
    Private Sub ButtonENVIAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonENVIAR.Click
        Try
            Dim CLIENTE As New System.Net.Sockets.TcpClient()
            CLIENTE.Connect(TextBoxIP.Text, TextBoxPUERTO.Text)
            Dim networkStream As NetworkStream = CLIENTE.GetStream()
            Dim sendBytes As [Byte]() = Encoding.UTF7.GetBytes("SOY W7:  " & TextBoxMENSAJE.Text)
            networkStream.Write(sendBytes, 0, sendBytes.Length)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        Try
            Dim CLIENTE As New System.Net.Sockets.TcpClient()
            CLIENTE.Connect(TextBoxIP.Text, TextBoxPUERTO.Text)
            Dim networkStream As NetworkStream = CLIENTE.GetStream()
            Dim sendBytes As [Byte]() = Encoding.UTF7.GetBytes("#CLIENTE DESCONECTADO")
            networkStream.Write(sendBytes, 0, sendBytes.Length)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
End Class

Webcam como Videocamara Remota con Visual Basic (VB.NET)

Se trata de una pequeña aplicación que permite usar la webcam de un ordenador como videocámara remota (UDP), y ver sus imágenes en otro ordenador.

Codigo:
Form1:(RECEPTOR)

Imports System.Net.Sockets
Imports System.Net
Imports System.IO
Public Class Form1
    Dim RECEPTOR As New UdpClient(2000) 'WEBCAM
    Private Sub ButtonCONECTAR_Click(sender As Object, e As EventArgs) Handles ButtonCONECTAR.Click
        ButtonCONECTAR.Visible = False
        ButtonEMISOR.Visible = False
        RECEPTOR.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
        RECEPTOR.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
        Timer1.Enabled = True
    End Sub
    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        Try
            Dim IP As IPEndPoint = New IPEndPoint(IPAddress.Any, 0) 'RECIBIRA DESDE CUALQUIER IP, POR CUALQUIER PUERTO
            Dim RECIBEMENSAJE As Byte() = RECEPTOR.Receive(IP) 'RECIBE EL MENSAJE EN BYTES
            Dim IMAGEN As New MemoryStream(RECIBEMENSAJE)
            Dim IMAGENRECIBIDA As Image = Image.FromStream(IMAGEN)
            PictureBox1.Image = IMAGENRECIBIDA
        Catch ex As Exception
        End Try
    End Sub
    Private Sub ButtonEMISOR_Click(sender As Object, e As EventArgs) Handles ButtonEMISOR.Click
        VIDEOCAMARA_EMISOR.Show()
        WindowState = FormWindowState.Minimized
    End Sub
End Class

VIDEOCAMARA EMISOR:

Imports System.Runtime.InteropServices
Imports System.Net.Sockets
Imports System.IO
Public Class VIDEOCAMARA_EMISOR
    Public Const WM_CAP As Short = &H400S
    Public Const WM_CAP_DLG_VIDEOFORMAT As Integer = WM_CAP + 41
    Public Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Public Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Public Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
    Public Const WM_CAP_SEQUENCE As Integer = WM_CAP + 62
    Public Const WM_CAP_FILE_SAVEAS As Integer = WM_CAP + 23
    Public Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
    Public Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
    Public Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
    Public Const WS_CHILD As Integer = &H40000000
    Public Const WS_VISIBLE As Integer = &H10000000
    Public Const SWP_NOMOVE As Short = &H2S
    Public Const SWP_NOSIZE As Short = 1
    Public Const SWP_NOZORDER As Short = &H4S
    Public Const HWND_BOTTOM As Short = 1
    Public Const WM_CAP_STOP As Integer = WM_CAP + 68
    Public iDevice As Integer = 0 ' Current device ID
    Public hHwnd As Integer ' Handle to preview window
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
        <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
    Public Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Integer, _
        ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
        ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
    Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
    Public Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
        (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
        ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
        ByVal nHeight As Short, ByVal hWndParent As Integer, _
        ByVal nID As Integer) As Integer
    Public Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean

    Dim DATOS As IDataObject
    Dim IMAGENCAMARA As Image

    Dim ENVIANTE As New UdpClient() 'WEBCAM

    'Open View
    Public Sub OpenPreviewWindow()

        ' Open Preview window in picturebox
        '
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
           480, PictureboxVISOR.Handle.ToInt32, 0)

        ' Connect to device
        '
        SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0)
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
            '
            'Set the preview scale

            SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)

            'Set the preview rate in milliseconds
            '
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)

            'Start previewing the image from the camera
            '
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)

            ' Resize window to fit in picturebox
            '
            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, PictureboxVISOR.Width, PictureboxVISOR.Height, _
                    SWP_NOMOVE Or SWP_NOZORDER)
            ButtonINICIAR.Visible = False
        Else
            ' Error connecting to device close window
            '
            DestroyWindow(hHwnd)

        End If
    End Sub

    Private Sub ButtonINICIAR_Click(sender As Object, e As EventArgs) Handles ButtonINICIAR.Click

        'Load And Capture Device
        OpenPreviewWindow()

    End Sub

    Private Sub ButtonENVIA_Click(sender As Object, e As EventArgs) Handles ButtonENVIA.Click
        ButtonENVIA.Visible = False
        Timer1.Enabled = True
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        ' Copy image to clipboard
        '
        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)

        ' Get image from clipboard and convert it to a bitmap
        '
        DATOS = Clipboard.GetDataObject()

        IMAGENCAMARA = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
        ENVIANTE.Connect(TextBoxIP.Text, 2000) 'SE CONECTA CON EL RECEPTOR
        Dim ARRAY As New MemoryStream()
        IMAGENCAMARA.Save(ARRAY, Imaging.ImageFormat.Jpeg)
        Dim IMAGEN_ARRAY As Byte() = ARRAY.ToArray
        ENVIANTE.Send(IMAGEN_ARRAY, IMAGEN_ARRAY.Length) 'ENVIA EL MENSAJE
    End Sub

    Private Sub VIDEOCAMARA_EMISOR_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
        Form1.Close()
    End Sub
End Class

Chat de Texto via Web con Visual Basic (VB.NET)

Se trata de una pequeña aplicación para disponer de un chat de texto a traves de una pagina web.

Codigo:

Form1

Public Class Form1

    Dim RECIBIDO As String 'VARIABLE PARA IMPEDIR

QUE EL RELOJLEE REPITA FRASES

    Private Sub ButtonCONEX_Click(sender As Object, e

As EventArgs) Handles ButtonCONEX.Click 'PONE EN

MARCHA LA APLICACION
        WebBrowserINPUT.Navigate

("http://androidvisualbasic.appspot.com/storeavalue")
        RELOJINICIO.Enabled = True
        WebBrowserOUTPUT.Navigate

("http://androidvisualbasic.appspot.com/")
        RELOJNUEVOS.Enabled = True
        ButtonENVIAR.Enabled = True
        ButtonCONEX.Enabled = False

        RichTextBox1.SelectionColor = Color.Black 'LA

FRASE ENVIADA SE VERA EN NEGRO
        RichTextBox1.SelectedText =

TextBoxUSUARIO.Text & "  CONECTADO  " & vbCrLf

        TextBoxMENSAJE.Focus()

    End Sub

    Private Sub RELOJINICIO_Tick(sender As Object, e

As EventArgs) Handles RELOJINICIO.Tick
        Try
            WebBrowserINPUT.Document.All

("tag").InnerText = TextBoxUSUARIO.Text
            WebBrowserINPUT.Document.All

("value").InnerText = """" & "ESTOY CONECTADO" &

""""""
            WebBrowserINPUT.Document.Forms

(0).InvokeMember("submit")
        Catch ex As Exception

        End Try
        RELOJINICIO.Enabled = False

    End Sub
    Private Sub RELOJNUEVOS_Tick(sender As Object, e

As EventArgs) Handles RELOJNUEVOS.Tick
        WebBrowserOUTPUT.Refresh()
        RELOJLEE.Enabled = True
    End Sub

    Private Sub RELOJLEE_Tick(sender As Object, e As

EventArgs) Handles RELOJLEE.Tick
        Dim BUSCADOR1, BUSCADOR2 As Integer
        Dim RECIBIDO1, RECIBIDO2 As String
        If WebBrowserOUTPUT.DocumentText.Contains

(TextBoxPARTNER.Text) Then

            BUSCADOR1 =

WebBrowserOUTPUT.DocumentText.IndexOf

(TextBoxPARTNER.Text)
            RECIBIDO1 =

WebBrowserOUTPUT.DocumentText.Remove(0,

BUSCADOR1 + TextBoxPARTNER.TextLength + 10)
            If RECIBIDO1.Contains("</td><td>") Then
                BUSCADOR2 = RECIBIDO1.IndexOf

("</td><td>")
                RECIBIDO2 = RECIBIDO1.Remove

(BUSCADOR2 - 1, RECIBIDO1.Length - BUSCADOR2 +

1)

                If RECIBIDO2 <> RECIBIDO Then

                    RichTextBox1.SelectionColor =

Color.Red 'LA FRASE RECIBIDA SE VERA EN ROJO
                    RichTextBox1.SelectedText =

RichTextBox1.SelectedText & TextBoxPARTNER.Text &

"  DICE:  " & RECIBIDO2 & vbCrLf
                    RECIBIDO = RECIBIDO2

                End If

            End If

        End If
    End Sub
    Private Sub ButtonENVIAR_Click(sender As Object,

e As EventArgs) Handles ButtonENVIAR.Click
        WebBrowserINPUT.Navigate

("http://androidvisualbasic.appspot.com/storeavalue")

        RELOJESCRIBE.Enabled = True
    End Sub

    Private Sub RELOJESCRIBE_Tick(sender As Object,

e As EventArgs) Handles RELOJESCRIBE.Tick
        Try
            WebBrowserINPUT.Document.All

("tag").InnerText = TextBoxUSUARIO.Text
            WebBrowserINPUT.Document.All

("value").InnerText = """" & TextBoxMENSAJE.Text &

""""
            WebBrowserINPUT.Document.Forms

(0).InvokeMember("submit")

            RichTextBox1.SelectionColor = Color.Black 'LA

FRASE ENVIADA SE VERA EN NEGRO
            RichTextBox1.SelectedText =

TextBoxUSUARIO.Text & "  DICE:  " &

TextBoxMENSAJE.Text & vbCrLf

            TextBoxMENSAJE.Text = ""
            TextBoxMENSAJE.Focus()
            RELOJESCRIBE.Enabled = False
        Catch ex As Exception

        End Try
       
    End Sub
    Private Sub ButtonDESCONEX_Click(sender As

Object, e As EventArgs) Handles

ButtonDESCONEX.Click
        WebBrowserINPUT.Navigate

("http://androidvisualbasic.appspot.com/storeavalue")
        RELOJESCRIBE.Enabled = False
        RELOJCIERRE.Enabled = True
    End Sub
    Private Sub RELOJCIERRE_Tick(sender As Object, e

As EventArgs) Handles RELOJCIERRE.Tick
        Try
            WebBrowserINPUT.Document.All

("tag").InnerText = TextBoxUSUARIO.Text
            WebBrowserINPUT.Document.All

("value").InnerText = """" & "ESTOY DESCONECTADO" &

""""
            WebBrowserINPUT.Document.Forms

(0).InvokeMember("submit")
            Close()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
  
End Class

Chat de Texto UDP con Visual Basic (VB.NET)

Se trata de una pequeña aplicación para disponer de un chat de texto con transmisión por UDP.

Codigo:

Form1

Imports System.Net.Sockets
Imports System.Text.Encoding
Imports System.Net

Public Class Form1
    Dim ENVIANTEMENSAJES As New UdpClient() ' MENSAJES
    Dim RECEPTORMENSAJES As New UdpClient(3000) ' MENSAJES

    Private Sub BTNENVIAR_Click(sender As System.Object, e As System.EventArgs) Handles BTNENVIAR.Click
        If ButtonCONECTAR.Enabled = False Then

            Dim FRASE As String = TextBoxUSUARIO.Text & "  DICE:   " & TextBoxMENSAJE.Text 'FRASE QUE SE TRANSMITE

            RichTextBox1.SelectionColor = Color.Black 'LA FRASE ENVIADA SE VERA EN NEGRO
            RichTextBox1.SelectedText = FRASE & vbCrLf

            RichTextBox1.SelectionStart = RichTextBox1.Text.Length 'AVANZA EL SCROLL
            RichTextBox1.ScrollToCaret()
            RichTextBox1.Refresh()

            Dim MENSAJE As Byte() = UTF7.GetBytes(FRASE) 'CODIFICA EN BYTES
            ENVIANTEMENSAJES.Connect(TextBoxIP.Text, 3000) 'SE CONECTA CON EL RECEPTOR
            ENVIANTEMENSAJES.Send(MENSAJE, MENSAJE.Length) 'ENVIA EL MENSAJE
            TextBoxMENSAJE.Text = ""
            TextBoxMENSAJE.Focus()
        Else
            MsgBox("NO HAS PULSADO CONECTAR")
        End If
    End Sub
    Private Sub ButtonCONECTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONECTAR.Click
        ButtonCONECTAR.Enabled = False
        TextBoxIP.ReadOnly = True
        TextBoxUSUARIO.ReadOnly = True
        RELOJRECIBIRMENSAJE.Interval = 100
        RELOJRECIBIRMENSAJE.Enabled = True
    End Sub

    Private Sub RELOJMENSAJE_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJRECIBIRMENSAJE.Tick
        Try
            Dim IP As IPEndPoint = New IPEndPoint(IPAddress.Any, 0) 'RECIBIRA DESDE CUALQUIER IP, POR CUALQUIER PUERTO
            Dim RECIBEMENSAJE As Byte() = RECEPTORMENSAJES.Receive(IP) 'RECIBE EL MENSAJE EN BYTES
            RichTextBox1.SelectionColor = Color.Red 'LA FRASE RECIBIDA SE VERA EN ROJO
            RichTextBox1.SelectedText = UTF7.GetString(RECIBEMENSAJE) & vbCrLf 'DECODIFICA EL MENSAJE A STRING

            RichTextBox1.SelectionStart = RichTextBox1.Text.Length 'AVANZA EL SCROLL
            RichTextBox1.ScrollToCaret()
            RichTextBox1.Refresh()

        Catch ex As Exception
            'SI HAY MENSAJE LO REGISTRA, SI NO LO HAY NO HACE NADA
        End Try
    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        RECEPTORMENSAJES.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
        RECEPTORMENSAJES.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
    End Sub

    Private Sub ButtonCONTACTOS_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONTACTOS.Click
        ButtonCONTACTOS.Enabled = False
        LISTA_CONTACTOS.Show()
    End Sub
End Class

LISTA DE CONTACTOS

Imports Microsoft.VisualBasic.FileIO

Public Class LISTA_CONTACTOS
    Dim DICCIONARIO As New SortedDictionary(Of String, String)
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        'CREA UN NUEVO CONTACTO Y ACTUALIZA EL FICHERO DATOS.txt Y EL LISTBOX
        Dim CONTACTO As String
        Dim IP As String
        CONTACTO = TextBox1.Text
        IP = TextBox2.Text
        My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\" & "CONTACTOS.txt", "$" & CONTACTO & "$" & IP & vbCrLf, True)
        MsgBox("SE HA CREADO EL USUARIO: " & CONTACTO & "  IP: " & IP)
        ACTUALIZAR_CONTACTOS()
        TextBox1.Text = ""
        TextBox2.Text = ""
    End Sub
    Public Sub ACTUALIZAR_CONTACTOS()

        ' VACIAMOS EL LISTBOX Y EL ARRAY DICCIONARIO
        ListBox1.Items.Clear()
        DICCIONARIO.Clear()

        ' RECORREMOS EL FICHERO CONTACTOS.txt PARA LLENAR EL LISTBOX
        Dim filename As String = Application.StartupPath & "\" & "CONTACTOS.txt"
        Dim fields As String()
        Dim delimiter As String = "$"
        Using parser As New TextFieldParser(filename)
            parser.SetDelimiters(delimiter)
            While Not parser.EndOfData
                ' Read in the fields for the current line
                fields = parser.ReadFields()
                ' Add code here to use data in fields variable.

                ListBox1.Items.Add(fields(1))

                ' CREAMOS UN ARRAY DE TIPO DICCIONARIO CON LOS VALORES QUE OBTENEMOS AL RECORRER EL ARCHIVO DE DATOS
                DICCIONARIO.Add(fields(1), fields(2))
            End While
        End Using
        'ORDENAMOS ALFABETICAMENTE EL LISTBOX
        ListBox1.Sorted = True
    End Sub

    Private Sub LISTA_CONTACTOS_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        'AL CARGAR LLENA EL LISTBOX
        ACTUALIZAR_CONTACTOS()
    End Sub
    Private Sub ListBox1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
        Dim ENUMERADOR As IDictionaryEnumerator
        ENUMERADOR = DICCIONARIO.GetEnumerator
        While ENUMERADOR.MoveNext
            If ENUMERADOR.Key = ListBox1.SelectedItem Then
                Form1.TextBoxIP.Text = ENUMERADOR.Value

            End If
        End While
       
        Close()
    End Sub
End Class

07- Chat de Video, Videoconferencia con Visual Basic (VB.NET). Voz en Tiempo Real

Se trata de una aplicación de Chat con Imagen y Sonido en tiempo real.

Codigo:

Form1

Imports System.Net
Imports System.Net.Sockets
Imports System.IO
Imports System.Threading
Imports System.Runtime.InteropServices
Imports CHAT_DE_VIDEO_Y_SONIDO.CHATVOZ

'Imports TCP_CHAT_VOZ.CHATVOZ

Public Class Form1

    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++                VIDEO                 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Public Const WM_CAP As Short = &H400S
    Public Const WM_CAP_DLG_VIDEOFORMAT As Integer = WM_CAP + 41
    Public Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Public Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Public Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
    Public Const WM_CAP_SEQUENCE As Integer = WM_CAP + 62
    Public Const WM_CAP_FILE_SAVEAS As Integer = WM_CAP + 23
    Public Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
    Public Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
    Public Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
    Public Const WS_CHILD As Integer = &H40000000
    Public Const WS_VISIBLE As Integer = &H10000000
    Public Const SWP_NOMOVE As Short = &H2S
    Public Const SWP_NOSIZE As Short = 1
    Public Const SWP_NOZORDER As Short = &H4S
    Public Const HWND_BOTTOM As Short = 1
    Public Const WM_CAP_STOP As Integer = WM_CAP + 68

    Public iDevice As Integer = 0 ' Current device ID
    Public hHwnd As Integer ' Handle to preview window

    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
        <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer

    Public Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Integer, _
        ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
        ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

    Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean

    Public Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
        (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
        ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
        ByVal nHeight As Short, ByVal hWndParent As Integer, _
        ByVal nID As Integer) As Integer

    Public Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean

    Dim DATOS As IDataObject
    Dim IMAGENCAMARA As Image
    Dim ENVIANTE As New UdpClient() 'WEBCAM
    Dim RECEPTOR As New UdpClient(2000) 'WEBCAM

    'Open View
    Public Sub OpenPreviewWindow()

        ' Open Preview window in picturebox
        '
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
           480, PictureboxVISOR.Handle.ToInt32, 0)

        ' Connect to device
        '
        SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0)
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
            '
            'Set the preview scale

            SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)

            'Set the preview rate in milliseconds
            '
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)

            'Start previewing the image from the camera
            '
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)

            ' Resize window to fit in picturebox
            '
            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, PictureboxVISOR.Width, PictureboxVISOR.Height, _
                    SWP_NOMOVE Or SWP_NOZORDER)

        Else
            ' Error connecting to device close window
            '
            DestroyWindow(hHwnd)

        End If
    End Sub
    Private Sub ButtonINICIAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonINICIAR.Click

        ButtonINICIAR.Enabled = False
        'Load And Capture Device
        OpenPreviewWindow()
    End Sub
    Private Sub ButtonCONECTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONECTAR.Click

        ButtonCONECTAR.Enabled = False
        LISTA_DE_CONTACTOS.Show()
    End Sub
    Private Sub RELOJWEBCAM_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJWEBCAM.Tick
        ' Copy image to clipboard
        '
        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)

        ' Get image from clipboard and convert it to a bitmap
        '
        DATOS = Clipboard.GetDataObject()

        IMAGENCAMARA = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
        ENVIANTE.Connect(LabelIP.Text, 2000) 'SE CONECTA CON EL RECEPTOR
        Dim ARRAY As New MemoryStream()
        IMAGENCAMARA.Save(ARRAY, Imaging.ImageFormat.Jpeg)
        Dim IMAGEN_ARRAY As Byte() = ARRAY.ToArray
        ENVIANTE.Send(IMAGEN_ARRAY, IMAGEN_ARRAY.Length) 'ENVIA EL MENSAJE

        Try
            Dim IP As IPEndPoint = New IPEndPoint(IPAddress.Any, 0) 'RECIBIRA DESDE CUALQUIER IP, POR CUALQUIER PUERTO
            Dim RECIBEMENSAJE As Byte() = RECEPTOR.Receive(IP) 'RECIBE EL MENSAJE EN BYTES

            Dim IMAGEN As New MemoryStream(RECIBEMENSAJE)
            Dim IMAGENRECIBIDA As Image = Image.FromStream(IMAGEN)
            PictureBoxRECIBIR.Image = IMAGENRECIBIDA
        Catch ex As Exception

        End Try
    End Sub
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++   AUDIO             +++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Private m_Player As WaveOutPlayer
    Private m_Recorder As WaveInRecorder
    Private m_Fifo As New FifoStream()

    Private m_PlayBuffer As Byte()
    Private m_RecBuffer As Byte()
    Private r As Socket
    Private t As Thread
    Private connected As Boolean = False
    Dim PUERTO As Integer = 9000

    Private Sub Voice_In()
        Try
            Dim br As Byte()
            r.Bind(New IPEndPoint(IPAddress.Any, PUERTO))
            While True
                br = New Byte(16383) {}
                r.Receive(br)
                m_Fifo.Write(br, 0, br.Length)
            End While
        Catch ex As Exception

        End Try

    End Sub

    Private Sub Voice_Out(data As IntPtr, size As Integer)
        'for Recorder
        If m_RecBuffer Is Nothing OrElse m_RecBuffer.Length < size Then
            m_RecBuffer = New Byte(size - 1) {}
        End If
        System.Runtime.InteropServices.Marshal.Copy(data, m_RecBuffer, 0, size)
        'Microphone ==> data ==> m_RecBuffer ==> m_Fifo
        r.SendTo(m_RecBuffer, New IPEndPoint(IPAddress.Parse(LabelIP.Text), PUERTO))
    End Sub

    Private Sub Start()
        [Stop]()
        Try
            Dim fmt As New WaveFormat(44100, 16, 2)
            m_Player = New WaveOutPlayer(-1, fmt, 16384, 3, New BufferFillEventHandler(AddressOf Filler))
            m_Recorder = New WaveInRecorder(-1, fmt, 16384, 3, New BufferDoneEventHandler(AddressOf Voice_Out))
        Catch
            [Stop]()
            Throw
        End Try
    End Sub

    Private Sub [Stop]()
        If m_Player IsNot Nothing Then
            Try
                m_Player.Dispose()
            Finally
                m_Player = Nothing
            End Try
        End If
        If m_Recorder IsNot Nothing Then
            Try
                m_Recorder.Dispose()
            Finally
                m_Recorder = Nothing
            End Try
        End If
        m_Fifo.Flush()
        ' clear all pending data
    End Sub

    Private Sub Filler(data As IntPtr, size As Integer)
        If m_PlayBuffer Is Nothing OrElse m_PlayBuffer.Length < size Then
            m_PlayBuffer = New Byte(size - 1) {}
        End If
        If m_Fifo.Length >= size Then
            m_Fifo.Read(m_PlayBuffer, 0, size)
        Else
            For i As Integer = 0 To m_PlayBuffer.Length - 1
                m_PlayBuffer(i) = 0
            Next
        End If
        System.Runtime.InteropServices.Marshal.Copy(m_PlayBuffer, 0, data, size)
        ' m_Fifo ==> m_PlayBuffer==> data ==> Speakers
    End Sub

    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ COMUN ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        RECEPTOR.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
        ' Voice Thread
        r = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
        t = New Thread(New ThreadStart(AddressOf Voice_In))
        t.IsBackground = True

    End Sub

    Private Sub ButtonCONECTARVOZ_Click(sender As Object, e As EventArgs) Handles ButtonCONECTARVOZ.Click
        ButtonDESCONECTARVOZ.Enabled = True
        ButtonCONECTARVOZ.Enabled = False
        If connected = False Then
            t.Start()
            connected = True
        End If

        Start()
    End Sub

    Private Sub ButtonDESCONECTARVOZ_Click(sender As Object, e As EventArgs) Handles ButtonDESCONECTARVOZ.Click
        ButtonCONECTARVOZ.Enabled = True
        ButtonDESCONECTARVOZ.Enabled = False
        [Stop]()
    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing

        [Stop]()
        Application.Exit()
    End Sub
End Class

Lista de Contactos

Imports Microsoft.VisualBasic.FileIO
Imports System.Net.Sockets

Public Class LISTA_DE_CONTACTOS

    Dim DICCIONARIO As New SortedDictionary(Of String, String)

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        'CREA UN NUEVO CONTACTO Y ACTUALIZA EL FICHERO DATOS.txt Y EL LISTBOX
        Dim CONTACTO As String
        Dim IP As String
        CONTACTO = TextBox1.Text
        IP = TextBox2.Text
        My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\" & "CONTACTOS.txt", "$" & CONTACTO & "$" & IP & vbCrLf, True)
        MsgBox("SE HA CREADO EL USUARIO: " & CONTACTO & "  IP: " & IP)
        ACTUALIZAR_CONTACTOS()
        TextBox1.Text = ""
        TextBox2.Text = ""
    End Sub

    Private Sub LISTA_DE_CONTACTOS_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

        'AL CARGAR LLENA EL LISTBOX
        ACTUALIZAR_CONTACTOS()

    End Sub
    Public Sub ACTUALIZAR_CONTACTOS()

        ' VACIAMOS EL LISTBOX Y EL ARRAY DICCIONARIO
        ListBox1.Items.Clear()
        DICCIONARIO.Clear()

        ' RECORREMOS EL FICHERO CONTACTOS.txt PARA LLENAR EL LISTBOX
        Dim filename As String = Application.StartupPath & "\" & "CONTACTOS.txt"
        Dim fields As String()
        Dim delimiter As String = "$"
        Using parser As New TextFieldParser(filename)
            parser.SetDelimiters(delimiter)
            While Not parser.EndOfData
                ' Read in the fields for the current line
                fields = parser.ReadFields()
                ' Add code here to use data in fields variable.

                ListBox1.Items.Add(fields(1))

                ' CREAMOS UN ARRAY DE TIPO DICCIONARIO CON LOS VALORES QUE OBTENEMOS AL RECORRER EL ARCHIVO DE DATOS
                DICCIONARIO.Add(fields(1), fields(2))
            End While
        End Using
        'ORDENAMOS ALFABETICAMENTE EL LISTBOX
        ListBox1.Sorted = True
    End Sub

    Private Sub ListBox1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
        Dim ENUMERADOR As IDictionaryEnumerator
        ENUMERADOR = DICCIONARIO.GetEnumerator
        While ENUMERADOR.MoveNext
            If ENUMERADOR.Key = ListBox1.SelectedItem Then
                Form1.LabelIP.Text = ENUMERADOR.Value
                Form1.Label1.Text = ENUMERADOR.Key
            End If
        End While
        Form1.RELOJWEBCAM.Enabled = True
        'Form1.RELOJMENSAJE.Enabled = True
        'Form1.RELOJRECIBEAUDIO.Enabled = True
        'Form1.SERVIDOR = New UDPListener(8050)
        'Form1.SERVIDOR.Start()
        Close()
    End Sub
End Class

CLASES:

WAVENATIVE

Imports System.Runtime.InteropServices

Public Enum WaveFormats
    Pcm = 1
    Float = 3
End Enum

<StructLayout(LayoutKind.Sequential)> _
Public Class WaveFormat
    Public wFormatTag As Short
    Public nChannels As Short
    Public nSamplesPerSec As Integer
    Public nAvgBytesPerSec As Integer
    Public nBlockAlign As Short
    Public wBitsPerSample As Short
    Public cbSize As Short

    Public Sub New(rate As Integer, bits As Integer, channels As Integer)
        wFormatTag = CShort(WaveFormats.Pcm)
        nChannels = CShort(channels)
        nSamplesPerSec = rate
        wBitsPerSample = CShort(bits)
        cbSize = 0

        nBlockAlign = CShort(channels * (bits \ 8))
        nAvgBytesPerSec = nSamplesPerSec * nBlockAlign
    End Sub
End Class

Friend Class WaveNative
    ' consts
    Public Const MMSYSERR_NOERROR As Integer = 0
    ' no error
    Public Const MM_WOM_OPEN As Integer = &H3BB
    Public Const MM_WOM_CLOSE As Integer = &H3BC
    Public Const MM_WOM_DONE As Integer = &H3BD

    Public Const MM_WIM_OPEN As Integer = &H3BE
    Public Const MM_WIM_CLOSE As Integer = &H3BF
    Public Const MM_WIM_DATA As Integer = &H3C0

    Public Const CALLBACK_FUNCTION As Integer = &H30000
    ' dwCallback is a FARPROC
    Public Const TIME_MS As Integer = &H1
    ' time in milliseconds
    Public Const TIME_SAMPLES As Integer = &H2
    ' number of wave samples
    Public Const TIME_BYTES As Integer = &H4
    ' current byte offset
    ' callbacks
    Public Delegate Sub WaveDelegate(hdrvr As IntPtr, uMsg As Integer, dwUser As Integer, ByRef wavhdr As WaveHdr, dwParam2 As Integer)

    ' structs

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure WaveHdr
        Public lpData As IntPtr
        ' pointer to locked data buffer
        Public dwBufferLength As Integer
        ' length of data buffer
        Public dwBytesRecorded As Integer
        ' used for input only
        Public dwUser As IntPtr
        ' for client's use
        Public dwFlags As Integer
        ' assorted flags (see defines)
        Public dwLoops As Integer
        ' loop control counter
        Public lpNext As IntPtr
        ' PWaveHdr, reserved for driver
        Public reserved As Integer
        ' reserved for driver
    End Structure

    Private Const mmdll As String = "winmm.dll"

    ' WaveOut calls
    <DllImport(mmdll)> _
    Public Shared Function waveOutGetNumDevs() As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutPrepareHeader(hWaveOut As IntPtr, ByRef lpWaveOutHdr As WaveHdr, uSize As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutUnprepareHeader(hWaveOut As IntPtr, ByRef lpWaveOutHdr As WaveHdr, uSize As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutWrite(hWaveOut As IntPtr, ByRef lpWaveOutHdr As WaveHdr, uSize As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutOpen(ByRef hWaveOut As IntPtr, uDeviceID As Integer, lpFormat As WaveFormat, dwCallback As WaveDelegate, dwInstance As Integer, dwFlags As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutReset(hWaveOut As IntPtr) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutClose(hWaveOut As IntPtr) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutPause(hWaveOut As IntPtr) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutRestart(hWaveOut As IntPtr) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutGetPosition(hWaveOut As IntPtr, ByRef lpInfo As Integer, uSize As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutSetVolume(hWaveOut As IntPtr, dwVolume As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveOutGetVolume(hWaveOut As IntPtr, ByRef dwVolume As Integer) As Integer
    End Function

    ' WaveIn calls
    <DllImport(mmdll)> _
    Public Shared Function waveInGetNumDevs() As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInAddBuffer(hwi As IntPtr, ByRef pwh As WaveHdr, cbwh As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInClose(hwi As IntPtr) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInOpen(ByRef phwi As IntPtr, uDeviceID As Integer, lpFormat As WaveFormat, dwCallback As WaveDelegate, dwInstance As Integer, dwFlags As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInPrepareHeader(hWaveIn As IntPtr, ByRef lpWaveInHdr As WaveHdr, uSize As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInUnprepareHeader(hWaveIn As IntPtr, ByRef lpWaveInHdr As WaveHdr, uSize As Integer) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInReset(hwi As IntPtr) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInStart(hwi As IntPtr) As Integer
    End Function
    <DllImport(mmdll)> _
    Public Shared Function waveInStop(hwi As IntPtr) As Integer
    End Function
End Class

WAVEIN

Imports System.Threading
Imports System.Runtime.InteropServices

Namespace CHATVOZ
    Friend Class WaveInHelper
        Public Shared Sub [Try](err As Integer)
            If err <> WaveNative.MMSYSERR_NOERROR Then
                Throw New Exception(err.ToString())
            End If
        End Sub
    End Class

    Public Delegate Sub BufferDoneEventHandler(data As IntPtr, size As Integer)

    Friend Class WaveInBuffer
        Implements IDisposable
        Public NextBuffer As WaveInBuffer

        Private m_RecordEvent As New AutoResetEvent(False)
        Private m_WaveIn As IntPtr

        Private m_Header As WaveNative.WaveHdr
        Private m_HeaderData As Byte()
        Private m_HeaderHandle As GCHandle
        Private m_HeaderDataHandle As GCHandle

        Private m_Recording As Boolean

        Friend Shared Sub WaveInProc(hdrvr As IntPtr, uMsg As Integer, dwUser As Integer, ByRef wavhdr As WaveNative.WaveHdr, dwParam2 As Integer)
            If uMsg = WaveNative.MM_WIM_DATA Then
                Try
                    Dim h As GCHandle = CType(wavhdr.dwUser, GCHandle)
                    Dim buf As WaveInBuffer = DirectCast(h.Target, WaveInBuffer)
                    buf.OnCompleted()
                Catch
                End Try
            End If
        End Sub

        Public Sub New(waveInHandle As IntPtr, size As Integer)
            m_WaveIn = waveInHandle

            m_HeaderHandle = GCHandle.Alloc(m_Header, GCHandleType.Pinned)
            m_Header.dwUser = CType(GCHandle.Alloc(Me), IntPtr)
            m_HeaderData = New Byte(size - 1) {}
            m_HeaderDataHandle = GCHandle.Alloc(m_HeaderData, GCHandleType.Pinned)
            m_Header.lpData = m_HeaderDataHandle.AddrOfPinnedObject()
            m_Header.dwBufferLength = size
            WaveInHelper.[Try](WaveNative.waveInPrepareHeader(m_WaveIn, m_Header, Marshal.SizeOf(m_Header)))
        End Sub
        Protected Overrides Sub Finalize()
            Try
                Dispose()
            Finally
                MyBase.Finalize()
            End Try
        End Sub

        Public Sub Dispose() Implements IDisposable.Dispose
            If m_Header.lpData <> IntPtr.Zero Then
                WaveNative.waveInUnprepareHeader(m_WaveIn, m_Header, Marshal.SizeOf(m_Header))
                m_HeaderHandle.Free()
                m_Header.lpData = IntPtr.Zero
            End If
            m_RecordEvent.Close()
            If m_HeaderDataHandle.IsAllocated Then
                m_HeaderDataHandle.Free()
            End If
            GC.SuppressFinalize(Me)
        End Sub

        Public ReadOnly Property Size() As Integer
            Get
                Return m_Header.dwBufferLength
            End Get
        End Property

        Public ReadOnly Property Data() As IntPtr
            Get
                Return m_Header.lpData
            End Get
        End Property

        Public Function Record() As Boolean
            SyncLock Me
                m_RecordEvent.Reset()
                m_Recording = WaveNative.waveInAddBuffer(m_WaveIn, m_Header, Marshal.SizeOf(m_Header)) = WaveNative.MMSYSERR_NOERROR
                Return m_Recording
            End SyncLock
        End Function

        Public Sub WaitFor()
            If m_Recording Then
                m_Recording = m_RecordEvent.WaitOne()
            Else
                Thread.Sleep(0)
            End If
        End Sub

        Private Sub OnCompleted()
            m_RecordEvent.[Set]()
            m_Recording = False
        End Sub
    End Class

    Public Class WaveInRecorder
        Implements IDisposable
        Private m_WaveIn As IntPtr
        Private m_Buffers As WaveInBuffer
        ' linked list
        Private m_CurrentBuffer As WaveInBuffer
        Private m_Thread As Thread
        Private m_DoneProc As BufferDoneEventHandler
        Private m_Finished As Boolean

        Private m_BufferProc As New WaveNative.WaveDelegate(AddressOf WaveInBuffer.WaveInProc)

        Public Shared ReadOnly Property DeviceCount() As Integer
            Get
                Return WaveNative.waveInGetNumDevs()
            End Get
        End Property

        Public Sub New(device As Integer, format As WaveFormat, bufferSize As Integer, bufferCount As Integer, doneProc As BufferDoneEventHandler)
            m_DoneProc = doneProc
            WaveInHelper.[Try](WaveNative.waveInOpen(m_WaveIn, device, format, m_BufferProc, 0, WaveNative.CALLBACK_FUNCTION))
            AllocateBuffers(bufferSize, bufferCount)
            For i As Integer = 0 To bufferCount - 1
                SelectNextBuffer()
                m_CurrentBuffer.Record()
            Next
            WaveInHelper.[Try](WaveNative.waveInStart(m_WaveIn))
            m_Thread = New Thread(New ThreadStart(AddressOf ThreadProc))
            m_Thread.Start()
        End Sub
        Protected Overrides Sub Finalize()
            Try
                Dispose()
            Finally
                MyBase.Finalize()
            End Try
        End Sub
        Public Sub Dispose() Implements IDisposable.Dispose
            If m_Thread IsNot Nothing Then
                Try
                    m_Finished = True
                    If m_WaveIn <> IntPtr.Zero Then
                        WaveNative.waveInReset(m_WaveIn)
                    End If
                    WaitForAllBuffers()
                    m_Thread.Join()
                    m_DoneProc = Nothing
                    FreeBuffers()
                    If m_WaveIn <> IntPtr.Zero Then
                        WaveNative.waveInClose(m_WaveIn)
                    End If
                Finally
                    m_Thread = Nothing
                    m_WaveIn = IntPtr.Zero
                End Try
            End If
            GC.SuppressFinalize(Me)
        End Sub
        Private Sub ThreadProc()
            While Not m_Finished
                Advance()
                If m_DoneProc IsNot Nothing AndAlso Not m_Finished Then
                    m_DoneProc(m_CurrentBuffer.Data, m_CurrentBuffer.Size)
                End If
                m_CurrentBuffer.Record()
            End While
        End Sub
        Private Sub AllocateBuffers(bufferSize As Integer, bufferCount As Integer)
            FreeBuffers()
            If bufferCount > 0 Then
                m_Buffers = New WaveInBuffer(m_WaveIn, bufferSize)
                Dim Prev As WaveInBuffer = m_Buffers
                Try
                    For i As Integer = 1 To bufferCount - 1
                        Dim Buf As New WaveInBuffer(m_WaveIn, bufferSize)
                        Prev.NextBuffer = Buf
                        Prev = Buf
                    Next
                Finally
                    Prev.NextBuffer = m_Buffers
                End Try
            End If
        End Sub
        Private Sub FreeBuffers()
            m_CurrentBuffer = Nothing
            If m_Buffers IsNot Nothing Then
                Dim First As WaveInBuffer = m_Buffers
                m_Buffers = Nothing

                Dim Current As WaveInBuffer = First
                Do
                    Dim [Next] As WaveInBuffer = Current.NextBuffer
                    Current.Dispose()
                    Current = [Next]
                Loop While Current IsNot First
            End If
        End Sub
        Private Sub Advance()
            SelectNextBuffer()
            m_CurrentBuffer.WaitFor()
        End Sub
        Private Sub SelectNextBuffer()
            m_CurrentBuffer = If(m_CurrentBuffer Is Nothing, m_Buffers, m_CurrentBuffer.NextBuffer)
        End Sub
        Private Sub WaitForAllBuffers()
            Dim Buf As WaveInBuffer = m_Buffers
            While Buf.NextBuffer IsNot m_Buffers
                Buf.WaitFor()
                Buf = Buf.NextBuffer
            End While
        End Sub
    End Class
End Namespace

WAVEOUT

Imports System.Threading
Imports System.Runtime.InteropServices

Namespace CHATVOZ
    Friend Class WaveOutHelper
        Public Shared Sub [Try](err As Integer)
            If err <> WaveNative.MMSYSERR_NOERROR Then
                Throw New Exception(err.ToString())
            End If
        End Sub
    End Class

    Public Delegate Sub BufferFillEventHandler(data As IntPtr, size As Integer)

    Friend Class WaveOutBuffer
        Implements IDisposable
        Public NextBuffer As WaveOutBuffer

        Private m_PlayEvent As New AutoResetEvent(False)
        Private m_WaveOut As IntPtr

        Private m_Header As WaveNative.WaveHdr
        Private m_HeaderData As Byte()
        Private m_HeaderHandle As GCHandle
        Private m_HeaderDataHandle As GCHandle

        Private m_Playing As Boolean

        Friend Shared Sub WaveOutProc(hdrvr As IntPtr, uMsg As Integer, dwUser As Integer, ByRef wavhdr As WaveNative.WaveHdr, dwParam2 As Integer)
            If uMsg = WaveNative.MM_WOM_DONE Then
                Try
                    Dim h As GCHandle = CType(wavhdr.dwUser, GCHandle)
                    Dim buf As WaveOutBuffer = DirectCast(h.Target, WaveOutBuffer)
                    buf.OnCompleted()
                Catch
                End Try
            End If
        End Sub

        Public Sub New(waveOutHandle As IntPtr, size As Integer)
            m_WaveOut = waveOutHandle

            m_HeaderHandle = GCHandle.Alloc(m_Header, GCHandleType.Pinned)
            m_Header.dwUser = CType(GCHandle.Alloc(Me), IntPtr)
            m_HeaderData = New Byte(size - 1) {}
            m_HeaderDataHandle = GCHandle.Alloc(m_HeaderData, GCHandleType.Pinned)
            m_Header.lpData = m_HeaderDataHandle.AddrOfPinnedObject()
            m_Header.dwBufferLength = size
            WaveOutHelper.[Try](WaveNative.waveOutPrepareHeader(m_WaveOut, m_Header, Marshal.SizeOf(m_Header)))
        End Sub
        Protected Overrides Sub Finalize()
            Try
                Dispose()
            Finally
                MyBase.Finalize()
            End Try
        End Sub
        Public Sub Dispose() Implements IDisposable.Dispose
            If m_Header.lpData <> IntPtr.Zero Then
                WaveNative.waveOutUnprepareHeader(m_WaveOut, m_Header, Marshal.SizeOf(m_Header))
                m_HeaderHandle.Free()
                m_Header.lpData = IntPtr.Zero
            End If
            m_PlayEvent.Close()
            If m_HeaderDataHandle.IsAllocated Then
                m_HeaderDataHandle.Free()
            End If
            GC.SuppressFinalize(Me)
        End Sub

        Public ReadOnly Property Size() As Integer
            Get
                Return m_Header.dwBufferLength
            End Get
        End Property

        Public ReadOnly Property Data() As IntPtr
            Get
                Return m_Header.lpData
            End Get
        End Property

        Public Function Play() As Boolean
            SyncLock Me
                m_PlayEvent.Reset()
                m_Playing = WaveNative.waveOutWrite(m_WaveOut, m_Header, Marshal.SizeOf(m_Header)) = WaveNative.MMSYSERR_NOERROR
                Return m_Playing
            End SyncLock
        End Function
        Public Sub WaitFor()
            If m_Playing Then
                m_Playing = m_PlayEvent.WaitOne()
            Else
                Thread.Sleep(0)
            End If
        End Sub
        Public Sub OnCompleted()
            m_PlayEvent.[Set]()
            m_Playing = False
        End Sub
    End Class

    Public Class WaveOutPlayer
        Implements IDisposable
        Private m_WaveOut As IntPtr
        Private m_Buffers As WaveOutBuffer
        ' linked list
        Private m_CurrentBuffer As WaveOutBuffer
        Private m_Thread As Thread
        Private m_FillProc As BufferFillEventHandler
        Private m_Finished As Boolean
        Private m_zero As Byte

        Private m_BufferProc As New WaveNative.WaveDelegate(AddressOf WaveOutBuffer.WaveOutProc)

        Public Shared ReadOnly Property DeviceCount() As Integer
            Get
                Return WaveNative.waveOutGetNumDevs()
            End Get
        End Property

        Public Sub New(device As Integer, format As WaveFormat, bufferSize As Integer, bufferCount As Integer, fillProc As BufferFillEventHandler)
            m_zero = If(format.wBitsPerSample = 8, CByte(128), CByte(0))
            m_FillProc = fillProc
            WaveOutHelper.[Try](WaveNative.waveOutOpen(m_WaveOut, device, format, m_BufferProc, 0, WaveNative.CALLBACK_FUNCTION))
            AllocateBuffers(bufferSize, bufferCount)
            m_Thread = New Thread(New ThreadStart(AddressOf ThreadProc))
            m_Thread.Start()
        End Sub
        Protected Overrides Sub Finalize()
            Try
                Dispose()
            Finally
                MyBase.Finalize()
            End Try
        End Sub
        Public Sub Dispose() Implements IDisposable.Dispose
            If m_Thread IsNot Nothing Then
                Try
                    m_Finished = True
                    If m_WaveOut <> IntPtr.Zero Then
                        WaveNative.waveOutReset(m_WaveOut)
                    End If
                    m_Thread.Join()
                    m_FillProc = Nothing
                    FreeBuffers()
                    If m_WaveOut <> IntPtr.Zero Then
                        WaveNative.waveOutClose(m_WaveOut)
                    End If
                Finally
                    m_Thread = Nothing
                    m_WaveOut = IntPtr.Zero
                End Try
            End If
            GC.SuppressFinalize(Me)
        End Sub
        Private Sub ThreadProc()
            While Not m_Finished
                Advance()
                If m_FillProc IsNot Nothing AndAlso Not m_Finished Then
                    m_FillProc(m_CurrentBuffer.Data, m_CurrentBuffer.Size)
                Else
                    ' zero out buffer
                    Dim v As Byte = m_zero
                    Dim b As Byte() = New Byte(m_CurrentBuffer.Size - 1) {}
                    For i As Integer = 0 To b.Length - 1
                        b(i) = v
                    Next

                    Marshal.Copy(b, 0, m_CurrentBuffer.Data, b.Length)
                End If
                m_CurrentBuffer.Play()
            End While
            WaitForAllBuffers()
        End Sub
        Private Sub AllocateBuffers(bufferSize As Integer, bufferCount As Integer)
            FreeBuffers()
            If bufferCount > 0 Then
                m_Buffers = New WaveOutBuffer(m_WaveOut, bufferSize)
                Dim Prev As WaveOutBuffer = m_Buffers
                Try
                    For i As Integer = 1 To bufferCount - 1
                        Dim Buf As New WaveOutBuffer(m_WaveOut, bufferSize)
                        Prev.NextBuffer = Buf
                        Prev = Buf
                    Next
                Finally
                    Prev.NextBuffer = m_Buffers
                End Try
            End If
        End Sub
        Private Sub FreeBuffers()
            m_CurrentBuffer = Nothing
            If m_Buffers IsNot Nothing Then
                Dim First As WaveOutBuffer = m_Buffers
                m_Buffers = Nothing

                Dim Current As WaveOutBuffer = First
                Do
                    Dim [Next] As WaveOutBuffer = Current.NextBuffer
                    Current.Dispose()
                    Current = [Next]
                Loop While Current IsNot First
            End If
        End Sub
        Private Sub Advance()
            m_CurrentBuffer = If(m_CurrentBuffer Is Nothing, m_Buffers, m_CurrentBuffer.NextBuffer)
            m_CurrentBuffer.WaitFor()
        End Sub
        Private Sub WaitForAllBuffers()
            Dim Buf As WaveOutBuffer = m_Buffers
            While Buf.NextBuffer IsNot m_Buffers
                Buf.WaitFor()
                Buf = Buf.NextBuffer
            End While
        End Sub
    End Class
End Namespace

WAVESTREAM

Imports System.IO

Namespace CHATVOZ
    Public Class WaveStream
        Inherits Stream
        Private m_Stream As Stream
        Private m_DataPos As Long
        Private m_Length As Long

        Private m_Format As WaveFormat

        Public ReadOnly Property Format() As WaveFormat
            Get
                Return m_Format
            End Get
        End Property

        Private Function ReadChunk(reader As BinaryReader) As String
            Dim ch As Byte() = New Byte(3) {}
            reader.Read(ch, 0, ch.Length)
            Return System.Text.Encoding.ASCII.GetString(ch)
        End Function

        Private Sub ReadHeader()
            Dim Reader As New BinaryReader(m_Stream)
            If ReadChunk(Reader) <> "RIFF" Then
                Throw New Exception("Invalid file format")
            End If

            Reader.ReadInt32()
            ' File length minus first 8 bytes of RIFF description, we don't use it
            If ReadChunk(Reader) <> "WAVE" Then
                Throw New Exception("Invalid file format")
            End If

            If ReadChunk(Reader) <> "fmt " Then
                Throw New Exception("Invalid file format")
            End If

            Dim len As Integer = Reader.ReadInt32()
            If len < 16 Then
                ' bad format chunk length
                Throw New Exception("Invalid file format")
            End If

            m_Format = New WaveFormat(22050, 16, 2)
            ' initialize to any format
            m_Format.wFormatTag = Reader.ReadInt16()
            m_Format.nChannels = Reader.ReadInt16()
            m_Format.nSamplesPerSec = Reader.ReadInt32()
            m_Format.nAvgBytesPerSec = Reader.ReadInt32()
            m_Format.nBlockAlign = Reader.ReadInt16()
            m_Format.wBitsPerSample = Reader.ReadInt16()

            ' advance in the stream to skip the wave format block
            len -= 16
            ' minimum format size
            While len > 0
                Reader.ReadByte()
                len -= 1
            End While

            ' assume the data chunk is aligned
            While m_Stream.Position < m_Stream.Length AndAlso ReadChunk(Reader) <> "data"

            End While

            If m_Stream.Position >= m_Stream.Length Then
                Throw New Exception("Invalid file format")
            End If

            m_Length = Reader.ReadInt32()
            m_DataPos = m_Stream.Position

            Position = 0
        End Sub

        Public Sub New(fileName As String)
            Me.New(New FileStream(fileName, FileMode.Open))
        End Sub
        Public Sub New(S As Stream)
            m_Stream = S
            ReadHeader()
        End Sub
        Protected Overrides Sub Finalize()
            Try
                Dispose()
            Finally
                MyBase.Finalize()
            End Try
        End Sub
        Public Overloads Sub Dispose()
            If m_Stream IsNot Nothing Then
                m_Stream.Close()
            End If
            GC.SuppressFinalize(Me)
        End Sub

        Public Overrides ReadOnly Property CanRead() As Boolean
            Get
                Return True
            End Get
        End Property
        Public Overrides ReadOnly Property CanSeek() As Boolean
            Get
                Return True
            End Get
        End Property
        Public Overrides ReadOnly Property CanWrite() As Boolean
            Get
                Return False
            End Get
        End Property
        Public Overrides ReadOnly Property Length() As Long
            Get
                Return m_Length
            End Get
        End Property
        Public Overrides Property Position() As Long
            Get
                Return m_Stream.Position - m_DataPos
            End Get
            Set(value As Long)
                Seek(value, SeekOrigin.Begin)
            End Set
        End Property
        Public Overrides Sub Close()
            Dispose()
        End Sub
        Public Overrides Sub Flush()
        End Sub
        Public Overrides Sub SetLength(len As Long)
            Throw New InvalidOperationException()
        End Sub
        Public Overrides Function Seek(pos As Long, o As SeekOrigin) As Long
            Select Case o
                Case SeekOrigin.Begin
                    m_Stream.Position = pos + m_DataPos
                    Exit Select
                Case SeekOrigin.Current
                    m_Stream.Seek(pos, SeekOrigin.Current)
                    Exit Select
                Case SeekOrigin.[End]
                    m_Stream.Position = m_DataPos + m_Length - pos
                    Exit Select
            End Select
            Return Me.Position
        End Function
        Public Overrides Function Read(buf As Byte(), ofs As Integer, count As Integer) As Integer
            Dim toread As Integer = CInt(Math.Min(count, m_Length - Position))
            Return m_Stream.Read(buf, ofs, toread)
        End Function
        Public Overrides Sub Write(buf As Byte(), ofs As Integer, count As Integer)
            Throw New InvalidOperationException()
        End Sub
    End Class
End Namespace

FIFOSTREAM

Imports System.IO
Imports System.Collections

Namespace CHATVOZ
    Public Class FifoStream
        Inherits Stream
        Private Const BlockSize As Integer = 65536
        Private Const MaxBlocksInCache As Integer = (3 * 1024 * 1024) / BlockSize

        Private m_Size As Integer
        Private m_RPos As Integer
        Private m_WPos As Integer
        Private m_UsedBlocks As New Stack()
        Private m_Blocks As New ArrayList()

        Private Function AllocBlock() As Byte()
            Dim Result As Byte() = Nothing
            Result = If(m_UsedBlocks.Count > 0, DirectCast(m_UsedBlocks.Pop(), Byte()), New Byte(BlockSize - 1) {})
            Return Result
        End Function
        Private Sub FreeBlock(block As Byte())
            If m_UsedBlocks.Count < MaxBlocksInCache Then
                m_UsedBlocks.Push(block)
            End If
        End Sub
        Private Function GetWBlock() As Byte()
            Dim Result As Byte() = Nothing
            If m_WPos < BlockSize AndAlso m_Blocks.Count > 0 Then
                Result = DirectCast(m_Blocks(m_Blocks.Count - 1), Byte())
            Else
                Result = AllocBlock()
                m_Blocks.Add(Result)
                m_WPos = 0
            End If
            Return Result
        End Function

        ' Stream members
        Public Overrides ReadOnly Property CanRead() As Boolean
            Get
                Return True
            End Get
        End Property
        Public Overrides ReadOnly Property CanSeek() As Boolean
            Get
                Return False
            End Get
        End Property
        Public Overrides ReadOnly Property CanWrite() As Boolean
            Get
                Return True
            End Get
        End Property
        Public Overrides ReadOnly Property Length() As Long
            Get
                SyncLock Me
                    Return m_Size
                End SyncLock
            End Get
        End Property
        Public Overrides Property Position() As Long
            Get
                Throw New InvalidOperationException()
            End Get
            Set(value As Long)
                Throw New InvalidOperationException()
            End Set
        End Property
        Public Overrides Sub Close()
            Flush()
        End Sub
        Public Overrides Sub Flush()
            SyncLock Me
                For Each block As Byte() In m_Blocks
                    FreeBlock(block)
                Next
                m_Blocks.Clear()
                m_RPos = 0
                m_WPos = 0
                m_Size = 0
            End SyncLock
        End Sub
        Public Overrides Sub SetLength(len As Long)
            Throw New InvalidOperationException()
        End Sub
        Public Overrides Function Seek(pos As Long, o As SeekOrigin) As Long
            Throw New InvalidOperationException()
        End Function
        Public Overrides Function Read(buf As Byte(), ofs As Integer, count As Integer) As Integer
            SyncLock Me
                Dim Result As Integer = Peek(buf, ofs, count)
                Advance(Result)
                Return Result
            End SyncLock
        End Function
        Public Overrides Sub Write(buf As Byte(), ofs As Integer, count As Integer)
            SyncLock Me
                Dim Left As Integer = count
                While Left > 0
                    Dim ToWrite As Integer = Math.Min(BlockSize - m_WPos, Left)
                    Array.Copy(buf, ofs + count - Left, GetWBlock(), m_WPos, ToWrite)
                    m_WPos += ToWrite
                    Left -= ToWrite
                End While
                m_Size += count
            End SyncLock
        End Sub

        ' extra stuff
        Public Function Advance(count As Integer) As Integer
            SyncLock Me
                Dim SizeLeft As Integer = count
                While SizeLeft > 0 AndAlso m_Size > 0
                    If m_RPos = BlockSize Then
                        m_RPos = 0
                        FreeBlock(DirectCast(m_Blocks(0), Byte()))
                        m_Blocks.RemoveAt(0)
                    End If
                    Dim ToFeed As Integer = If(m_Blocks.Count = 1, Math.Min(m_WPos - m_RPos, SizeLeft), Math.Min(BlockSize - m_RPos, SizeLeft))
                    m_RPos += ToFeed
                    SizeLeft -= ToFeed
                    m_Size -= ToFeed
                End While
                Return count - SizeLeft
            End SyncLock
        End Function
        Public Function Peek(buf As Byte(), ofs As Integer, count As Integer) As Integer
            SyncLock Me
                Dim SizeLeft As Integer = count
                Dim TempBlockPos As Integer = m_RPos
                Dim TempSize As Integer = m_Size

                Dim CurrentBlock As Integer = 0
                While SizeLeft > 0 AndAlso TempSize > 0
                    If TempBlockPos = BlockSize Then
                        TempBlockPos = 0
                        CurrentBlock += 1
                    End If
                    Dim Upper As Integer = If(CurrentBlock < m_Blocks.Count - 1, BlockSize, m_WPos)
                    Dim ToFeed As Integer = Math.Min(Upper - TempBlockPos, SizeLeft)
                    Array.Copy(DirectCast(m_Blocks(CurrentBlock), Byte()), TempBlockPos, buf, ofs + count - SizeLeft, ToFeed)
                    SizeLeft -= ToFeed
                    TempBlockPos += ToFeed
                    TempSize -= ToFeed
                End While
                Return count - SizeLeft
            End SyncLock
        End Function
    End Class
End Namespace