Bueno aquí les dejo un minitutorial de como hacer un Cliente\Servidor.
El ejemplo consiste en 2 formularios, uno que actúa como cliente y otro servidor. El servidor cuando se ejecuta se pone a la escucha de una conexión, y el cliente una ves conectado, puede ejecutar las siguientes opciones en el lado del server.
* Enviar pulsaciones de teclas.
* Enviar un Mensaje que se mostrará en el servidor con un MsgBox.
* Enviar un comando al Servidor para que genere un string con todos los procesos que están corriendo en el server, luego le devuelve esa lista al cliente, y este lo visualiza en un Msgbox.
* Abrir y cerrar la bandeja del Cd mediante el api McisendString.
* El cliente puede ejecutar un archivo en el servidor.
* El cliente puede cerrar el proceso activo del Servidor, es decir la ventana activa.
Bueno mas o menos Tiene que estar así:
En un modulo de él cliente:
'Estructura OPENFILENAME para el cuadro de diálogo Abrir archivo
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'Función Api GetOpenFileName para abrir el CommonDialog
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Dim OFName As OPENFILENAME 'Variable para la estructura
Public Function AbrirArchivo(f As Form, extenciones As String, titulo As String) As String
With OFName
.lStructSize = Len(OFName)
.hwndOwner = f.hWnd
.hInstance = App.hInstance
.lpstrFilter = extenciones
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = "C:\"
.lpstrTitle = titulo
.flags = 0
If GetOpenFileName(OFName) Then
AbrirArchivo = Trim$(OFName.lpstrFile)
Else
AbrirArchivo = ""
End If
End With
End Function
En un Formulario colocar 9 CommandButton (Command1, Command2 etc...) Los caption de los botones se ponen mediante código
Colocar 4 textBox (Text1 para la IP, Text2 para las teclas, Text3 para la ruta del Programa y text4 para Enviar Mensaje).
Por último un control Timer1 y un Control Winsock1
En un Formulario:
'Fom1
'Para saber el estado de la conexión
Dim Conectado As Boolean
'Envia un Mensaje y lo muestra en el servidor mediante un MsgBox
Private Sub Command7_Click()
If Conectado Then Winsock1.SendData "#MENSAJE##" & Text4
End Sub
'Abre el cuado de dialogo abrir archivo, llamando a la funcion que esta en el modulo.bas
Private Sub Command8_Click()
Text3 = Dialogo.AbrirArchivo(Me, "", "Seleccione el archivo")
End Sub
'Obtiene los procesos del servidor y los lista en el Cliente mediante un Msgbox
Private Sub Command9_Click()
Winsock1.SendData "LISTARPRO"
End Sub
Private Sub Form_Load()
EstablecerCaption
Timer1.Interval = 100
End Sub
Private Sub Command1_Click()
If Text1.Text <> "" And Conectado = False Then
Winsock1.Connect Text1.Text, 636 'Conectamos el winsock
'según el IP
End If
End Sub
Private Sub Command2_Click()
If Conectado = True Then Winsock1.SendData "##OPENCD##"
End Sub
Private Sub Command3_Click()
If Conectado Then Winsock1.SendData "#CLOSECD##"
End Sub
Private Sub Command4_Click()
If Conectado Then Winsock1.SendData "#SENDKEYS#" & Text2.Text
End Sub
Private Sub Command5_Click()
Dim a As Variant
If Conectado Then
If IsNumeric(a) Then 'Comprobamos que lo que ingresamos sean números
Winsock1.SendData "#EJECUTAR#" & Text3.Text 'Si es así se envían los datos
End If
End If
End Sub
Private Sub Command6_Click()
'Para cerrar el proceso activo
If Conectado = True Then Winsock1.SendData "#CLOSEPROG"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Winsock1.Close 'Cerramos el winsock
End Sub
Private Sub Text3_Change()
If Text3 = "" Then
Command5.Enabled = False
Else
Command5.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
'Si el winsock está conectado, cambiamos la variable a true
DoEvents
If Winsock1.State <> sckConnected Then
Me.Caption = "Desconectado del servidor"
Conectado = False
Else
Me.Caption = "Conectado al servidor"
Conectado = True
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim dato As String
Conectado = True
Winsock1.GetData dato
dato = Replace(dato, "\", vbNewLine)
MsgBox dato
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)
'En caso de error cerramos la conexión
Winsock1.Close
End Sub
Private Sub EstablecerCaption()
Command1.Caption = "Conectar"
Command2.Caption = "Abrir CD"
Command3.Caption = "Cerrar CD"
Command4.Caption = "Enviar Pulsaciones de tecla"
Command5.Caption = "Ejecutar"
Command6.Caption = "Cerrar proceso Activo"
Command7.Caption = "Enviar mensaje"
Command8.Caption = "Seleccionar programa para abrir"
Command9.Caption = "Ver procesos abiertos"
End Sub
En el formulario Servidor:
'Función Api ShellExecute Para ejecutar archivos
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
'Para acceder a la unidad de CD
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
'Api ExitProcess Cerrar la aplicación que este activa en el momento
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Sub Form_Load()
'establecemos el puerto a conectar
Winsock1.LocalPort = "636"
'Ponemos a la escucha el Winsock
Winsock1.Listen
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
'Si el winsock está abierto lo cerramos.
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID 'Aceptamos la conexión
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)
'Si ocurre un error, cerramos el Winsock y volvemos a ponerlo a la escucha.
Winsock1.Close
Winsock1.Listen
End Sub
Private Sub Winsock1_Close()
'Si se cierra la conexión, volvemos a escuchar.
Winsock1.Close
Winsock1.Listen
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Variable para la ruta del archivo en la opcion ejecutar archivo
Dim Ruta As String
'Declaramos la variable que recibirá los datos
Dim data1 As String
'Tomamos los datos que nos envían con GetData
Winsock1.GetData data1
DoEvents
'Separamos el String y determinamos que accion nos está mandando el Cliente
Select Case Mid(data1, 1, 10)
'Opcion ejecutar un archivo
Case "#EJECUTAR#"
Ruta = Mid(data1, 11)
ShellExecute Me.hwnd, vbNullString, Ruta, vbNullString, vbNullString, SW_SHOWNORMAL
'Genera las pulsacione de tecla
Case "#SENDKEYS#"
SendKeys Mid(data1, 10, Len(data1)) 'Envía las teclas al teclado
'Muestra un Mensaje mediante un Msgbox
Case "#MENSAJE##"
MsgBox Mid(data1, 11, Len(data1))
'Abre y cierra la bandeja del CD mediante el APi MciSendString con el comando Open
Case "##OPENCD##"
mciSendString "set Cdaudio door open", returnstring, 127, 0 'Habre la lectora de CDs
Case "#CLOSECD##"
mciSendString "set Cdaudio door closed", returnstring, 127, 0 'Cierra la lectora de CDs
'Cierra el programa activo
Case "#CLOSEPROG"
ExitProcess GetExitCodeProcess(GetCurrentProcess, 0)
'Genera un listado de los procesos, y le envia al cliente en un String _
El cliente luego formatea el String y lo muestra en un Msgbox
Case "LISTARPRO"
ListarPro
End Select
End Sub
'Procedimiento que lista los procesos abiertos
Private Sub ListarPro()
Dim Procesos As String
Set ObjetoWMI = GetObject("winmgmts:")
If IsNull(ObjetoWMI) = False Then
'instanciamos la variable
Set Listaprocesos = ObjetoWMI.InstancesOf("win32_process")
'Recorremos toda las coleccion en lista de procesos y la añadimos al list
For Each ProcesoACerrar In Listaprocesos
Procesos = Procesos & LCase$(ProcesoACerrar.Name) & "\"
Next
End If
Winsock1.SendData Procesos
Set Listaprocesos = Nothing
Set ObjetoWMI = Nothing
End Sub
Autor