Sockets
Programa para ejecutar programas en m�quinas remotas mediante 'sockets'

Fecha: 02/Oct/98 (15/Dic/97)
Autor: Nacho Cassou [email protected]

Hola Guille,

No te dejo en paz eh?
Te env�o una colaboraci�n que, adem�s de �til te puede servir para quedarte con alg�n compa�ero de trabajo.

Se trata de lo siguiente : - Un programa (SocketListen) que se ejecuta en 'background' (o sea, oculto) y que 'escucha' por sockets, y que es capaz de ejecutar el programa que se le ordene desde otra m�quina remota, ya sea en modo s�ncrono o as�ncrono.
Por cierto, para conseguir lo de 's�ncrono' intent� utilizar tu c�digo pero no me funcion�, as� que busqu� yo mismo en el CD del MSDN y encontr� el c�digo, muy similar al tuyo pero utilizando la API CreateProcess en vez de OpenProcess. Funciona bien, con la salvedad de que si la aplicaci�n que quieres ejecutar es el Explorador de Windows, la rutina se comporta como si ya hubiese terminado. Se te ocurre por qu�?

- Un EXE ActiveX (SocketTalk) que es el que se encarga de enviarle las �rdenes a SocketListen.

- Un programita de ejemplo de su utilizaci�n (UsaSocketTalk).

Con esto se puede conseguir ejecutar un programa en una m�quina remota, lo �nico que hace falta es instalarle el programita SocketListen y manipular el registro para que se cargue siempre que arranque Windows (tambi�n se puede cargar incluy�ndolo en el grupo 'Inicio', pero queda m�s feo).
Tambi�n puedes, como dec�a antes, hacer que en el PC de un compa�ero se abra de repente el Notepad mientras est� trabajando, con lo que le dejar�s 'pasmao'.

Funcionan bajo VB5, pero se pueden utilizar desde VB4 si se generan los archivos de instalaci�n y se instala SocketTalk o SocketListen en el PC donde se quieran emplear.


Te gusta la idea?


Salu2,

Nacho.

Aqu� tienes los listados de los diferentes m�dulos:

SocketListen: el programa que se ejecuta en "background", esperando que el socket le diga algo.

'M�dulo slMod1.bas

Private Sub Main()
'Damos el n�mero de puerto TCP que
'queremos usar. Se puede cambiar,
'pero hay que ver que no sea un puerto
'usado por otras aplicaciones (ver archivo
'Services en el directorio Windows), y
'si se cambia, hay que hacer lo propio con
'SocketTalk.

    slForm.Winsock1.LocalPort = 1027
    slForm.Winsock1.Listen
End Sub

'Formulario slForm.frm
'El form s�lo tiene un control WinSock

Private Type STARTUPINFO

      cb As Long
      lpReserved As String
      lpDesktop As String
      lpTitle As String
      dwX As Long
      dwY As Long
      dwXSize As Long
      dwYSize As Long
      dwXCountChars As Long
      dwYCountChars As Long
      dwFillAttribute As Long
      dwFlags As Long
      wShowWindow As Integer
      cbReserved2 As Integer
      lpReserved2 As Long
      hStdInput As Long
      hStdOutput As Long
      hStdError As Long
End Type

'Valores para dwFlags

Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESIZE = &H2
Private Const STARTF_USEPOSITION = &H4
Private Const STARTF_USECOUNTCHARS = &H8
Private Const STARTF_USEFILLATTRIBUTE = &H10
Private Const STARTF_RUNFULLSCREEN = &H20        '  se ignora para plataformas que no sean x86
Private Const STARTF_FORCEONFEEDBACK = &H40
Private Const STARTF_FORCEOFFFEEDBACK = &H80
Private Const STARTF_USESTDHANDLES = &H100

Private Type PROCESS_INFORMATION

      hProcess As Long
      hThread As Long
      dwProcessID As Long
      dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
      hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
      lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
      lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
      ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
      hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&


Public objfrm As slForm
Public WithEvents sckobjl As Winsock
Public WithEvents sckobja As Winsock

