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

Fecha: 02/Oct/98 (15/Dic/97)
Autor: Nacho Cassou nachoc@dixit.com

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