06- Chat de Video, Videoconferencia, Videollamada con Visual Basic (VB.NET). Version Simplificada
Se trata de una versión simplificada del Proyecto 05- Chat de Video...etc,.
Al que se le ha omitido, para sencillez, Videovigilancia, Android, Escritorio Remoto, etc.
Codigo:
Form1
Imports System.Net.Sockets
Imports System.Text.Encoding
Imports System.Net
Imports System.IO
Imports System.Runtime.InteropServices
Public Class Form1
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 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
(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
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
(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
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
Dim RECEPTOR As New UdpClient(2000) 'WEBCAM
Dim ENVIANTEMENSAJES As New UdpClient() ' MENSAJES
Dim RECEPTORMENSAJES As New UdpClient(3000) ' MENSAJES
Dim RECEPTORMENSAJES As New UdpClient(3000) ' MENSAJES
Dim ENVIANTEAUDIO As New UdpClient() ' AUDIO
Dim RECEPTORAUDIO As New UdpClient(4000) ' AUDIO
Dim RECEPTORAUDIO As New UdpClient(4000) ' AUDIO
Dim ENVIANTEARCHIVO As New UdpClient() ' ARCHIVOS
Dim RECEPTORARCHIVO As New UdpClient(5000) ' ARCHIVOS
Dim RECEPTORARCHIVO As New UdpClient(5000) ' ARCHIVOS
Dim AUDIO_RECIBIDO As String = "C:\ULTIMA_GRABACION_RECIBIDA.WAV"
Dim AUDIO_ENVIADO As String = "C:\ULTIMA_GRABACION_ENVIADA.WAV"
Dim AUDIO_ENVIADO As String = "C:\ULTIMA_GRABACION_ENVIADA.WAV"
Public SERVIDOR As TcpListener
Public CLIENTE As TcpClient
Dim ARCHIVO As String
Private Const TAMAÑOBUFFER As Integer = 1024
Public CLIENTE As TcpClient
Dim ARCHIVO As String
Private Const TAMAÑOBUFFER As Integer = 1024
<DllImport("winmm.dll")> _
Private Shared Function mciSendString(ByVal command As String, ByVal buffer As String, ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr) As Integer
End Function
Private Shared Function mciSendString(ByVal command As String, ByVal buffer As String, ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr) As Integer
End Function
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
RECEPTOR.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTOR.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTOR.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTOR.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORMENSAJES.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTORMENSAJES.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORMENSAJES.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORAUDIO.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTORAUDIO.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORAUDIO.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
End Sub
'Open View
Public Sub OpenPreviewWindow()
'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)
'
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_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)
'
SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
'Start previewing the image from the camera
'
SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
'
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)
'
SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, PictureboxVISOR.Width, PictureboxVISOR.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
Else
' Error connecting to device close window
'
DestroyWindow(hHwnd)
' Error connecting to device close window
'
DestroyWindow(hHwnd)
End If
End Sub
End Sub
Private Sub ButtonINICIAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonINICIAR.Click
ButtonINICIAR.BackColor = Color.Red
'Load And Capture Device
OpenPreviewWindow()
End Sub
ButtonINICIAR.BackColor = Color.Red
'Load And Capture Device
OpenPreviewWindow()
End Sub
Private Sub ButtonCONECTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONECTAR.Click
ButtonCONECTAR.BackColor = Color.Red
LISTA_DE_CONTACTOS.Show()
ButtonCONECTAR.BackColor = Color.Red
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)
' 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()
'
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
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 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
Dim IMAGENRECIBIDA As Image = Image.FromStream(IMAGEN)
PictureBoxRECIBIR.Image = IMAGENRECIBIDA
Catch ex As Exception
End Try
End Sub
Private Sub ButtonENVIAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonENVIAR.Click
ENVIAR_MENSAJEPC()
TextBoxMENSAJE.Text = ""
TextBoxMENSAJE.Focus()
End Sub
Public Sub ENVIAR_MENSAJEPC()
ENVIANTEMENSAJES.Connect(LabelIP.Text, 3000) 'SE CONECTA CON EL RECEPTOR
Dim mensaje As Byte() = UTF7.GetBytes(TextBoxMENSAJE.Text) 'CODIFICA EN BYTES
ENVIANTEMENSAJES.Send(mensaje, mensaje.Length) 'ENVIA EL MENSAJE
End Sub
ENVIAR_MENSAJEPC()
TextBoxMENSAJE.Text = ""
TextBoxMENSAJE.Focus()
End Sub
Public Sub ENVIAR_MENSAJEPC()
ENVIANTEMENSAJES.Connect(LabelIP.Text, 3000) 'SE CONECTA CON EL RECEPTOR
Dim mensaje As Byte() = UTF7.GetBytes(TextBoxMENSAJE.Text) 'CODIFICA EN BYTES
ENVIANTEMENSAJES.Send(mensaje, mensaje.Length) 'ENVIA EL MENSAJE
End Sub
Private Sub RELOJMENSAJE_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJMENSAJE.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
LabelMENSAJERECIBIDO.Text = UTF7.GetString(RECIBEMENSAJE) 'DECODIFICA EL MENSAJE A STRING
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
LabelMENSAJERECIBIDO.Text = UTF7.GetString(RECIBEMENSAJE) 'DECODIFICA EL MENSAJE A STRING
Catch ex As Exception
End Try
End Sub
End Sub
Private Sub ButtonHABLAR_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ButtonHABLAR.MouseDown
ButtonHABLAR.BackColor = Color.Red
mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
mciSendString("record recsound", "", 0, 0)
End Sub
ButtonHABLAR.BackColor = Color.Red
mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
mciSendString("record recsound", "", 0, 0)
End Sub
Private Sub ButtonHABLAR_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ButtonHABLAR.MouseUp
ButtonHABLAR.BackColor = Color.Black
mciSendString("save recsound " & AUDIO_ENVIADO, "", 0, 0)
mciSendString("close recsound ", "", 0, 0)
ENVIANTEAUDIO.Connect(LabelIP.Text, 4000) 'SE CONECTA CON EL RECEPTOR
Dim VOZ_ENVIAR As Byte() = System.IO.File.ReadAllBytes(AUDIO_ENVIADO) 'CODIFICA EN BYTES
ENVIANTEAUDIO.Send(VOZ_ENVIAR, VOZ_ENVIAR.Length) 'ENVIA EL MENSAJE
My.Computer.FileSystem.DeleteFile(AUDIO_ENVIADO)
End Sub
ButtonHABLAR.BackColor = Color.Black
mciSendString("save recsound " & AUDIO_ENVIADO, "", 0, 0)
mciSendString("close recsound ", "", 0, 0)
ENVIANTEAUDIO.Connect(LabelIP.Text, 4000) 'SE CONECTA CON EL RECEPTOR
Dim VOZ_ENVIAR As Byte() = System.IO.File.ReadAllBytes(AUDIO_ENVIADO) 'CODIFICA EN BYTES
ENVIANTEAUDIO.Send(VOZ_ENVIAR, VOZ_ENVIAR.Length) 'ENVIA EL MENSAJE
My.Computer.FileSystem.DeleteFile(AUDIO_ENVIADO)
End Sub
Private Sub RELOJRECIBEAUDIO_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJRECIBEAUDIO.Tick
Try
Dim IP As IPEndPoint = New IPEndPoint(IPAddress.Any, 0) 'RECIBIRA DESDE CUALQUIER IP, POR CUALQUIER PUERTO
Dim RECIBEMENSAJE As Byte() = RECEPTORAUDIO.Receive(IP) 'RECIBE EL MENSAJE EN BYTES
System.IO.File.WriteAllBytes(AUDIO_RECIBIDO, RECIBEMENSAJE) 'CODIFICA EN BYTES
My.Computer.Audio.Play(AUDIO_RECIBIDO, AudioPlayMode.WaitToComplete)
My.Computer.FileSystem.DeleteFile(AUDIO_RECIBIDO)
Dim RECIBEMENSAJE As Byte() = RECEPTORAUDIO.Receive(IP) 'RECIBE EL MENSAJE EN BYTES
System.IO.File.WriteAllBytes(AUDIO_RECIBIDO, RECIBEMENSAJE) 'CODIFICA EN BYTES
My.Computer.Audio.Play(AUDIO_RECIBIDO, AudioPlayMode.WaitToComplete)
My.Computer.FileSystem.DeleteFile(AUDIO_RECIBIDO)
Catch ex As Exception
End Try
End Sub
Private Sub ButtonENVIARARCHIVO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonENVIARARCHIVO.Click
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
ARCHIVO = OpenFileDialog1.FileName
End Sub
Private Sub ButtonENVIARARCHIVO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonENVIARARCHIVO.Click
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
ARCHIVO = OpenFileDialog1.FileName
End If
ENVIAARCHIVO(ARCHIVO, LabelIP.Text, 8050)
End Sub
Public Sub ENVIAARCHIVO(ARCHIVO As String, IP As String, PUERTO As Integer)
Dim ENVIARBUFFER As Byte()
Dim NS As NetworkStream
End Sub
Public Sub ENVIAARCHIVO(ARCHIVO As String, IP As String, PUERTO As Integer)
Dim ENVIARBUFFER As Byte()
Dim NS As NetworkStream
Try
CLIENTE = New TcpClient(IP, PUERTO)
NS = CLIENTE.GetStream
Dim FS As New FileStream(ARCHIVO, FileMode.Open, FileAccess.Read)
Dim PAQUETES As Integer = CInt(Math.Ceiling(CDbl(FS.Length) / CDbl(TAMAÑOBUFFER)))
Dim LONGITUDTOTAL As Integer = CInt(FS.Length)
Dim LONGITUDPAQUETEACTUAL As Integer = 0
Dim CONTADOR As Integer = 0
CLIENTE = New TcpClient(IP, PUERTO)
NS = CLIENTE.GetStream
Dim FS As New FileStream(ARCHIVO, FileMode.Open, FileAccess.Read)
Dim PAQUETES As Integer = CInt(Math.Ceiling(CDbl(FS.Length) / CDbl(TAMAÑOBUFFER)))
Dim LONGITUDTOTAL As Integer = CInt(FS.Length)
Dim LONGITUDPAQUETEACTUAL As Integer = 0
Dim CONTADOR As Integer = 0
For I As Integer = 0 To PAQUETES - 1
If LONGITUDTOTAL > TAMAÑOBUFFER Then
LONGITUDPAQUETEACTUAL = TAMAÑOBUFFER
LONGITUDTOTAL = LONGITUDTOTAL - LONGITUDPAQUETEACTUAL
Else
LONGITUDPAQUETEACTUAL = LONGITUDTOTAL
If LONGITUDTOTAL > TAMAÑOBUFFER Then
LONGITUDPAQUETEACTUAL = TAMAÑOBUFFER
LONGITUDTOTAL = LONGITUDTOTAL - LONGITUDPAQUETEACTUAL
Else
LONGITUDPAQUETEACTUAL = LONGITUDTOTAL
End If
ENVIARBUFFER = New Byte(LONGITUDPAQUETEACTUAL - 1) {}
FS.Read(ENVIARBUFFER, 0, LONGITUDPAQUETEACTUAL)
NS.Write(ENVIARBUFFER, 0, CInt(ENVIARBUFFER.Length))
Next
FS.Close()
NS.Close()
CLIENTE.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
ENVIARBUFFER = New Byte(LONGITUDPAQUETEACTUAL - 1) {}
FS.Read(ENVIARBUFFER, 0, LONGITUDPAQUETEACTUAL)
NS.Write(ENVIARBUFFER, 0, CInt(ENVIARBUFFER.Length))
Next
FS.Close()
NS.Close()
CLIENTE.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub ButtonRECIBIRARCHIVO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonRECIBIRARCHIVO.Click
ButtonRECIBIRARCHIVO.BackColor = Color.Red
RECIBIRARCHIVO(8050)
End Sub
Public Sub RECIBIRARCHIVO(PUERTO As Integer)
Dim ARCHIVORECIBIDO As Byte() = New Byte(TAMAÑOBUFFER - 1) {}
Dim BYTESRECIBIDOS As Integer
Dim FIN As Integer = 0
While FIN = 0
Dim NS As NetworkStream = Nothing
ButtonRECIBIRARCHIVO.BackColor = Color.Red
RECIBIRARCHIVO(8050)
End Sub
Public Sub RECIBIRARCHIVO(PUERTO As Integer)
Dim ARCHIVORECIBIDO As Byte() = New Byte(TAMAÑOBUFFER - 1) {}
Dim BYTESRECIBIDOS As Integer
Dim FIN As Integer = 0
While FIN = 0
Dim NS As NetworkStream = Nothing
Try
Dim ACEPTA As String = "ACEPTA EL FICHERO ENTRANTE"
Dim TITULO As String = "FICHERO ENTRANTE"
Dim BOTONES As MessageBoxButtons = MessageBoxButtons.YesNo
Dim RESULTADO As DialogResult
Dim ACEPTA As String = "ACEPTA EL FICHERO ENTRANTE"
Dim TITULO As String = "FICHERO ENTRANTE"
Dim BOTONES As MessageBoxButtons = MessageBoxButtons.YesNo
Dim RESULTADO As DialogResult
If SERVIDOR.Pending Then
CLIENTE = SERVIDOR.AcceptTcpClient
NS = CLIENTE.GetStream
RESULTADO = MessageBox.Show(ACEPTA, TITULO, BOTONES)
CLIENTE = SERVIDOR.AcceptTcpClient
NS = CLIENTE.GetStream
RESULTADO = MessageBox.Show(ACEPTA, TITULO, BOTONES)
If RESULTADO = Windows.Forms.DialogResult.Yes Then
Dim FICHERORECIBIDO As String = Nothing
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
FICHERORECIBIDO = SaveFileDialog1.FileName
End If
If FICHERORECIBIDO <> String.Empty Then
Dim TOTALBYTESRECIBIDOS As Integer = 0
Dim FS As New FileStream(FICHERORECIBIDO, FileMode.OpenOrCreate, FileAccess.Write)
Dim FICHERORECIBIDO As String = Nothing
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
FICHERORECIBIDO = SaveFileDialog1.FileName
End If
If FICHERORECIBIDO <> String.Empty Then
Dim TOTALBYTESRECIBIDOS As Integer = 0
Dim FS As New FileStream(FICHERORECIBIDO, FileMode.OpenOrCreate, FileAccess.Write)
While (AYUDAENLINEA(BYTESRECIBIDOS, NS.Read(ARCHIVORECIBIDO, 0, ARCHIVORECIBIDO.Length))) > 0
FS.Write(ARCHIVORECIBIDO, 0, BYTESRECIBIDOS)
TOTALBYTESRECIBIDOS = TOTALBYTESRECIBIDOS + BYTESRECIBIDOS
End While
FS.Close()
End If
NS.Close()
CLIENTE.Close()
MsgBox("DESCARGA FINALIZADA")
FIN = 1
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End While
End Sub
FS.Write(ARCHIVORECIBIDO, 0, BYTESRECIBIDOS)
TOTALBYTESRECIBIDOS = TOTALBYTESRECIBIDOS + BYTESRECIBIDOS
End While
FS.Close()
End If
NS.Close()
CLIENTE.Close()
MsgBox("DESCARGA FINALIZADA")
FIN = 1
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End While
End Sub
Private Shared Function AYUDAENLINEA(Of T)(ByRef OBJETIVO As T, VALOR As T)
OBJETIVO = VALOR
Return VALOR
End Function
OBJETIVO = VALOR
Return VALOR
End Function
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
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()
ACTUALIZAR_CONTACTOS()
End Sub
Public Sub ACTUALIZAR_CONTACTOS()
Public Sub ACTUALIZAR_CONTACTOS()
' VACIAMOS EL LISTBOX Y EL ARRAY DICCIONARIO
ListBox1.Items.Clear()
DICCIONARIO.Clear()
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.
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
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 TcpListener(8050)
Form1.SERVIDOR.Start()
Close()
End Sub
End Class
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 TcpListener(8050)
Form1.SERVIDOR.Start()
Close()
End Sub
End Class
IP Address, Hostname, DNS, Ping, Traceroute, Whois con VisualBasic (VB.NET). Networking
Se trata de una pequeña aplicación para ayudar a entender los conceptos de DNS, Ping, Traceroute y Whois.
Codigo:
Form1
Imports System.Net
Imports System.Net.NetworkInformation
Imports System.Globalization
Imports System.Net.NetworkInformation
Imports System.Globalization
Public Class Form1
Dim WithEvents pingSender As New Ping()
Dim PINGERROR As Boolean = False
Private Sub ButtonNOMBRE_Click(sender As Object, e As EventArgs) Handles ButtonNOMBRE.Click
TextBoxIPS.Clear()
Dim IPS As IPAddress()
Try
IPS = Dns.GetHostAddresses(TextBoxNOMBRE.Text)
For I = 0 To IPS.Length - 1
Dim WithEvents pingSender As New Ping()
Dim PINGERROR As Boolean = False
Private Sub ButtonNOMBRE_Click(sender As Object, e As EventArgs) Handles ButtonNOMBRE.Click
TextBoxIPS.Clear()
Dim IPS As IPAddress()
Try
IPS = Dns.GetHostAddresses(TextBoxNOMBRE.Text)
For I = 0 To IPS.Length - 1
TextBoxIPS.Text = TextBoxIPS.Text & IPS(I).ToString & vbCrLf
Next
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
MsgBox(ex.Message)
End Try
End Sub
Private Sub ButtonIP_Click(sender As Object, e As EventArgs) Handles ButtonIP.Click
TextBoxNOMBRE2.Text = ""
Dim NOMBRE As IPHostEntry
Try
NOMBRE = Dns.GetHostEntry(TextBoxIP.Text)
TextBoxNOMBRE2.Text = NOMBRE.HostName
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub ButtonPING_Click(sender As Object, e As EventArgs) Handles ButtonPING.Click
TextBoxPINGS.Clear()
Private Sub ButtonIP_Click(sender As Object, e As EventArgs) Handles ButtonIP.Click
TextBoxNOMBRE2.Text = ""
Dim NOMBRE As IPHostEntry
Try
NOMBRE = Dns.GetHostEntry(TextBoxIP.Text)
TextBoxNOMBRE2.Text = NOMBRE.HostName
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub ButtonPING_Click(sender As Object, e As EventArgs) Handles ButtonPING.Click
TextBoxPINGS.Clear()
TextBoxPINGIP.SelectAll()
If TextBoxPINGIP.Text.Length <> 0 Then
ButtonPING.Enabled = False
TextBoxPINGS.Text &= _
"HACIENDO PING A: " & TextBoxPINGIP.Text & vbCrLf
"HACIENDO PING A: " & TextBoxPINGIP.Text & vbCrLf
pingSender.SendAsync(TextBoxPINGIP.Text, Nothing)
Else
MessageBox.Show("ENTRA UNA IP O NOMBRE VALIDO")
End If
End Sub
Private Sub ButtonCANCEL_Click(sender As Object, e As EventArgs) Handles ButtonCANCEL.Click
Else
MessageBox.Show("ENTRA UNA IP O NOMBRE VALIDO")
End If
End Sub
Private Sub ButtonCANCEL_Click(sender As Object, e As EventArgs) Handles ButtonCANCEL.Click
pingSender.SendAsyncCancel()
End Sub
Private Sub ButtonTRACE_Click(sender As Object, e As EventArgs) Handles ButtonTRACE.Click
PINGERROR = False
TextBoxTRACE.Clear()
End Sub
Private Sub ButtonTRACE_Click(sender As Object, e As EventArgs) Handles ButtonTRACE.Click
PINGERROR = False
TextBoxTRACE.Clear()
TextBoxTRACEIP.SelectAll()
If TextBoxTRACEIP.Text.Length <> 0 Then
SUBPING()
pingSender.SendAsyncCancel()
If PINGERROR = False Then
Try
TRAZADO()
Catch ex As Exception
MsgBox(ex.Message)
End Try
SUBPING()
pingSender.SendAsyncCancel()
If PINGERROR = False Then
Try
TRAZADO()
Catch ex As Exception
MsgBox(ex.Message)
End Try
Else
TextBoxTRACE.Text = "NO SE PUEDE REALIZAR EL TRAZADO"
End If
TextBoxTRACE.Text = "NO SE PUEDE REALIZAR EL TRAZADO"
End If
Else
MessageBox.Show("ENTRA UNA IP O NOMBRE VALIDO")
End If
MessageBox.Show("ENTRA UNA IP O NOMBRE VALIDO")
End If
End Sub
Private Sub pingSender_PingCompleted( _
ByVal sender As Object, ByVal e As PingCompletedEventArgs) _
Handles pingSender.PingCompleted
If e.Error Is Nothing Then
If e.Cancelled Then
TextBoxPINGS.Text &= _
"PING CANCELADO" & vbCrLf
Else
If e.Reply.Status = IPStatus.Success Then
TextBoxPINGS.Text &= " " & e.Reply.Address.ToString() & " " & e.Reply.RoundtripTime.ToString(NumberFormatInfo.CurrentInfo) & "ms " & vbCrLf
Else
TextBoxPINGS.Text &= " " & GetStatusString(e.Reply.Status) & vbCrLf
PINGERROR = True
End If
End If
Else
ByVal sender As Object, ByVal e As PingCompletedEventArgs) _
Handles pingSender.PingCompleted
If e.Error Is Nothing Then
If e.Cancelled Then
TextBoxPINGS.Text &= _
"PING CANCELADO" & vbCrLf
Else
If e.Reply.Status = IPStatus.Success Then
TextBoxPINGS.Text &= " " & e.Reply.Address.ToString() & " " & e.Reply.RoundtripTime.ToString(NumberFormatInfo.CurrentInfo) & "ms " & vbCrLf
Else
TextBoxPINGS.Text &= " " & GetStatusString(e.Reply.Status) & vbCrLf
PINGERROR = True
End If
End If
Else
TextBoxPINGS.Text &= " PING ERROR" & vbCrLf
MessageBox.Show("HA OCURRIDO UN ERROR ENVIANDO EL PING: " & e.Error.InnerException.Message.ToString())
PINGERROR = True
End If
ButtonTRACE.Enabled = True
ButtonPING.Enabled = True
End Sub
MessageBox.Show("HA OCURRIDO UN ERROR ENVIANDO EL PING: " & e.Error.InnerException.Message.ToString())
PINGERROR = True
End If
ButtonTRACE.Enabled = True
ButtonPING.Enabled = True
End Sub
Private Function GetStatusString(ByVal status As IPStatus) As String
Select Case status
Case IPStatus.Success
Return "OK"
Case IPStatus.DestinationHostUnreachable
Return "HOST ILOCALIZABLE"
Case IPStatus.DestinationNetworkUnreachable
Return "RED ILOCALIZABLE"
Case IPStatus.DestinationPortUnreachable
Return "PUERTO ILOCALIZABLE"
Case IPStatus.DestinationProtocolUnreachable
Return "PROTOCOLO ILOCALIZABLE"
Case IPStatus.PacketTooBig
Return "PAQUETE DEMASIADO GRANDE"
Case IPStatus.TtlExpired
Return "TTL AGOTADA"
Case IPStatus.ParameterProblem
Return "PROBLEMA DE PARAMETROS"
Case IPStatus.SourceQuench
Return "REDUCE LA VELOCIDAD DE TRANSMISION"
Case IPStatus.TimedOut
Return "TIEMPO SOBREPASADO"
Case Else
Return "FALLO DE PING"
End Select
End Function
Public Sub SUBPING()
Try
pingSender.SendAsync(TextBoxTRACEIP.Text, Nothing)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Select Case status
Case IPStatus.Success
Return "OK"
Case IPStatus.DestinationHostUnreachable
Return "HOST ILOCALIZABLE"
Case IPStatus.DestinationNetworkUnreachable
Return "RED ILOCALIZABLE"
Case IPStatus.DestinationPortUnreachable
Return "PUERTO ILOCALIZABLE"
Case IPStatus.DestinationProtocolUnreachable
Return "PROTOCOLO ILOCALIZABLE"
Case IPStatus.PacketTooBig
Return "PAQUETE DEMASIADO GRANDE"
Case IPStatus.TtlExpired
Return "TTL AGOTADA"
Case IPStatus.ParameterProblem
Return "PROBLEMA DE PARAMETROS"
Case IPStatus.SourceQuench
Return "REDUCE LA VELOCIDAD DE TRANSMISION"
Case IPStatus.TimedOut
Return "TIEMPO SOBREPASADO"
Case Else
Return "FALLO DE PING"
End Select
End Function
Public Sub SUBPING()
Try
pingSender.SendAsync(TextBoxTRACEIP.Text, Nothing)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Public Sub TRAZADO()
Dim IP As IPAddress
Try
IP = Dns.GetHostEntry(TextBoxTRACEIP.Text).AddressList(0)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Dim pingOptions As New PingOptions()
pingOptions.Ttl = 1
Dim maxHops As Integer = 30
Dim stopWatch As New Stopwatch()
Dim IP As IPAddress
Try
IP = Dns.GetHostEntry(TextBoxTRACEIP.Text).AddressList(0)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Dim pingOptions As New PingOptions()
pingOptions.Ttl = 1
Dim maxHops As Integer = 30
Dim stopWatch As New Stopwatch()
ButtonTRACE.Enabled = False
For i As Integer = 1 To maxHops
stopWatch.Reset()
stopWatch.Start()
stopWatch.Start()
Dim pingReply As PingReply = pingSender.Send(IP, 5000, New Byte(31) {}, pingOptions)
stopWatch.[Stop]()
Try
If PingReply.Address IsNot Nothing Then
stopWatch.[Stop]()
Try
If PingReply.Address IsNot Nothing Then
TextBoxTRACE.Text = TextBoxTRACE.Text & i & "... " & stopWatch.ElapsedMilliseconds.ToString & " ms. " & PingReply.Address.ToString & vbCrLf
Else
Else
TextBoxTRACE.Text = TextBoxTRACE.Text & "NO SE PUEDE IR MAS ALLA" & vbCrLf
Exit For
Exit For
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
MsgBox(ex.Message)
End Try
If pingReply.Status = IPStatus.Success Then
TextBoxTRACE.Text = TextBoxTRACE.Text & "TRAZADO COMPLETO" & vbCrLf
Exit For
End If
pingOptions.Ttl += 1
Next
ButtonTRACE.Enabled = True
End Sub
End If
pingOptions.Ttl += 1
Next
ButtonTRACE.Enabled = True
End Sub
Private Sub ButtonMAPA_Click(sender As Object, e As EventArgs) Handles ButtonMAPA.Click
WebBrowser1.Navigate("www.infosniper.net")
Timer1.Interval = 3000
Timer1.Enabled = True
Timer1.Enabled = True
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Try
WebBrowser1.Document.Forms("ip_address").All("ip_address").InnerText = TextBoxMAPA.Text
WebBrowser1.Document.Forms("ip_address").InvokeMember("SUBMIT")
Catch ex As Exception
MsgBox(ex.Message)
End Try
Timer1.Enabled = False
WebBrowser1.Visible = True
End Sub
Try
WebBrowser1.Document.Forms("ip_address").All("ip_address").InnerText = TextBoxMAPA.Text
WebBrowser1.Document.Forms("ip_address").InvokeMember("SUBMIT")
Catch ex As Exception
MsgBox(ex.Message)
End Try
Timer1.Enabled = False
WebBrowser1.Visible = True
End Sub
Private Sub ButtonWHOIS_Click(sender As Object, e As EventArgs) Handles ButtonWHOIS.Click
WebBrowser1.Navigate("http://whois.domaintools.com")
Timer2.Interval = 3000
Timer2.Enabled = True
End Sub
Timer2.Enabled = True
End Sub
Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
Try
WebBrowser1.Document.Forms("whois-box").All("Q").InnerText = TextBoxMAPA.Text
WebBrowser1.Document.Forms("whois-box").InvokeMember("SUBMIT")
Catch ex As Exception
MsgBox(ex.Message)
End Try
Timer2.Enabled = False
WebBrowser1.Visible = True
End Sub
End Class
Try
WebBrowser1.Document.Forms("whois-box").All("Q").InnerText = TextBoxMAPA.Text
WebBrowser1.Document.Forms("whois-box").InvokeMember("SUBMIT")
Catch ex As Exception
MsgBox(ex.Message)
End Try
Timer2.Enabled = False
WebBrowser1.Visible = True
End Sub
End Class
Obtener la IP o el Nombre de un Servidor con Visual Basic (VB.NET)
Se trata de una pequeña aplicacion que nos permite conocer la IP de un Servidor a partir de su nombre o el Nombre del Servidor a partir de la IP.
Codigo:
Form1
Imports System.Net
Public Class Form1
Public Class Form1
Private Sub ButtonNOMBRE_Click(sender As Object, e As EventArgs) Handles ButtonNOMBRE.Click
'BUSCA EL NOMBRE
Dim NOMBRE As IPHostEntry
Try
Dim NOMBRE As IPHostEntry
Try
NOMBRE = Dns.GetHostEntry(TextBox1.Text)
TextBox3.Text = NOMBRE.HostName
Catch ex As Exception
MsgBox(ex.Message)
End Try
TextBox3.Text = NOMBRE.HostName
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub ButtonIP_Click(sender As Object, e As EventArgs) Handles ButtonIP.Click
'BUSCA LA IP
Dim SU_IP As IPAddress()
Try
SU_IP = Dns.GetHostAddresses(TextBox2.Text)
For I = 0 To SU_IP.Length - 1
TextBox4.Text = (SU_IP(I)).ToString
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
'BUSCA LA IP
Dim SU_IP As IPAddress()
Try
SU_IP = Dns.GetHostAddresses(TextBox2.Text)
For I = 0 To SU_IP.Length - 1
TextBox4.Text = (SU_IP(I)).ToString
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
End Class
Control Basico de Escritorio Remoto
Se trata de una
aplicacion que permite ver y controlar el cursor de un escritorio
remoto. En el otro ordenador tambien debe estar instalada la misma
aplicacion.
Video 1:
Video 2:
Codigo:
Form1
Imports System.Net.Sockets
Imports System.Text.Encoding
Imports System.Net
Imports System.IO
Imports System.Runtime.InteropServices
Public Class Form1
Dim ENVIANTE As New UdpClient() 'IMAGENES
Dim RECEPTOR As New UdpClient(2000) 'IMAGENES
Dim ENVIANTEMENSAJES As New UdpClient() ' MENSAJES
Dim RECEPTORMENSAJES As New UdpClient(3000) ' MENSAJES
Dim BM2 As Bitmap
Dim PUNTOX As Integer
Dim PUNTOY As Integer
<DllImport("user32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Sub mouse_event(dwFlags As Integer, dx As Integer, dy As Integer, cButtons As Integer, dwExtraInfo As Integer)
End Sub
Private Const MOUSEEVENTF_LEFTDOWN As Integer = &H2
Private Const MOUSEEVENTF_LEFTUP As Integer = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Integer = &H8
Private Const MOUSEEVENTF_RIGHTUP As Integer = &H10
Protected Overrides Function ProcessCmdKey( _
ByRef msg As System.Windows.Forms.Message, _
ByVal keyData As System.Windows.Forms.Keys) As Boolean
Select Case keyData
Case Keys.Up
LabelORDENENVIADA.Text = "ARRIBA"
Case Keys.Down
LabelORDENENVIADA.Text = "ABAJO"
Case Keys.Left
LabelORDENENVIADA.Text = "IZQUIERDA"
Case Keys.Right
LabelORDENENVIADA.Text = "DERECHA"
Case Keys.S
LabelORDENENVIADA.Text = "PARA"
Case Keys.Enter
LabelORDENENVIADA.Text = "INTRO"
Case Keys.D
LabelORDENENVIADA.Text = "DOBLE"
End Select
Return Nothing
End Function
Public Sub CLICKIZDO()
mouse_event(MOUSEEVENTF_LEFTDOWN, PUNTOX, PUNTOY, 0, 0)
mouse_event(MOUSEEVENTF_LEFTUP, PUNTOX, PUNTOY, 0, 0)
End Sub
Public Sub CLICKDCHO()
mouse_event(MOUSEEVENTF_RIGHTDOWN, PUNTOX, PUNTOY, 0, 0)
mouse_event(MOUSEEVENTF_RIGHTUP, PUNTOX, PUNTOY, 0, 0)
End Sub
Private Sub MOVERMOUSE()
Cursor = New Cursor(Cursor.Current.Handle)
Cursor.Position = New Point(PUNTOX, PUNTOY)
End Sub
Public Sub INSTRUCCIONES() 'ORDENES QUE EJECUTA EL RECEPTORMENSAJES
Select Case (LabelORDENRECIBIDA.Text.ToUpper)
Case "ARRIBA"
PUNTOX = Cursor.Position.X
PUNTOY = Cursor.Position.Y - 25
MOVERMOUSE()
Case "ABAJO"
PUNTOX = Cursor.Position.X
PUNTOY = Cursor.Position.Y + 25
MOVERMOUSE()
Case "IZQUIERDA"
PUNTOX = Cursor.Position.X - 25
PUNTOY = Cursor.Position.Y
MOVERMOUSE()
Case "DERECHA"
PUNTOX = Cursor.Position.X + 25
PUNTOY = Cursor.Position.Y
MOVERMOUSE()
Case "PARA"
PUNTOX = Cursor.Position.X
PUNTOY = Cursor.Position.Y
MOVERMOUSE()
Case "INTRO"
CLICKIZDO()
Case "DOBLE"
CLICKIZDO()
CLICKIZDO()
Case "STANDBY"
TimerSTANBY.Enabled = True
End Select
End Sub
Public Sub CAPTURA()
'CAPTURA DE PANTALLA
Dim BM As Bitmap
BM = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Dim DIBUJO As Graphics
DIBUJO = Graphics.FromImage(BM)
DIBUJO.CopyFromScreen(0, 0, 0, 0, Screen.PrimaryScreen.Bounds.Size)
DIBUJO.DrawImage(BM, 0, 0, BM.Width, BM.Height)
'AÑADE EL CURSOR
Dim BM3 As Bitmap
BM3 = New Bitmap(BM)
Dim DIBUJO3 As Graphics
DIBUJO3 = Graphics.FromImage(BM3)
DIBUJO3.FillEllipse(Brushes.Black, Cursor.Position.X, Cursor.Position.Y, 30, 30)
DIBUJO3.DrawImage(BM3, 0, 0, BM.Width, BM.Height)
'REDUCE TAMAÑO PARA EVITAR PROBLEMAS BUFFER
BM2 = New Bitmap(CInt(BM3.Width / TextBoxTAMAÑO.Text), CInt(BM3.Height / TextBoxTAMAÑO.Text))
Dim DIBUJO2 As Graphics
DIBUJO2 = Graphics.FromImage(BM2)
DIBUJO2.DrawImage(BM3, 0, 0, BM2.Width, BM2.Height)
End Sub
Public Sub BLOQUEARTEXTBOXES()
TextBoxIPENVIAIMAGENES.ReadOnly = True
TextBoxIPRECIBEIMAGENES.ReadOnly = True
TextBoxTAMAÑO.ReadOnly = True
TextBoxTIEMPO.ReadOnly = True
End Sub
Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
If ButtonSTANDBY.BackColor = Color.Red Then
MsgBox("HASTA PRONTO")
ElseIf ButtonRECIBEIMAGENES.BackColor = Color.Red Then
LabelORDENENVIADA.Text = "STANDBY"
MsgBox("SE HA ACTIVADO STANDBY EN ESCRITORIO REMOTO")
End If
End Sub
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
RECEPTOR.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTOR.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORMENSAJES.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTORMENSAJES.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
End Sub
Private Sub ButtonSTANDBY_Click(sender As System.Object, e As System.EventArgs) Handles ButtonSTANDBY.Click
ButtonSTANDBY.BackColor = Color.Red
BLOQUEARTEXTBOXES()
TextBoxIPENVIAIMAGENES.Visible = False
LabelORDENENVIADA.Visible = False
LabelORDENRECIBIDA.Text = "STANDBY"
TimerSTANBY.Interval = CInt(TextBoxTIEMPO.Text)
TimerSTANBY.Enabled = True
Me.WindowState = FormWindowState.Minimized
End Sub
Private Sub ButtonRECIBEIMAGENES_Click(sender As System.Object, e As System.EventArgs) Handles ButtonRECIBEIMAGENES.Click
ButtonRECIBEIMAGENES.BackColor = Color.Red
BLOQUEARTEXTBOXES()
TextBoxIPRECIBEIMAGENES.Visible = False
LabelORDENRECIBIDA.Visible = False
LabelORDENENVIADA.Text = "DESPIERTA"
TimerRECIBEIMAGENES.Enabled = True
TimerENVIAMENSAJES.Enabled = True
End Sub
Private Sub TimerENVIAIMAGENES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerENVIAIMAGENES.Tick
'ENVIA
CAPTURA()
ENVIANTE.Connect(TextBoxIPRECIBEIMAGENES.Text, 2000) 'SE CONECTA CON EL RECEPTOR
Dim ARRAY As New MemoryStream()
BM2.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 TimerRECIBEIMAGENES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerRECIBEIMAGENES.Tick
'RECIBE
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 TimerENVIAMENSAJES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerENVIAMENSAJES.Tick
ENVIANTEMENSAJES.Connect(TextBoxIPENVIAIMAGENES.Text, 3000) 'SE CONECTA CON EL RECEPTOR
Dim mensaje As Byte() = UTF7.GetBytes(LabelORDENENVIADA.Text) 'CODIFICA EN BYTES
ENVIANTEMENSAJES.Send(mensaje, mensaje.Length) 'ENVIA EL MENSAJE
End Sub
Private Sub TimerRECIBEMENSAJES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerRECIBEMENSAJES.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
LabelORDENRECIBIDA.Text = UTF7.GetString(RECIBEMENSAJE) 'DECODIFICA EL MENSAJE A STRING
INSTRUCCIONES() 'ORDENES QUE EJECUTA EL OTRO ORDENADOR
Catch ex As Exception
End Try
End Sub
Private Sub TimerSTANBY_Tick(sender As System.Object, e As System.EventArgs) Handles TimerSTANBY.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
LabelORDENRECIBIDA.Text = UTF7.GetString(RECIBEMENSAJE) 'DECODIFICA EL MENSAJE A STRING
If LabelORDENRECIBIDA.Text = "DESPIERTA" Then
LabelORDENRECIBIDA.Visible = False
TimerENVIAIMAGENES.Enabled = True
TimerRECIBEMENSAJES.Enabled = True
TimerSTANBY.Enabled = False
End If
Catch ex As Exception
End Try
End Sub
Private Sub ButtonGUARDAIMAGENES_Click(sender As System.Object, e As System.EventArgs) Handles ButtonGUARDAIMAGENES.Click
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
PictureBox1.Image.Save(SaveFileDialog1.FileName & ".JPG", Imaging.ImageFormat.Jpeg)
End If
End Sub
Private Sub ButtonOCULTA_Click(sender As System.Object, e As System.EventArgs) Handles ButtonOCULTA.Click
ButtonOCULTA.BackColor = Color.Red
TextBoxIPENVIAIMAGENES.Visible = False
TextBoxIPRECIBEIMAGENES.Visible = False
TextBoxTAMAÑO.Visible = False
TextBoxTIEMPO.Visible = False
End Sub
End Class
Imports System.Text.Encoding
Imports System.Net
Imports System.IO
Imports System.Runtime.InteropServices
Public Class Form1
Dim ENVIANTE As New UdpClient() 'IMAGENES
Dim RECEPTOR As New UdpClient(2000) 'IMAGENES
Dim ENVIANTEMENSAJES As New UdpClient() ' MENSAJES
Dim RECEPTORMENSAJES As New UdpClient(3000) ' MENSAJES
Dim BM2 As Bitmap
Dim PUNTOX As Integer
Dim PUNTOY As Integer
<DllImport("user32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Sub mouse_event(dwFlags As Integer, dx As Integer, dy As Integer, cButtons As Integer, dwExtraInfo As Integer)
End Sub
Private Const MOUSEEVENTF_LEFTDOWN As Integer = &H2
Private Const MOUSEEVENTF_LEFTUP As Integer = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Integer = &H8
Private Const MOUSEEVENTF_RIGHTUP As Integer = &H10
Protected Overrides Function ProcessCmdKey( _
ByRef msg As System.Windows.Forms.Message, _
ByVal keyData As System.Windows.Forms.Keys) As Boolean
Select Case keyData
Case Keys.Up
LabelORDENENVIADA.Text = "ARRIBA"
Case Keys.Down
LabelORDENENVIADA.Text = "ABAJO"
Case Keys.Left
LabelORDENENVIADA.Text = "IZQUIERDA"
Case Keys.Right
LabelORDENENVIADA.Text = "DERECHA"
Case Keys.S
LabelORDENENVIADA.Text = "PARA"
Case Keys.Enter
LabelORDENENVIADA.Text = "INTRO"
Case Keys.D
LabelORDENENVIADA.Text = "DOBLE"
End Select
Return Nothing
End Function
Public Sub CLICKIZDO()
mouse_event(MOUSEEVENTF_LEFTDOWN, PUNTOX, PUNTOY, 0, 0)
mouse_event(MOUSEEVENTF_LEFTUP, PUNTOX, PUNTOY, 0, 0)
End Sub
Public Sub CLICKDCHO()
mouse_event(MOUSEEVENTF_RIGHTDOWN, PUNTOX, PUNTOY, 0, 0)
mouse_event(MOUSEEVENTF_RIGHTUP, PUNTOX, PUNTOY, 0, 0)
End Sub
Private Sub MOVERMOUSE()
Cursor = New Cursor(Cursor.Current.Handle)
Cursor.Position = New Point(PUNTOX, PUNTOY)
End Sub
Public Sub INSTRUCCIONES() 'ORDENES QUE EJECUTA EL RECEPTORMENSAJES
Select Case (LabelORDENRECIBIDA.Text.ToUpper)
Case "ARRIBA"
PUNTOX = Cursor.Position.X
PUNTOY = Cursor.Position.Y - 25
MOVERMOUSE()
Case "ABAJO"
PUNTOX = Cursor.Position.X
PUNTOY = Cursor.Position.Y + 25
MOVERMOUSE()
Case "IZQUIERDA"
PUNTOX = Cursor.Position.X - 25
PUNTOY = Cursor.Position.Y
MOVERMOUSE()
Case "DERECHA"
PUNTOX = Cursor.Position.X + 25
PUNTOY = Cursor.Position.Y
MOVERMOUSE()
Case "PARA"
PUNTOX = Cursor.Position.X
PUNTOY = Cursor.Position.Y
MOVERMOUSE()
Case "INTRO"
CLICKIZDO()
Case "DOBLE"
CLICKIZDO()
CLICKIZDO()
Case "STANDBY"
TimerSTANBY.Enabled = True
End Select
End Sub
Public Sub CAPTURA()
'CAPTURA DE PANTALLA
Dim BM As Bitmap
BM = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Dim DIBUJO As Graphics
DIBUJO = Graphics.FromImage(BM)
DIBUJO.CopyFromScreen(0, 0, 0, 0, Screen.PrimaryScreen.Bounds.Size)
DIBUJO.DrawImage(BM, 0, 0, BM.Width, BM.Height)
'AÑADE EL CURSOR
Dim BM3 As Bitmap
BM3 = New Bitmap(BM)
Dim DIBUJO3 As Graphics
DIBUJO3 = Graphics.FromImage(BM3)
DIBUJO3.FillEllipse(Brushes.Black, Cursor.Position.X, Cursor.Position.Y, 30, 30)
DIBUJO3.DrawImage(BM3, 0, 0, BM.Width, BM.Height)
'REDUCE TAMAÑO PARA EVITAR PROBLEMAS BUFFER
BM2 = New Bitmap(CInt(BM3.Width / TextBoxTAMAÑO.Text), CInt(BM3.Height / TextBoxTAMAÑO.Text))
Dim DIBUJO2 As Graphics
DIBUJO2 = Graphics.FromImage(BM2)
DIBUJO2.DrawImage(BM3, 0, 0, BM2.Width, BM2.Height)
End Sub
Public Sub BLOQUEARTEXTBOXES()
TextBoxIPENVIAIMAGENES.ReadOnly = True
TextBoxIPRECIBEIMAGENES.ReadOnly = True
TextBoxTAMAÑO.ReadOnly = True
TextBoxTIEMPO.ReadOnly = True
End Sub
Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
If ButtonSTANDBY.BackColor = Color.Red Then
MsgBox("HASTA PRONTO")
ElseIf ButtonRECIBEIMAGENES.BackColor = Color.Red Then
LabelORDENENVIADA.Text = "STANDBY"
MsgBox("SE HA ACTIVADO STANDBY EN ESCRITORIO REMOTO")
End If
End Sub
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
RECEPTOR.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTOR.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORMENSAJES.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTORMENSAJES.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
End Sub
Private Sub ButtonSTANDBY_Click(sender As System.Object, e As System.EventArgs) Handles ButtonSTANDBY.Click
ButtonSTANDBY.BackColor = Color.Red
BLOQUEARTEXTBOXES()
TextBoxIPENVIAIMAGENES.Visible = False
LabelORDENENVIADA.Visible = False
LabelORDENRECIBIDA.Text = "STANDBY"
TimerSTANBY.Interval = CInt(TextBoxTIEMPO.Text)
TimerSTANBY.Enabled = True
Me.WindowState = FormWindowState.Minimized
End Sub
Private Sub ButtonRECIBEIMAGENES_Click(sender As System.Object, e As System.EventArgs) Handles ButtonRECIBEIMAGENES.Click
ButtonRECIBEIMAGENES.BackColor = Color.Red
BLOQUEARTEXTBOXES()
TextBoxIPRECIBEIMAGENES.Visible = False
LabelORDENRECIBIDA.Visible = False
LabelORDENENVIADA.Text = "DESPIERTA"
TimerRECIBEIMAGENES.Enabled = True
TimerENVIAMENSAJES.Enabled = True
End Sub
Private Sub TimerENVIAIMAGENES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerENVIAIMAGENES.Tick
'ENVIA
CAPTURA()
ENVIANTE.Connect(TextBoxIPRECIBEIMAGENES.Text, 2000) 'SE CONECTA CON EL RECEPTOR
Dim ARRAY As New MemoryStream()
BM2.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 TimerRECIBEIMAGENES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerRECIBEIMAGENES.Tick
'RECIBE
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 TimerENVIAMENSAJES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerENVIAMENSAJES.Tick
ENVIANTEMENSAJES.Connect(TextBoxIPENVIAIMAGENES.Text, 3000) 'SE CONECTA CON EL RECEPTOR
Dim mensaje As Byte() = UTF7.GetBytes(LabelORDENENVIADA.Text) 'CODIFICA EN BYTES
ENVIANTEMENSAJES.Send(mensaje, mensaje.Length) 'ENVIA EL MENSAJE
End Sub
Private Sub TimerRECIBEMENSAJES_Tick(sender As System.Object, e As System.EventArgs) Handles TimerRECIBEMENSAJES.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
LabelORDENRECIBIDA.Text = UTF7.GetString(RECIBEMENSAJE) 'DECODIFICA EL MENSAJE A STRING
INSTRUCCIONES() 'ORDENES QUE EJECUTA EL OTRO ORDENADOR
Catch ex As Exception
End Try
End Sub
Private Sub TimerSTANBY_Tick(sender As System.Object, e As System.EventArgs) Handles TimerSTANBY.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
LabelORDENRECIBIDA.Text = UTF7.GetString(RECIBEMENSAJE) 'DECODIFICA EL MENSAJE A STRING
If LabelORDENRECIBIDA.Text = "DESPIERTA" Then
LabelORDENRECIBIDA.Visible = False
TimerENVIAIMAGENES.Enabled = True
TimerRECIBEMENSAJES.Enabled = True
TimerSTANBY.Enabled = False
End If
Catch ex As Exception
End Try
End Sub
Private Sub ButtonGUARDAIMAGENES_Click(sender As System.Object, e As System.EventArgs) Handles ButtonGUARDAIMAGENES.Click
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
PictureBox1.Image.Save(SaveFileDialog1.FileName & ".JPG", Imaging.ImageFormat.Jpeg)
End If
End Sub
Private Sub ButtonOCULTA_Click(sender As System.Object, e As System.EventArgs) Handles ButtonOCULTA.Click
ButtonOCULTA.BackColor = Color.Red
TextBoxIPENVIAIMAGENES.Visible = False
TextBoxIPRECIBEIMAGENES.Visible = False
TextBoxTAMAÑO.Visible = False
TextBoxTIEMPO.Visible = False
End Sub
End Class
Usar la WebCam del PC como Camara de Vigilancia con Visual Basic (VB.NET)
CODIGO:
FORM1
Imports System.Runtime.InteropServices
Public Class Form1
Dim DATOS As IDataObject
Dim IMAGEN As Image
Dim CARPETA_VIDEOS As String = "C:\MI WEBCAM\CARPETA VIDEOS\"
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
Dim SUBCARPETA As String
Dim CARPETAS_DIARIAS As String = "C:\MI WEBCAM\CARPETAS DIARIAS\"
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
'Open View
Public Sub OpenPreviewWindow()
' Open Preview window in picturebox
'
hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
480, VISOR.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, VISOR.Width, VISOR.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
Else
' Error connecting to device close window
'
DestroyWindow(hHwnd)
End If
End Sub
Private Sub INICIAR_Click(sender As Object, e As EventArgs) Handles INICIAR.Click
'Load And Capture Device
OpenPreviewWindow()
INICIAR.Visible = False
End Sub
Private Sub CAPTURAR_Click(sender As Object, e As EventArgs) Handles CAPTURAR.Click
' 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()
IMAGEN = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
CAPTURA.PCAPTURA.Image = IMAGEN
CAPTURA.Show()
End Sub
Private Sub GUARDAR_Click(sender As Object, e As EventArgs) Handles GUARDAR.Click
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
Dim CARPETA_CAPTURAS As String = "C:\MI WEBCAM\CARPETA CAPTURAS"
If My.Computer.FileSystem.DirectoryExists(CARPETA_CAPTURAS) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETA_CAPTURAS)
End If
IMAGEN.Save(CARPETA_CAPTURAS & "\" & FECHA & ".Jpg", Imaging.ImageFormat.Jpeg)
CAPTURA.Close()
End Sub
Private Sub GRABAR_Click(sender As Object, e As EventArgs) Handles GRABAR.Click
If My.Computer.FileSystem.DirectoryExists(CARPETA_VIDEOS) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETA_VIDEOS)
End If
SendMessage(hHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
SendMessage(hHwnd, WM_CAP_SEQUENCE, 0, 0)
End Sub
Private Sub FGRABAR_Click(sender As Object, e As EventArgs) Handles FGRABAR.Click
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
SendMessage(hHwnd, WM_CAP_STOP, 0, 0)
SendMessage(hHwnd, WM_CAP_FILE_SAVEAS, 0, CARPETA_VIDEOS & FECHA & ".mpg")
My.Computer.FileSystem.DeleteFile("C:\CAPTURE.avi")
End Sub
Private Sub FORMATO_Click(sender As Object, e As EventArgs) Handles FORMATO.Click
SendMessage(hHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
End Sub
Private Sub ButtonSERIEDIARIA_Click(sender As Object, e As EventArgs) Handles ButtonSERIEDIARIA.Click
If My.Computer.FileSystem.DirectoryExists(CARPETAS_DIARIAS) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETAS_DIARIAS)
End If
SUBCARPETA = DateTime.Now.ToShortDateString().Replace("/", "_") & "\"
If My.Computer.FileSystem.DirectoryExists(CARPETAS_DIARIAS & SUBCARPETA) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETAS_DIARIAS & SUBCARPETA)
End If
Timer1.Enabled = True
End Sub
Private Sub ButtonFINSERIEDIARIA_Click(sender As Object, e As EventArgs) Handles ButtonFINSERIEDIARIA.Click
Timer1.Enabled = False
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
' 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()
IMAGEN = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
CAPTURA.PCAPTURA.Image = IMAGEN
Try
CAPTURA.PCAPTURA.Image.Save(CARPETAS_DIARIAS & SUBCARPETA & FECHA & ".Jpg", Imaging.ImageFormat.Jpeg)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If Button1.Text = "DETECCION" Then
Timer2.Enabled = True
DETECCION.Show()
Else
Label3.Visible = False
Label1.Visible = False
Timer2.Enabled = False
Button1.Text = "DETECCION"
Button1.BackColor = Color.Black
DETECCION.Timer1.Enabled = False
DETECCION.Timer2.Enabled = False
DETECCION.Close()
End If
End Sub
Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
' Get image from clipboard and convert it to a bitmap
'
DATOS = Clipboard.GetDataObject()
IMAGEN = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
DETECCION.PictureBox1.Image = IMAGEN
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
DETALLES.TextBox1.Text = TextBox1.Text
DETALLES.Show()
End Sub
End Class
CAPTURA
Public Class CAPTURA
End Class
DETECCION
Public Class DETECCION
Dim CARPETA As String = "C:\MI WEBCAM\CARPETAS DETECCION\"
Dim DIAS As Integer
Dim INTERVALO As Integer
Dim DATOS As IDataObject
Dim IMAGEN As Image
Dim CONTADOR As Integer = 0
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'MUESTRA QUE EN ESTE MOMENTO NO HA DETECTADO AMENAZAS
Form1.Label1.Visible = True
'RESALTA EL BOTON PARA PARAR LA DETECCION
Form1.Button1.BackColor = Color.Blue
Form1.Button1.Text = "PARAR DETECCION"
'TOMA EL NUMERO DE DIAS PARA LA ANTIGÜEDAD QUE SE QUIERE CONSERVAR
DIAS = CInt(TextBox2.Text)
' SI HAY CARPETAS MAS ANTIGUAS QUE LAS DESEADAS ELIMINALAS
If My.Computer.FileSystem.DirectoryExists(CARPETA) Then
ELIMINAR()
End If
'TOMA EL NUMERO DE IMAGENES POR MINUTO A GUARDAR POR DETECCION DE MOVIMIENTO
INTERVALO = CInt(TextBox1.Text)
Timer2.Interval = 1000 * 60 / INTERVALO
'SI NO EXISTE EL DIRECTORIO CARPETAS DIARIAS LO CREARA, SI EXISTE NO HARA NADA
If My.Computer.FileSystem.FileExists(CARPETA) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETA)
End If
'COPIA LA IMAGEN DE LA WEBCAM EN EL PICTUREBOX2 DE ESTE FORMULARIO PARA COMPARAR
PictureBox2.Image = PictureBox1.Image
'PONE EN MARCHA EL RELOJ PARA HACER COMPARACIONES
Timer1.Enabled = True
WindowState = FormWindowState.Minimized
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
'COMPARACION DE PIXELES ENTRE PICTUREBOX1 Y PICTUREBOX2
Dim BITMAP1 As Bitmap
Dim BITMAP2 As Bitmap
Dim ROJO As Integer = 0
Dim VERDE As Integer = 0
Dim AZUL As Integer = 0
Dim X, Y As Integer
BITMAP1 = PictureBox1.Image
BITMAP2 = PictureBox2.Image
For Y = 0 To BITMAP1.Height - 1 Step 10
For X = 0 To BITMAP1.Width - 1 Step 10
Dim MICOLOR1 As Color = BITMAP1.GetPixel(X, Y)
Dim MICOLOR2 As Color = BITMAP2.GetPixel(X, Y)
If Math.Abs(CInt(MICOLOR1.R) - CInt(MICOLOR2.R)) > 20 Then
ROJO = ROJO + 1
End If
If Math.Abs(CInt(MICOLOR1.G) - CInt(MICOLOR2.G)) > 20 Then
VERDE = VERDE + 1
End If
If Math.Abs(CInt(MICOLOR1.B) - CInt(MICOLOR2.B)) > 20 Then
AZUL = AZUL + 1
End If
Next
Next
Dim SUMA As Integer = ROJO + VERDE + AZUL
' SI LA SUMA DE LAS DIFERENCIAS ES SUFICIENTEMENTE GRANDE ALARMA Y EMPIEZA A GUARDAR IMAGENES
If SUMA > 500 Then
Beep()
Form1.TextBox1.Text = Form1.TextBox1.Text + vbCrLf & "NUEVA DETECCION:" & vbCrLf & DateTime.Now.ToShortDateString & " HORA: " & DateTime.Now.ToLongTimeString & vbCrLf
Form1.Label3.Visible = True
Form1.Button2.Visible = True
Timer1.Enabled = False
Timer2.Enabled = True
Form1.Label1.Visible = False
End If
End Sub
Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
' CADA MINUTO COMPRUEBA SI SIGUEN HABIENDO CAMBIOS EN LA IMAGEN
If CONTADOR > INTERVALO Then
CONTADOR = 0
PictureBox2.Image = PictureBox1.Image
Timer1.Enabled = True
Timer2.Enabled = False
Form1.Label1.Visible = True
Else
'VAMOS A COMPONER EL NOMBRE DE LAS SUBCARPETAS CON FORMATO AÑO/MES/DIA PARA QUE SE
'ORDENEN DE MAS NUEVA A MAS ANTIGUA
Dim SUBCARPETA_AA As String
SUBCARPETA_AA = DateTime.Today.Year
Dim SUBCARPETA_MM As String
SUBCARPETA_MM = DateTime.Today.Month
If SUBCARPETA_MM < 10 Then
SUBCARPETA_MM = "0" & SUBCARPETA_MM
End If
Dim SUBCARPETA_DD As String
SUBCARPETA_DD = DateTime.Today.Day
If SUBCARPETA_DD < 10 Then
SUBCARPETA_DD = "0" & SUBCARPETA_DD
End If
'EL NOMBRE DE LA SUBCARPETA SE COMPONDRA CON LAS ANTERIORES SEPARADAS POR _ E
'INCLUYE LA BARRA SEPARADORA DE CARPETAS
Dim SUBCARPETA As String
SUBCARPETA = SUBCARPETA_AA & "_" & SUBCARPETA_MM & "_" & SUBCARPETA_DD & "\"
'SI NO EXISTE LA SUBCARPETA LA CREARA, SI EXISTE NO HARA NADA
If My.Computer.FileSystem.FileExists(CARPETA & SUBCARPETA) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETA & SUBCARPETA)
End If
'GUARDA LAS IMAGENES DE LA DETECCION
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
PictureBox1.Image.Save(CARPETA & "\" & SUBCARPETA & FECHA & ".JPG", Imaging.ImageFormat.Jpeg)
'PARA CALCULAR UN MINUTO DE GRABACION
CONTADOR = CONTADOR + 1
End If
End Sub
Public Sub ELIMINAR()
'DEFINIMOS EL NUMERO DE DIAS DE SEGURIDAD Y LO CONVERTIMOS EN INTERVALO DE TIEMPO
Dim MENOS As TimeSpan
MENOS = New TimeSpan(-DIAS, 0, 0, 0)
'CAPTURAMOS LA FECHA ACTUAL
Dim FECHA_ACTUAL As DateTime
FECHA_ACTUAL = DateTime.Today
'DETERMINAMOS LA FECHA DE SEGURIDAD
Dim FECHA_SEGURIDAD As DateTime
FECHA_SEGURIDAD = FECHA_ACTUAL.Add(MENOS)
'DESCOMPONEMOS LA FECHA MAXIMA EN SUS ELEMENTOS Y AÑADIMOS 0 SI EL MES O DIA < 10
Dim FECHA_MAXIMA_AÑO As String
FECHA_MAXIMA_AÑO = FECHA_SEGURIDAD.Year
Dim FECHA_MAXIMA_MES As String
FECHA_MAXIMA_MES = FECHA_SEGURIDAD.Month
If FECHA_MAXIMA_MES < 10 Then
FECHA_MAXIMA_MES = "0" & FECHA_MAXIMA_MES
End If
Dim FECHA_MAXIMA_DIA As String
FECHA_MAXIMA_DIA = FECHA_SEGURIDAD.Day
If FECHA_MAXIMA_DIA < 10 Then
FECHA_MAXIMA_DIA = "0" & FECHA_MAXIMA_DIA
End If
' COMPONEMOS LA FECHA EN EL MISMO FORMATO QUE COMPUSIMOS LAS SUBCARPETAS
Dim FECHA_COMPARACION As String
FECHA_COMPARACION = FECHA_MAXIMA_AÑO & "_" & FECHA_MAXIMA_MES & "_" & FECHA_MAXIMA_DIA
'CREAMOS UN ARRAY CON LOS NOMBRES DE LAS SUBCARPETAS QUE CONTIENE "CARPETAS DIARIAS"
Dim SUBCARPETAS As System.Collections.ObjectModel.ReadOnlyCollection(Of String)
SUBCARPETAS = My.Computer.FileSystem.GetDirectories(CARPETA)
'SI HAY MAS CARPETAS QUE DIAS DE SEGURIDAD ELIMINAREMOS LAS MAS ANTIGUAS
'RECORREMOS TODO EL ARRAY
For I = 0 To SUBCARPETAS.Count - 1
'DEJAMOS SOLO LA PARTE FINAL DEL NOMBRE DE LA SUBCARPETA
Dim INDICE As Integer
INDICE = SUBCARPETAS(I).LastIndexOf("\")
Dim SUBCARPETA_NOMBRE As String
SUBCARPETA_NOMBRE = SUBCARPETAS(I).Substring(INDICE + 1, 10)
'SI LA PARTE FINAL DEL NOMBRE DE LA SUBCARPETA ES MENOR O IGUAL QUE LA FECHA DE COMPARACION
'ELIMINALA
If SUBCARPETA_NOMBRE <= FECHA_COMPARACION Then
My.Computer.FileSystem.DeleteDirectory(SUBCARPETAS(I), FileIO.DeleteDirectoryOption.DeleteAllContents)
End If
Next
End Sub
End Class
DETALLES
Public Class DETALLES
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
My.Computer.FileSystem.WriteAllText("C:\MI WEBCAM\CARPETAS DETECCION\INFORME DETECCION.txt", TextBox1.Text, True)
MsgBox("INFORME GUARDADO")
Me.Close()
End Sub
End Class
05-Chat de Video,Ver Escritorio Remoto, VideoVigilancia,VideoConferencia (VB.NET)
CODIGO:
FORM1
Imports System.Net.Sockets
Imports System.Text.Encoding
Imports System.Net
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Speech.Recognition
Imports System.Drawing.Imaging
Public Class Form1
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
Dim ENVIANTEMENSAJES As New UdpClient() ' MENSAJES
Dim RECEPTORMENSAJES As New UdpClient(3000) ' MENSAJES
Dim ENVIANTEAUDIO As New UdpClient() ' AUDIO
Dim RECEPTORAUDIO As New UdpClient(4000) ' AUDIO
Dim ENVIANTEARCHIVO As New UdpClient() ' ARCHIVOS
Dim RECEPTORARCHIVO As New UdpClient(5000) ' ARCHIVOS
Dim ARCHIVO_RECIBIDO As String = "C:\ULTIMA_GRABACION_RECIBIDA.WAV"
Dim ARCHIVO_ENVIADO As String = "C:\ULTIMA_GRABACION_ENVIADA.WAV"
Dim SERVIDOR As TcpListener
Dim CLIENTE As TcpClient
Dim ARCHIVO As String
Dim ENVIANTEESCRITORIO As New UdpClient() ' ESCRITORIO
Dim RECEPTORESCRITORIO As New UdpClient(6000) 'ESCRITORIO
Dim BM As Bitmap
Dim BM2 As Bitmap
Dim DIBUJO As Graphics
Dim AJUSTETAMAÑO As Integer = 4
Private Const TAMAÑOBUFFER As Integer = 1024
Dim REC As New SpeechRecognitionEngine
<DllImport("winmm.dll")> _
Private Shared Function mciSendString(ByVal command As String, ByVal buffer As String, ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr) As Integer
End Function
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
RECEPTOR.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTOR.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORMENSAJES.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTORMENSAJES.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RECEPTORAUDIO.Client.ReceiveTimeout = 100 'TIEMPO PARA PASAR A ESPERA
RECEPTORAUDIO.Client.Blocking = False 'RECEPTOR NO BLOQUEADO
RELOJMENSAJE.Enabled = True
RELOJRECIBEAUDIO.Enabled = True
End Sub
'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.BackColor = Color.Red
'Load And Capture Device
OpenPreviewWindow()
End Sub
Private Sub ButtonCONECTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONECTAR.Click
ButtonCONECTAR.BackColor = Color.Red
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
Private Sub ButtonENVIAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonENVIAR.Click
ENVIAR_MENSAJEPC()
TextBoxMENSAJE.Text = ""
TextBoxMENSAJE.Focus()
End Sub
Public Sub ENVIAR_MENSAJEPC()
ENVIANTEMENSAJES.Connect(LabelIP.Text, 3000) 'SE CONECTA CON EL RECEPTOR
Dim mensaje As Byte() = UTF7.GetBytes(TextBoxMENSAJE.Text) 'CODIFICA EN BYTES
ENVIANTEMENSAJES.Send(mensaje, mensaje.Length) 'ENVIA EL MENSAJE
End Sub
Private Sub RELOJMENSAJE_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJMENSAJE.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
LabelMENSAJERECIBIDO.Text = UTF7.GetString(RECIBEMENSAJE) 'DECODIFICA EL MENSAJE A STRING
INSTRUCCIONES() 'ORDENES QUE EJECUTA EL OTRO ORDENADOR
Catch ex As Exception
End Try
End Sub
Public Sub INSTRUCCIONES() 'ORDENES QUE EJECUTA EL OTRO ORDENADOR
Select Case (LabelMENSAJERECIBIDO.Text.ToUpper)
Case "AZUL"
BackColor = Color.Blue
Case "ROJO"
BackColor = Color.Red
Case "VERDE"
BackColor = Color.Green
Case "NEGRO"
BackColor = Color.Black
Case "BLANCO"
BackColor = Color.White
Case "NOTAS"
notepad()
End Select
End Sub
Private Sub ButtonHABLAR_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ButtonHABLAR.MouseDown
ButtonHABLAR.BackColor = Color.Red
mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
mciSendString("record recsound", "", 0, 0)
End Sub
Private Sub ButtonHABLAR_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ButtonHABLAR.MouseUp
ButtonHABLAR.BackColor = Color.Black
mciSendString("save recsound " & ARCHIVO_ENVIADO, "", 0, 0)
mciSendString("close recsound ", "", 0, 0)
ENVIANTEAUDIO.Connect(LabelIP.Text, 4000) 'SE CONECTA CON EL RECEPTOR
Dim VOZ_ENVIAR As Byte() = System.IO.File.ReadAllBytes(ARCHIVO_ENVIADO) 'CODIFICA EN BYTES
ENVIANTEAUDIO.Send(VOZ_ENVIAR, VOZ_ENVIAR.Length) 'ENVIA EL MENSAJE
My.Computer.FileSystem.DeleteFile(ARCHIVO_ENVIADO)
End Sub
Private Sub RELOJRECIBEAUDIO_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJRECIBEAUDIO.Tick
Try
Dim IP As IPEndPoint = New IPEndPoint(IPAddress.Any, 0) 'RECIBIRA DESDE CUALQUIER IP, POR CUALQUIER PUERTO
Dim RECIBEMENSAJE As Byte() = RECEPTORAUDIO.Receive(IP) 'RECIBE EL MENSAJE EN BYTES
System.IO.File.WriteAllBytes(ARCHIVO_RECIBIDO, RECIBEMENSAJE) 'CODIFICA EN BYTES
My.Computer.Audio.Play(ARCHIVO_RECIBIDO, AudioPlayMode.WaitToComplete)
My.Computer.FileSystem.DeleteFile(ARCHIVO_RECIBIDO)
Catch ex As Exception
End Try
End Sub
Private Sub ButtonANDROID_Click(sender As System.Object, e As System.EventArgs) Handles ButtonANDROID.Click
ButtonANDROID.BackColor = Color.Red
ANDROID.Show()
End Sub
Private Sub ButtonVOZ_Click(sender As System.Object, e As System.EventArgs) Handles ButtonVOZ.Click
ButtonVOZ.BackColor = Color.Red
'GRAMATICA INICIAL
Dim INICIAL As New GrammarBuilder
INICIAL.Append(New Choices("azul", "rojo", "verde", "negro", "blanco", "notas"))
REC.LoadGrammar(New Grammar(INICIAL))
'FUNCIONES RECOGNITION
REC.SetInputToDefaultAudioDevice()
REC.RecognizeAsync(RecognizeMode.Multiple)
AddHandler REC.SpeechRecognized, AddressOf RECONOCE
End Sub
Public Sub RECONOCE(ByVal sender As Object, ByVal e As SpeechRecognizedEventArgs)
Select Case e.Result.Text
Case "azul"
TextBoxMENSAJE.Text = "AZUL"
ENVIAR_MENSAJEPC()
Case "rojo"
TextBoxMENSAJE.Text = "ROJO"
ENVIAR_MENSAJEPC()
Case "verde"
TextBoxMENSAJE.Text = "VERDE"
ENVIAR_MENSAJEPC()
Case "negro"
TextBoxMENSAJE.Text = "NEGRO"
ENVIAR_MENSAJEPC()
Case "blanco"
TextBoxMENSAJE.Text = "BLANCO"
ENVIAR_MENSAJEPC()
Case "notas"
TextBoxMENSAJE.Text = "NOTAS"
ENVIAR_MENSAJEPC()
End Select
End Sub
Private Sub notepad()
Dim notepad As New System.Diagnostics.Process
notepad.StartInfo.WorkingDirectory = "%windir%\system32\"
notepad.StartInfo.FileName = "notepad.exe"
notepad.Start()
End Sub
Private Sub ButtonENVIARARCHIVO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonENVIARARCHIVO.Click
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
ARCHIVO = OpenFileDialog1.FileName
End If
ENVIAARCHIVO(ARCHIVO, LabelIP.Text, 8050)
End Sub
Public Sub ENVIAARCHIVO(ARCHIVO As String, IP As String, PUERTO As Integer)
Dim ENVIARBUFFER As Byte()
Dim NS As NetworkStream
Try
CLIENTE = New TcpClient(IP, PUERTO)
NS = CLIENTE.GetStream
Dim FS As New FileStream(ARCHIVO, FileMode.Open, FileAccess.Read)
Dim PAQUETES As Integer = CInt(Math.Ceiling(CDbl(FS.Length) / CDbl(TAMAÑOBUFFER)))
Dim LONGITUDTOTAL As Integer = CInt(FS.Length)
Dim LONGITUDPAQUETEACTUAL As Integer = 0
Dim CONTADOR As Integer = 0
For I As Integer = 0 To PAQUETES - 1
If LONGITUDTOTAL > TAMAÑOBUFFER Then
LONGITUDPAQUETEACTUAL = TAMAÑOBUFFER
LONGITUDTOTAL = LONGITUDTOTAL - LONGITUDPAQUETEACTUAL
Else
LONGITUDPAQUETEACTUAL = LONGITUDTOTAL
End If
ENVIARBUFFER = New Byte(LONGITUDPAQUETEACTUAL - 1) {}
FS.Read(ENVIARBUFFER, 0, LONGITUDPAQUETEACTUAL)
NS.Write(ENVIARBUFFER, 0, CInt(ENVIARBUFFER.Length))
Next
FS.Close()
NS.Close()
CLIENTE.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub ButtonRECIBIRARCHIVO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonRECIBIRARCHIVO.Click
ButtonRECIBIRARCHIVO.BackColor = Color.Red
RECIBIRARCHIVO(8050)
End Sub
Public Sub RECIBIRARCHIVO(PUERTO As Integer)
Dim ARCHIVORECIBIDO As Byte() = New Byte(TAMAÑOBUFFER - 1) {}
Dim BYTESRECIBIDOS As Integer
Dim FIN As Integer = 0
While FIN = 0
Dim NS As NetworkStream = Nothing
Try
Dim ACEPTA As String = "ACEPTA EL FICHERO ENTRANTE"
Dim TITULO As String = "FICHERO ENTRANTE"
Dim BOTONES As MessageBoxButtons = MessageBoxButtons.YesNo
Dim RESULTADO As DialogResult
If SERVIDOR.Pending Then
CLIENTE = SERVIDOR.AcceptTcpClient
NS = CLIENTE.GetStream
RESULTADO = MessageBox.Show(ACEPTA, TITULO, BOTONES)
If RESULTADO = Windows.Forms.DialogResult.Yes Then
Dim FICHERORECIBIDO As String
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
FICHERORECIBIDO = SaveFileDialog1.FileName
End If
If FICHERORECIBIDO <> String.Empty Then
Dim TOTALBYTESRECIBIDOS As Integer = 0
Dim FS As New FileStream(FICHERORECIBIDO, FileMode.OpenOrCreate, FileAccess.Write)
While (AYUDAENLINEA(BYTESRECIBIDOS, NS.Read(ARCHIVORECIBIDO, 0, ARCHIVORECIBIDO.Length))) > 0
FS.Write(ARCHIVORECIBIDO, 0, BYTESRECIBIDOS)
TOTALBYTESRECIBIDOS = TOTALBYTESRECIBIDOS + BYTESRECIBIDOS
End While
FS.Close()
End If
NS.Close()
CLIENTE.Close()
MsgBox("DESCARGA FINALIZADA")
FIN = 1
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End While
End Sub
Private Shared Function AYUDAENLINEA(Of T)(ByRef OBJETIVO As T, VALOR As T)
OBJETIVO = VALOR
Return VALOR
End Function
Private Sub ButtonCONECTARENVIOARCHIVOS_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCONECTARENVIOARCHIVOS.Click
ButtonCONECTARENVIOARCHIVOS.BackColor = Color.Red
SERVIDOR = New TcpListener(8050)
SERVIDOR.Start()
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
RELOJRECIBEAUDIO.Enabled = False
RELOJWEBCAM.Enabled = False
RELOJDETECCION.Enabled = True
DETECCION_DE_MOVIMIENTO_REMOTO.Show()
Hide()
End Sub
Private Sub RELOJDETECCION_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJDETECCION.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)
DETECCION_DE_MOVIMIENTO_REMOTO.PictureBoxRECIBIR.Image = IMAGENRECIBIDA
Catch ex As Exception
End Try
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
RELOJWEBCAM.Enabled = False
ESCRITORIO.Show()
Hide()
End Sub
Private Sub RELOJESCRITORIO_Tick(sender As Object, e As EventArgs) Handles RELOJESCRITORIO.Tick
BM = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
DIBUJO = Graphics.FromImage(BM)
DIBUJO.CopyFromScreen(Screen.PrimaryScreen.Bounds.X, Screen.PrimaryScreen.Bounds.Y, 0, 0, Screen.PrimaryScreen.Bounds.Size)
BM2 = New Bitmap(CInt(BM.Width / AJUSTETAMAÑO), CInt(BM.Height / AJUSTETAMAÑO))
Dim DIBUJO2 As Graphics
DIBUJO2 = Graphics.FromImage(BM2)
DIBUJO2.DrawImage(BM, 0, 0, BM2.Width, BM2.Height)
ENVIANTEESCRITORIO.Connect(LabelIP.Text, 6000) 'SE CONECTA CON EL RECEPTOR
Dim ARRAY As New MemoryStream()
BM2.Save(ARRAY, Imaging.ImageFormat.Jpeg)
Dim IMAGEN_ARRAY As Byte() = ARRAY.ToArray
ENVIANTEESCRITORIO.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() = RECEPTORESCRITORIO.Receive(IP) 'RECIBE EL MENSAJE EN BYTES
Dim IMAGEN As New MemoryStream(RECIBEMENSAJE)
Dim IMAGENRECIBIDA As Image = Image.FromStream(IMAGEN)
ESCRITORIO.PictureBox1.Image = IMAGENRECIBIDA
Catch ex As Exception
End Try
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
RELOJWEBCAM.Enabled = True
End Sub
End Class
ANDROID:
Public Class ANDROID
Dim notepad As New System.Diagnostics.Process
Private Sub ANDROID_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
RELOJINICIO.Enabled = True
RELOJNUEVOS.Enabled = True
End Sub
Private Sub RELOJINICIO_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJINICIO.Tick
WEBINPUT.Document.All("tag").InnerText = "PC"
WEBINPUT.Document.All("value").InnerText = """" + "ESTOY CONECTADO" + """"""
WEBINPUT.Document.Forms(0).InvokeMember("submit")
RELOJINICIO.Enabled = False
RELOJLEE.Enabled = True
End Sub
Private Sub RELOJNUEVOS_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJNUEVOS.Tick
WEBDATOS.Refresh()
RELOJLEE.Enabled = True
End Sub
Private Sub RELOJLEE_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJLEE.Tick
LEE()
INSTRUCCIONES_ANDROID()
RELOJLEE.Enabled = False
End Sub
Private Sub RELOJESCRIBE_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJESCRIBE.Tick
ESCRIBE()
RELOJESCRIBE.Enabled = False
End Sub
Private Sub RELOJCIERRE_Tick(sender As System.Object, e As System.EventArgs) Handles RELOJCIERRE.Tick
WEBINPUT.Document.All("tag").InnerText = "PC"
WEBINPUT.Document.All("value").InnerText = """" + "ESTOY DESCONECTADO" + """"""
WEBINPUT.Document.Forms(0).InvokeMember("submit")
Me.Close()
End Sub
Public Sub ESCRIBE()
WEBINPUT.Document.All("tag").InnerText = "PC"
WEBINPUT.Document.All("value").InnerText = """" + TextBoxPC.Text + """"
WEBINPUT.Document.Forms(0).InvokeMember("submit")
TextBoxPC.Text = ""
End Sub
Public Sub LEE()
Dim BUSCADOR1 As Integer
If WEBDATOS.DocumentText.Contains("ANDROID</td><td>") Then
BUSCADOR1 = WEBDATOS.DocumentText.LastIndexOf("ANDROID</td><td>")
LabelANDROID.Text = WEBDATOS.DocumentText.Remove(0, BUSCADOR1 + 17)
If LabelANDROID.Text.Contains("</td><td>") Then
LabelANDROID.Text = LabelANDROID.Text.Remove(LabelANDROID.Text.IndexOf("</td><td>") - 1, LabelANDROID.Text.Length - LabelANDROID.Text.IndexOf("</td><td>") + 1)
End If
End If
End Sub
Private Sub CERRAR_Click(sender As System.Object, e As System.EventArgs) Handles CERRAR.Click
Form1.ButtonANDROID.BackColor = Color.Black
WEBINPUT.Navigate("http://androidvisualbasic.appspot.com/storeavalue") 'PON LA WEB DE TU PROPIA APLICACION
RELOJCIERRE.Enabled = True
End Sub
Private Sub ENVIAR_Click(sender As System.Object, e As System.EventArgs) Handles ENVIAR.Click
WEBINPUT.Navigate("http://androidvisualbasic.appspot.com/storeavalue") 'PON LA WEB DE TU PROPIA APLICACION
RELOJESCRIBE.Enabled = True
End Sub
Public Sub INSTRUCCIONES_ANDROID() 'ORDENES QUE EJECUTA EL ORDENADOR DESDE ANDROID
Select Case (LabelANDROID.Text.ToUpper)
Case "AZUL"
BackColor = Color.Blue
Case "ROJO"
BackColor = Color.Red
Case "VERDE"
BackColor = Color.Green
Case "NEGRO"
BackColor = Color.Black
Case "BLANCO"
BackColor = Color.White
End Select
End Sub
End Class
DETECCION DE MOVIMIENTO REMOTO
Public Class DETECCION_DE_MOVIMIENTO_REMOTO
Dim CARPETA As String = Application.StartupPath & "\CARPETAS DIARIAS\"
Dim CONTADOR As Integer = 0
Dim DIAS As Integer
Dim INTERVALO As Integer
Private Sub ButtonDETECTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonDETECTAR.Click
'TOMA EL NUMERO DE DIAS PARA LA ANTIGÜEDAD QUE SE QUIERE CONSERVAR
DIAS = CInt(TextBox1.Text)
'TOMA EL NUMERO DE IMAGENES A GUARDAR POR DETECCION DE MOVIMIENTO
INTERVALO = CInt(TextBox2.Text)
'SI NO EXISTE EL DIRECTORIO CARPETAS DIARIAS LO CREARA, SI EXISTE NO HARA NADA
If My.Computer.FileSystem.FileExists(CARPETA) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETA)
End If
ButtonDETECTAR.BackColor = Color.Red
PictureBoxPATRON.Image = PictureBoxRECIBIR.Image
TimerSTANDBY.Enabled = True
End Sub
Private Sub TimerSTANDBY_Tick(sender As System.Object, e As System.EventArgs) Handles TimerSTANDBY.Tick
Dim BITMAP1 As Bitmap
Dim BITMAP2 As Bitmap
Dim ROJO As Integer = 0
Dim VERDE As Integer = 0
Dim AZUL As Integer = 0
Dim X, Y As Integer
BITMAP1 = PictureBoxPATRON.Image
BITMAP2 = PictureBoxRECIBIR.Image
For Y = 0 To BITMAP1.Height - 1 Step 10
For X = 0 To BITMAP1.Width - 1 Step 10
Dim MICOLOR1 As Color = BITMAP1.GetPixel(X, Y)
Dim MICOLOR2 As Color = BITMAP2.GetPixel(X, Y)
If Math.Abs(CInt(MICOLOR1.R) - CInt(MICOLOR2.R)) > 20 Then
ROJO = ROJO + 1
End If
If Math.Abs(CInt(MICOLOR1.G) - CInt(MICOLOR2.G)) > 20 Then
VERDE = VERDE + 1
End If
If Math.Abs(CInt(MICOLOR1.B) - CInt(MICOLOR2.B)) > 20 Then
AZUL = AZUL + 1
End If
Next
Next
Dim SUMA As Integer = ROJO + VERDE + AZUL
If SUMA > 500 Then
Beep()
Label1.Visible = True
PictureBoxDETECTADO.Image = BITMAP2
ANDROID.TextBoxPC.Text = "DETECTADO MOVIMIENTO"
ANDROID.WEBINPUT.Navigate("http://androidvisualbasic.appspot.com/storeavalue") 'PON LA WEB DE TU PROPIA APLICACION
ANDROID.RELOJESCRIBE.Enabled = True
TimerSTANDBY.Enabled = False
TimerGRABACION.Enabled = True
End If
End Sub
Private Sub DETECCION_DE_MOVIMIENTO_REMOTO_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Form1.RELOJWEBCAM.Enabled = True
Form1.RELOJRECIBEAUDIO.Enabled = True
Form1.Show()
End Sub
Private Sub TimerGRABACION_Tick(sender As System.Object, e As System.EventArgs) Handles TimerGRABACION.Tick
If CONTADOR > INTERVALO Then
Beep()
CONTADOR = 0
ButtonDETECTAR.BackColor = Color.Red
PictureBoxPATRON.Image = PictureBoxRECIBIR.Image
TimerSTANDBY.Enabled = True
TimerGRABACION.Enabled = False
Else
'VAMOS A COMPONER EL NOMBRE DE LAS SUBCARPETAS CON FORMATO AÑO/MES/DIA PARA QUE SE
'ORDENEN DE MAS NUEVA A MAS ANTIGUA
Dim SUBCARPETA_AA As String
SUBCARPETA_AA = DateTime.Today.Year
Dim SUBCARPETA_MM As String
SUBCARPETA_MM = DateTime.Today.Month
If SUBCARPETA_MM < 10 Then
SUBCARPETA_MM = "0" & SUBCARPETA_MM
End If
Dim SUBCARPETA_DD As String
SUBCARPETA_DD = DateTime.Today.Day
If SUBCARPETA_DD < 10 Then
SUBCARPETA_DD = "0" & SUBCARPETA_DD
End If
'EL NOMBRE DE LA SUBCARPETA SE COMPONDRA CON LAS ANTERIORES SEPARADAS POR _ E
'INCLUYE LA BARRA SEPARADORA DE CARPETAS
Dim SUBCARPETA As String
SUBCARPETA = SUBCARPETA_AA & "_" & SUBCARPETA_MM & "_" & SUBCARPETA_DD & "\"
'SI NO EXISTE LA SUBCARPETA LA CREARA, SI EXISTE NO HARA NADA
If My.Computer.FileSystem.FileExists(CARPETA & SUBCARPETA) = False Then
My.Computer.FileSystem.CreateDirectory(CARPETA & SUBCARPETA)
ELIMINAR()
End If
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
PictureBoxRECIBIR.Image.Save(CARPETA & "\" & SUBCARPETA & FECHA & ".JPG", Imaging.ImageFormat.Jpeg)
CONTADOR = CONTADOR + 1
End If
End Sub
Public Sub ELIMINAR()
'DEFINIMOS EL NUMERO DE DIAS DE SEGURIDAD Y LO CONVERTIMOS EN INTERVALO DE TIEMPO
Dim INTERVALO As TimeSpan
INTERVALO = New TimeSpan(-DIAS, 0, 0, 0)
'CAPTURAMOS LA FECHA ACTUAL
Dim FECHA_ACTUAL As DateTime
FECHA_ACTUAL = DateTime.Today
'DETERMINAMOS LA FECHA DE SEGURIDAD
Dim FECHA_SEGURIDAD As DateTime
FECHA_SEGURIDAD = FECHA_ACTUAL.Add(INTERVALO)
'DESCOMPONEMOS LA FECHA MAXIMA EN SUS ELEMENTOS Y AÑADIMOS 0 SI EL MES O DIA < 10
Dim FECHA_MAXIMA_AÑO As String
FECHA_MAXIMA_AÑO = FECHA_SEGURIDAD.Year
Dim FECHA_MAXIMA_MES As String
FECHA_MAXIMA_MES = FECHA_SEGURIDAD.Month
If FECHA_MAXIMA_MES < 10 Then
FECHA_MAXIMA_MES = "0" & FECHA_MAXIMA_MES
End If
Dim FECHA_MAXIMA_DIA As String
FECHA_MAXIMA_DIA = FECHA_SEGURIDAD.Day
If FECHA_MAXIMA_DIA < 10 Then
FECHA_MAXIMA_DIA = "0" & FECHA_MAXIMA_DIA
End If
' COMPONEMOS LA FECHA EN EL MISMO FORMATO QUE COMPUSIMOS LAS SUBCARPETAS
Dim FECHA_COMPARACION As String
FECHA_COMPARACION = FECHA_MAXIMA_AÑO & "_" & FECHA_MAXIMA_MES & "_" & FECHA_MAXIMA_DIA
'CREAMOS UN ARRAY CON LOS NOMBRES DE LAS SUBCARPETAS QUE CONTIENE "CARPETAS DIARIAS"
Dim SUBCARPETAS As System.Collections.ObjectModel.ReadOnlyCollection(Of String)
SUBCARPETAS = My.Computer.FileSystem.GetDirectories(CARPETA)
'SI HAY MAS CARPETAS QUE DIAS DE SEGURIDAD ELIMINAREMOS LAS MAS ANTIGUAS
If SUBCARPETAS.Count >= DIAS Then
'RECORREMOS TODO EL ARRAY
For I = 0 To SUBCARPETAS.Count - (DIAS)
'DEJAMOS SOLO LA PARTE FINAL DEL NOMBRE DE LA SUBCARPETA
Dim INDICE As Integer
INDICE = SUBCARPETAS(I).LastIndexOf("\")
Dim SUBCARPETA_NOMBRE As String
SUBCARPETA_NOMBRE = SUBCARPETAS(I).Substring(INDICE + 1, 10)
'SI LA PARTE FINAL DEL NOMBRE DE LA SUBCARPETA ES MENOR O IGUAL QUE LA FECHA DE COMPARACION
'ELIMINALA
If SUBCARPETA_NOMBRE <= FECHA_COMPARACION Then
My.Computer.FileSystem.DeleteDirectory(SUBCARPETAS(I), FileIO.DeleteDirectoryOption.DeleteAllContents)
End If
Next
End If
End Sub
Private Sub DETECCION_DE_MOVIMIENTO_REMOTO_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Label4.Text = Form1.Label1.Text
End Sub
End Class
ESCRITORIO
Public Class ESCRITORIO
Dim CONTADOR As Integer = 1000000
Private Sub ESCRITORIO_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
Form1.RELOJESCRITORIO.Enabled = False
Form1.Show()
End Sub
Private Sub ESCRITORIO_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Label1.Text = Form1.Label1.Text
End Sub
Private Sub ButtonCONECTAR_Click(sender As Object, e As EventArgs) Handles ButtonCONECTAR.Click
Form1.RELOJESCRITORIO.Enabled = True
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Form1.RELOJESCRITORIO.Enabled = False
Form1.Show()
'Hide()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
FolderBrowserDialog1.ShowDialog()
Timer1.Enabled = True
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
PictureBox1.Image.Save(FolderBrowserDialog1.SelectedPath & "\" & CONTADOR & ".JPG", Imaging.ImageFormat.Jpeg)
CONTADOR += 1
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Timer1.Enabled = False
End Sub
End Class
LISTA DE CONTACTOS
Imports Microsoft.VisualBasic.FileIO
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
Close()
End Sub
End Class
Captura WebCam, Imagenes y Video con Visual Basic (VB Net)
Se trata de una pequeña aplicacion que permite activar la webcam del pc y tomar imagenes y grabar videos desde ella. No precisa descargar nada, todo lo empleado es Visual Studio y nada mas.
CODIGO:
FORM1
Imports System.Runtime.InteropServices
Public Class Form1
Dim DATOS As IDataObject
Dim IMAGEN As Image
Dim CARPETA As String
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
Dim DIRECTORIO As String = "C:\Users\SALVADOR\Desktop\" ' AQUI COLOCA LA RUTA A TU ESCRITORIO
Dim DESTINO As String
Dim CONTADOR As Integer = 1
Dim CARPETAS_DIARIAS As String
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
Dim DATOS As IDataObject
Dim IMAGEN As Image
Dim CARPETA As String
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
Dim DIRECTORIO As String = "C:\Users\SALVADOR\Desktop\" ' AQUI COLOCA LA RUTA A TU ESCRITORIO
Dim DESTINO As String
Dim CONTADOR As Integer = 1
Dim CARPETAS_DIARIAS As String
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 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
(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
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
(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
ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
ByVal cbVer As Integer) As Boolean
'Open View
Public Sub OpenPreviewWindow()
' Open Preview window in picturebox
'
hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
480, VISOR.Handle.ToInt32, 0)
'
hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
480, VISOR.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_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)
'
SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
'Start previewing the image from the camera
'
SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
'
SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
' Resize window to fit in picturebox
'
SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, VISOR.Width, VISOR.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
'
SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, VISOR.Width, VISOR.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
Else
' Error connecting to device close window
'
DestroyWindow(hHwnd)
' Error connecting to device close window
'
DestroyWindow(hHwnd)
End If
End Sub
End Sub
Private Sub INICIAR_Click(sender As Object, e As EventArgs) Handles INICIAR.Click
'Load And Capture Device
OpenPreviewWindow()
INICIAR.Visible = False
CAPTURAR.Visible = True
GRABAR.Visible = True
FGRABAR.Visible = True
SERIE.Visible = True
FSERIE.Visible = True
FORMATO.Visible = True
End Sub
OpenPreviewWindow()
INICIAR.Visible = False
CAPTURAR.Visible = True
GRABAR.Visible = True
FGRABAR.Visible = True
SERIE.Visible = True
FSERIE.Visible = True
FORMATO.Visible = True
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles CERRAR.Click
Close()
End Sub
Close()
End Sub
Private Sub CAPTURAR_Click(sender As Object, e As EventArgs) Handles CAPTURAR.Click
' Copy image to clipboard
'
SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
'
SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
' Get image from clipboard and convert it to a bitmap
'
DATOS = Clipboard.GetDataObject()
'
DATOS = Clipboard.GetDataObject()
IMAGEN = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
CAPTURA.PCAPTURA.Image = IMAGEN
CAPTURA.Show()
GUARDAR.Visible = True
CAPTURA.PCAPTURA.Image = IMAGEN
CAPTURA.Show()
GUARDAR.Visible = True
End Sub
Private Sub GUARDAR_Click(sender As Object, e As EventArgs) Handles GUARDAR.Click
'Set Save Dialog
'Set Save Dialog
SFD.FileName = FECHA
SFD.Title = "GUARDAR IMAGEN"
SFD.Title = "GUARDAR IMAGEN"
SFD.Filter = "Jpeg|*.jpg"
CAPTURA.TopMost = False
'If File Name Not Equal "" then Save The File
If SFD.ShowDialog = DialogResult.OK Then
IMAGEN.Save(SFD.FileName, Imaging.ImageFormat.Jpeg)
End If
CAPTURA.Close()
GUARDAR.Visible = False
End Sub
CAPTURA.TopMost = False
'If File Name Not Equal "" then Save The File
If SFD.ShowDialog = DialogResult.OK Then
IMAGEN.Save(SFD.FileName, Imaging.ImageFormat.Jpeg)
End If
CAPTURA.Close()
GUARDAR.Visible = False
End Sub
Private Sub GRABAR_Click(sender As Object, e As EventArgs) Handles GRABAR.Click
'SendMessage(hHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
FBD.ShowDialog()
CARPETA = FBD.SelectedPath
'SendMessage(hHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
FBD.ShowDialog()
CARPETA = FBD.SelectedPath
SendMessage(hHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
SendMessage(hHwnd, WM_CAP_SEQUENCE, 0, 0)
End Sub
End Sub
Private Sub FGRABAR_Click(sender As Object, e As EventArgs) Handles FGRABAR.Click
SendMessage(hHwnd, WM_CAP_STOP, 0, 0)
SendMessage(hHwnd, WM_CAP_FILE_SAVEAS, 0, CARPETA & "\" & FECHA & ".mpg")
My.Computer.FileSystem.DeleteFile("C:\CAPTURE.avi")
SendMessage(hHwnd, WM_CAP_FILE_SAVEAS, 0, CARPETA & "\" & FECHA & ".mpg")
My.Computer.FileSystem.DeleteFile("C:\CAPTURE.avi")
End Sub
Private Sub FORMATO_Click(sender As Object, e As EventArgs) Handles FORMATO.Click
SendMessage(hHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
End Sub
SendMessage(hHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
End Sub
Private Sub MINIMIZAR_Click(sender As Object, e As EventArgs) Handles MINIMIZAR.Click
WindowState = FormWindowState.Minimized
End Sub
WindowState = FormWindowState.Minimized
End Sub
Private Sub FSERIE_Click(sender As Object, e As EventArgs) Handles FSERIE.Click
RELOJ.Enabled = False
FSERIE.Visible = False
SERIE.Visible = True
End Sub
RELOJ.Enabled = False
FSERIE.Visible = False
SERIE.Visible = True
End Sub
Private Sub SERIE_Click(sender As Object, e As EventArgs) Handles SERIE.Click
CAPTURA.TopMost = False
CARPETA = InputBox("¿COMO QUIERES QUE SE LLAME LA CARPETA?.¡¡SE SITUARA EN EL ESCRITORIO!!", "CARPETA", DateString)
DESTINO = DIRECTORIO & CARPETA
My.Computer.FileSystem.CreateDirectory(DESTINO)
CAPTURA.TopMost = True
RELOJ.Enabled = True
SERIE.Visible = False
FSERIE.Visible = True
End Sub
CAPTURA.TopMost = False
CARPETA = InputBox("¿COMO QUIERES QUE SE LLAME LA CARPETA?.¡¡SE SITUARA EN EL ESCRITORIO!!", "CARPETA", DateString)
DESTINO = DIRECTORIO & CARPETA
My.Computer.FileSystem.CreateDirectory(DESTINO)
CAPTURA.TopMost = True
RELOJ.Enabled = True
SERIE.Visible = False
FSERIE.Visible = True
End Sub
Private Sub RELOJ_Tick(sender As Object, e As EventArgs) Handles RELOJ.Tick
' Copy image to clipboard
'
SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
' 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()
'
DATOS = Clipboard.GetDataObject()
IMAGEN = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
CAPTURA.PCAPTURA.Image = IMAGEN
CAPTURA.PCAPTURA.Image.Save(DESTINO & "\" & CONTADOR.ToString & ".JPG", Imaging.ImageFormat.Jpeg)
CONTADOR = CONTADOR + 1
End Sub
CAPTURA.PCAPTURA.Image.Save(DESTINO & "\" & CONTADOR.ToString & ".JPG", Imaging.ImageFormat.Jpeg)
CONTADOR = CONTADOR + 1
End Sub
Private Sub ButtonELIMINAR_CARPETAS_Click(sender As Object, e As EventArgs) Handles ButtonELIMINAR_CARPETAS.Click
CARPETAS_DIARIAS = Application.StartupPath.ToString
CARPETAS_DIARIAS = CARPETAS_DIARIAS.Replace("\bin\Debug", "\CARPETAS DIARIAS\")
Try
My.Computer.FileSystem.DeleteDirectory(CARPETAS_DIARIAS, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
CARPETAS_DIARIAS = CARPETAS_DIARIAS.Replace("\bin\Debug", "\CARPETAS DIARIAS\")
Try
My.Computer.FileSystem.DeleteDirectory(CARPETAS_DIARIAS, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub ButtonSERIEDIARIA_Click(sender As Object, e As EventArgs) Handles ButtonSERIEDIARIA.Click
CARPETAS_DIARIAS = Application.StartupPath.ToString
CARPETAS_DIARIAS = CARPETAS_DIARIAS.Replace("\bin\Debug", "\CARPETAS DIARIAS\")
CARPETAS_DIARIAS = Application.StartupPath.ToString
CARPETAS_DIARIAS = CARPETAS_DIARIAS.Replace("\bin\Debug", "\CARPETAS DIARIAS\")
Try
My.Computer.FileSystem.CreateDirectory(CARPETAS_DIARIAS)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Timer1.Enabled = True
End Sub
My.Computer.FileSystem.CreateDirectory(CARPETAS_DIARIAS)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Timer1.Enabled = True
End Sub
Private Sub ButtonFINSERIEDIARIA_Click(sender As Object, e As EventArgs) Handles ButtonFINSERIEDIARIA.Click
Timer1.Enabled = False
End Sub
Timer1.Enabled = False
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim SUBCARPETA As String
SUBCARPETA = DateTime.Now.ToShortDateString().Replace("/", "_") & "\"
SUBCARPETA = DateTime.Now.ToShortDateString().Replace("/", "_") & "\"
Try
My.Computer.FileSystem.CreateDirectory(CARPETAS_DIARIAS & SUBCARPETA)
Catch ex As Exception
MsgBox(ex.Message)
End Try
My.Computer.FileSystem.CreateDirectory(CARPETAS_DIARIAS & SUBCARPETA)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
' Copy image to clipboard
'
SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
'
SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
' Get image from clipboard and convert it to a bitmap
'
DATOS = Clipboard.GetDataObject()
'
DATOS = Clipboard.GetDataObject()
IMAGEN = CType(DATOS.GetData(GetType(System.Drawing.Bitmap)), Image)
CAPTURA.PCAPTURA.Image = IMAGEN
Try
CAPTURA.PCAPTURA.Image.Save(CARPETAS_DIARIAS & "\" & SUBCARPETA & FECHA & ".JPG", Imaging.ImageFormat.Jpeg)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Try
CAPTURA.PCAPTURA.Image.Save(CARPETAS_DIARIAS & "\" & SUBCARPETA & FECHA & ".JPG", Imaging.ImageFormat.Jpeg)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
End Class
CAPTURA
Public Class CAPTURA
Private Sub CAPTURA_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
Form1.GUARDAR.Visible = False
End Sub
End Class
Form1.GUARDAR.Visible = False
End Sub
End Class
Hola muy buenas noches creador del blog, mi pregunta es como puedo hacer que funcione como una video conferencia si lo pruebo con dos equipos funciona a la perfección pero si conecto otro equipo un tercero comienza hacer interferencia entre las camaras montrando por veces la imagen de una y otra
ResponderEliminarHola:
EliminarLa aplicación esta preparada solo para 2 ordenadores. En los próximos días intentare adaptarla para mas ordenadores. Pero no podre probarla, yo solo tengo 2 ordenadores. ¿Puedes probarla tu con varios ordenadores?.¿De cuantos ordenadores dispones?.
Saludos.
Hola, ¿hay forma de que nos puedas compartir la carpeta de proyecto de forma comprimida?, estoy empezando en esto y me da mucho error. Saludos, gracias.
ResponderEliminarHola:
EliminarEn esta pagina solo se muestra el código de varios proyectos. Puedes encontrar la descarga del proyecto que te interese a través de la nube etiquetas (arriba y a la derecha). Si tienes dificultades dime que proyecto te interesa y te ayudare a localizarlo. Saludos.
Hola...buenos aportes.
ResponderEliminarHe testeado el de captura desde webcam, perfecto, pero al ejecutarlo por segunda vez me lanza la ventana de selección de "origen de video" de windows...sabes q puede ser??...gracias...
Hola: Creo que esta relacionado con el nivel de permisos . Prueba ejecutarlo como Administrador. Saludos.
Eliminarweena...weena...jajaja...si eso era...te las mandaste...gracias...
ResponderEliminarHola que tal uso vs 2013 y cuando corro la aplicacion de la camara ip de smartphone me sale varios cuadros con advertencias diciedo no se encuentra el punto de entrada del procedimiento. sabes como podria solucionarlo
ResponderEliminarHola: No puedo responderte si ver esas advertencias. Puedes enviarme capturas de pantalla y algo mas de detalles sobre como se produce el problema a mi mail:
ResponderEliminarvb.tutoriales,abc@gmail.com.
Saludos.
hola, megusta mucho tu blog, queria ademas de felicitarte por todos tus proyectos, preguntarte si hay manera de sacar capturas del webcam si emplear el portapapeles "Copy image to clipboard" ?
ResponderEliminarSi la hay me darias un alubron de como se hace, Gracias
Hola: Si. Eso del portapapeles es cosa de la libreria de Windows. A ver si te sirve esto:
Eliminarhttp://visualbasictutoriales.blogspot.com.es/2015/03/webcam-video-aforge-con-visual-basic.html
Saludos.
Tengo otra duda o mas bien peticion.
ResponderEliminarPodrias subir un video de como poner la aplicacion servidor y cliente remota, fuera de la red interna.
Yo e utilizado un codigo en php y una aplicacion vb.net para capturar las imagenes del escritorio y por medio del php las hago publicas por medio de "no-ip" con un host gratuito me funciona bien, pero no tengo idea de como se hace con este tipo de aplicaciones tcp o udp por eso queria ver si nos enseñas como hacerlo, gracias.
Hola: Quizas te ayuden los proyectos que hay aqui:
Eliminarhttp://visualbasictutoriales.blogspot.com.es/search/label/COMUNICACION.
Especialmente los que empiezan por XX- Comunicacion Remota.
Saludos.
Muchas gracias por compartir tu conocimiento y proyectos, la verdad me sirvió mucho este que utiliza la webcam
ResponderEliminarMil gracias por tus aportes ayudan mucho.
ResponderEliminar