Private Sub Winsock1_Close()
    Winsock1.Close
    Winsock1.Listen
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
'Recibimos una petici�n de conexi�n
'y la aceptamos.

    If Winsock1.State = sckConnected Or Winsock1.State = sckListening Then
        Winsock1.Close
    End If
    Winsock1.Accept requestID
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim datos As String
    Dim swLanzado As Boolean
    Dim ModoVentana As Integer
    Dim Posicion As Integer
    Dim LongTrozo As Integer
    
'Han llegado datos por el socket. Vamos a ver qu�
'encontramos.

    datos = String(bytesTotal, Chr$(0))

'Recuperamos los datos recibidos.
    Winsock1.GetData datos
    
'Aqu� interpretamos el montaje que
'hemos hecho en SocketTalk para
'saber qu� hemos de ejecutar y
'c�mo.

    Posicion = InStr(4, datos, "#ModoVentana=")
    If Posicion > 0 Then
        LongTrozo = Len(Mid$(datos, Posicion))
        Posicion = Posicion + 13
        ModoVentana = Val(Mid$(datos, Posicion))
    Else
        ModoVentana = vbNormalFocus
    End If
    
    Select Case UCase(Mid$(datos, 1, 3))
        Case "EA#"
            swLanzado = ExecCmd(Mid$(datos, 4, Len(datos) - LongTrozo - 3), ModoVentana, False)

'Contestamos a SocketTalk y le decimos si ha
'ido bien o no.
'La respuesta he preferido darla como string
'en vez de como boolean porque en el entorno
'donde yo voy a emplear SocketTalk no tengo
'muy claro que reciba correctamente los booleanos.

            If swLanzado Then
                Winsock1.SendData "Ok"
            Else
                Winsock1.SendData "NoOk"
            End If
        Case "ES#"
            swLanzado = ExecCmd(Mid$(datos, 4, Len(datos) - LongTrozo - 3), ModoVentana, True)

'Igual que en el caso as�ncrono, contestamos.

            If swLanzado Then
                Winsock1.SendData "Ok"
            Else
                Winsock1.SendData "NoOk"
            End If
        Case Else

'Si lo que nos han enviado no es ninguna
'orden de ejecuci�n (algo que empiece por
'EA# o ES#) devolvemos los datos recibidos
'tal cual.

            Winsock1.SendData datos
    End Select
End Sub

Private Function ExecCmd(cmdline As String, ModoVentana As Integer, swWait As Boolean) As Boolean

    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim ret As Long
' Initialize the STARTUPINFO structure:

    start.cb = Len(start)

' Le decimos que haga caso de lo que indique wShowWindow
    start.dwFlags = STARTF_USESHOWWINDOW

' Le indicamos el modo en que se abrir� la
' nueva ventana.
    start.wShowWindow = ModoVentana
        
'He de reconocer que esto lo he sacado de
'Microsoft, aunque he a�adido cosas de
'mi cosecha, pues en el ejemplo de MS no
'explicaba como especificar el modo de
'presentaci�n de la ventana.

' Start the shelled application:
    ret = CreateProcessA(0&, cmdline, 0&, 0&, 1&, _
        NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    If ret = 0 Then
        ExecCmd = False
    Else
        ExecCmd = True
        If swWait Then

'Atenci�n, si la aplicaci�n que lanzamos es el
'Explorador de Windows no conseguiremos que
'WaitForSingeObject se espere, sino que actuar�
'como si la aplicaci�n hubiese terminado. No s�
'por qu�, pero si alguien lo averigua me gustar�
'que me lo diga.
'S� funciona correctamente con la mayor�a de
'programas, y tambi�n con los programas
'hechos en VB.

' Wait for the shelled application to finish:
            ret = WaitForSingleObject(proc.hProcess, INFINITE)
            ret = CloseHandle(proc.hProcess)
        End If
    End If
End Function

'M�dulo stMod1.bas

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public sw_Host_Responded As Boolean
Public BytesReceived As Integer

Public Function Now_plus_nseconds(ByVal nseconds As Integer) As String
    Dim final_time As String
    final_time = DateAdd("s", nseconds, Now)
    Now_plus_nseconds = Format$(final_time, "yyyy/mm/dd hh:MM:ss")
End Function

Public Function Wait_For_Host_Response(final_time As String) As Boolean
    sw_Host_Responded = False
    Do While sw_Host_Responded = False And Format$(Now, "yyyy/mm/dd hh:MM:ss)") <= final_time
        DoEvents
        Sleep 100
    Loop
    Wait_For_Host_Response = sw_Host_Responded
End Function

'Clase: stClass (stClass.cls) con la propiedad Instancing a 5-MultiUse

Public Property Get HostRemoto() As String
'Devolvemos informaci�n del host remoto
    HostRemoto = stForm.Winsock1.RemoteHost
End Property

Public Property Let HostRemoto(ByVal vNewValue As String)
'Aceptamos informaci�n sobre el host remoto
    If stForm.Winsock1.State = sckConnected Then
        stForm.Winsock1.Close
    End If
    stForm.Winsock1.RemoteHost = vNewValue
    stForm.Winsock1.RemotePort = 1027
End Property

Public Function Conectar() As String
    Dim final_time As String

'Intentamos conectar con el host remoto

    stForm.Winsock1.Connect
    Do While stForm.Winsock1.State <> sckConnected And stForm.Winsock1.State <> sckError And stForm.Winsock1.State <> sckClosed
        DoEvents
    Loop
    If stForm.Winsock1.State = sckConnected Then
        Conectar = "Ok"
    Else
        Conectar = "NoOk"
    End If
End Function

Public Sub Cerrar()
    stForm.Winsock1.Close
End Sub

Public Function EjecutarRemoto(Datos As String, ModoVentana As Integer) As String
    Dim final_time As String
    Dim Respondio As Boolean
    Dim respuesta As String
    If stForm.Winsock1.State <> sckConnected Then
        EjecutarRemoto = "No Conectado"
    Else

'Aqu� hacemos un montaje para indicarle a SocketListen
'como queremos que ejecute el programa y
'le enviamos la informaci�n usando el socket.

        stForm.Winsock1.SendData "EA#" & Datos & "#ModoVentana=" & Str$(ModoVentana)

'Esperamos un tiempo prudencial la respuesta
'de SocketListen, y si no hemos recibido nada,
'asumimos que no se ha enterado y pasamos de �l.
'Ver que la variable sw_Host_Responded (en el
'procedimiento Wait_For_Host_Response) se actualiza
'cuando se activa el evento de recepci�n
'de datos en el Socket.

        final_time = Now_plus_nseconds(ByVal 10)
        Respondio = Wait_For_Host_Response(final_time)
        If Respondio Then
            respuesta = String(BytesReceived, Chr$(0))
            stForm.Winsock1.GetData respuesta
            EjecutarRemoto = respuesta
        Else
            EjecutarRemoto = "NoOk"
        End If
    End If
End Function

Public Function EjecutarRemotoSincrono(Datos As String, ModoVentana As Integer) As String
    Dim final_time As String
    Dim Respondio As Boolean
    Dim respuesta As String
    If stForm.Winsock1.State <> sckConnected Then
        EjecutarRemotoSincrono = "No Conectado"
    Else
        sw_Host_Responded = False

'Aqu� hacemos un montaje para indicarle a SocketListen
'como queremos que ejecute el programa y
'le enviamos la informaci�n usando el socket.

        stForm.Winsock1.SendData "ES#" & Datos & "#ModoVentana=" & Str$(ModoVentana)

'Esperamos indefinidamente la respuesta
'de SocketListen.
'Ver que la variable sw_Host_Responded
'se actualiza cuando se activa el evento de recepci�n
'de datos en el Socket.

        Do While sw_Host_Responded = False And stForm.Winsock1.State = sckConnected
            DoEvents
            Sleep 100
        Loop
        If sw_Host_Responded Then
            respuesta = String(BytesReceived, Chr$(0))
            stForm.Winsock1.GetData respuesta
            EjecutarRemotoSincrono = respuesta
        Else
            EjecutarRemotoSincrono = "NoOk"
        End If
    End If
End Function

Public Function EnviarString(Datos As String) As String
    Dim final_time As String
    Dim Respondio As Boolean
    Dim respuesta As String
    If stForm.Winsock1.State <> sckConnected Then
        EnviarString = "No Conectado"
    Else

'Simplemente enviamos el string tal cual

        stForm.Winsock1.SendData Datos

'Esperamos un tiempo prudencial la respuesta
'de SocketListen, y si no hemos recibido nada,
'asumimos que no se ha enterado y pasamos de �l.
'Ver que la variable sw_Host_Responded (en el
'procedimiento Wait_For_Host_Response) se actualiza
'cuando se activa el evento de recepci�n
'de datos en el Socket.

        final_time = Now_plus_nseconds(ByVal 10)
        Respondio = Wait_For_Host_Response(final_time)
        If Respondio Then
            respuesta = String(BytesReceived, Chr$(0))
            stForm.Winsock1.GetData respuesta
            EnviarString = respuesta
        Else
            EnviarString = "NoOk"
        End If
    End If

End Function

Private Sub Class_Terminate()
    stForm.Winsock1.Close

'He puesto el END porque me ha ocurrido
'que alguna vez, despu�s de acabar la
'ejecuci�n del programa principal,
'el proceso SocketTalk continuaba activo.

    End
End Sub

'Formulario: stForm.frm (s�lo tiene un control WinSock)

Private Sub Winsock1_Close()
    'MsgBox "Socket listen desconectado, vuelvo a escuchar"
    Winsock1.Close
    Winsock1.Listen
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    'MsgBox "Connection Requested"
    If Winsock1.State = sckConnected Or Winsock1.State = sckListening Then
        Winsock1.Close
    End If
    Winsock1.Accept requestID
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    BytesReceived = bytesTotal
    sw_Host_Responded = True
End Sub

'En Proyecto->Referencias, seleccionar 'Enviar �rdenes por sockets'
'Si se quiere hacer debug, hay que arrancar el proyecto
'SocketTalk.vbp y ejecutarlo, entonces, deberemos seleccionar
'como referencia la l�nea 'Enviar �rdenes por sockets'
'pero en este caso la que corresponda a
'SocketTalk.vbp.

'Otra cosa obvia es que hay que tener activado
'el protocolo TCP/IP.

'Por otro lado, hay que ejecutar el programa
'SocketListen.exe (queda oculto, pero si
'presionamos ctrl-alt-del lo veremos en la
'lista de procesos) o bien cargar el proyecto
'y ejecutarlo.

Private sockobj As SocketTalk.stClass
Private Conectado As String

Private Sub Command1_Click()
    Text2.Text = ""
    If Conectado = "Ok" Then
'Ejecuci�n as�ncrona, es decir, no esperamos
'a que el proceso lanzado acabe.
'El primer par�metro es la l�nea
'de comando a ejecutar
'(ej. "notepad.exe c:\autoexec.bat).
'El segundo par�metro es el modo en que
'queremos que se visualice la nueva ventana
'(ver lista de posibilidades en la ayuda
'de la funci�n shell de VB).

        Text2.Text = sockobj.EjecutarRemoto(Text1.Text, vbMinimizedNoFocus)
    Else
        Text2.Text = "NoConectado"
    End If

End Sub

Private Sub Command2_Click()
    Text2.Text = ""
    If Conectado = "Ok" Then
'Ejecuci�n s�ncrona, es decir, esperamos
'a que el proceso lanzado acabe.
'Para los respectivos par�metros se
'aplica lo mismo que para la as�ncrona.
        Text2.Text = sockobj.EjecutarRemotoSincrono(Text1.Text, vbNormalNoFocus)
    Else
        Text2.Text = "NoConectado"
    End If

End Sub

Private Sub Command3_Click()
    Text2.Text = sockobj.EnviarString(Text1.Text)
End Sub

Private Sub Form_Load()
    Set sockobj = New SocketTalk.stClass

'Le damos el nombre de la m�quina en la que se
'est� ejecutando SocketListen.
'Para poderlo probar todo en una misma m�quina
'le damos como host remoto nuestra propia m�quina
'(localhost).
    sockobj.HostRemoto = "localhost"
    Conectado = sockobj.Conectar
End Sub

Private Sub Form_Unload(Cancel As Integer)
    sockobj.Cerrar
    Set sockobj = Nothing
End Sub