Usar TTCPServer y TTCPClient

Este es un ejemplo de como usar los componente TTCPServer y TTCPClient que vienen con Turbo Delphi Explorer (la versión gratuita de Turbo Delphi). En este ejemplo, vamos a enviar un archivo desde el cliente al servidor.

El protocolo es intencionadamente muy simple: el cliente primero envía la ruta donde se debe guardar el archivo, luego envía el archivo y por ultimo cierra la conexión. Por su parte el servidor se limita a leer los datos y guardarlos en la ruta indicada, hasta que la conexión se cierra.

const
  BufferSize = 32 * 1024;
 
// En el evento OnAccept del TTCPServer (BlockMode = bmThreadBlocking)
procedure TfrmMain.ServidorAccept(Sender: TObject;
  ClientSocket: TCustomIpClient);
var
  Buffer: PByte;
  Recibidos: Integer;
begin
  // La primera linea que recibimos es la ruta donde guardar el archivo
  with TFileStream.Create(ClientSocket.Receiveln, fmCreate) do
  try
    // Reservamos memoria para el buffer
    GetMem(Buffer,BufferSize);
    try
      // Recibimos los datos del archivo hasta que se cierre la conexion
      Recibidos:= ClientSocket.ReceiveBuf(Buffer^,BufferSize);
      while Recibidos > 0 do
      begin
        // Guardamos los datos recibidos en el archivo
        WriteBuffer(Buffer^,Recibidos);    
        Recibidos:= ClientSocket.ReceiveBuf(Buffer^,BufferSize);
      end;
    finally
      // Liberamos la memoria
      FreeMem(Buffer);
    end;
  finally
    Free;
  end;
end;

El cliente lo implemento dentro de un thread, ya que voy a colocar la propiedad BlockMode = bmBlocking y no quiero que se me bloquee el resto de la aplicación. Aunque puede parecer complicado, esto nos permitirá mandar varios archivos a la vez y también cancelar el envió antes de que termine.

El thread cliente, que yo llamare TEnvio, lo implemento asi:

// Debajo de interface, junto a la definicion del formualrio
 TEnvio = class(TThread)
  private
    FCliente: TTCPClient;
    FLocalFile: String;
    FRemoteFile: String;
  protected
    procedure Execute; override;
  public
    constructor Create(LocalFile,RemoteFile,Host,Port: String);
    destructor Destroy; override;
  end;
 
 
// Debajo de implementation
{ TEnvio }
 
constructor TEnvio.Create(LocalFile,RemoteFile,Host,Port: String);
begin
  inherited Create(FALSE);
  // Le indicamos que se destruya al termianr
  FreeOnTerminate:= TRUE;
  FLocalFile:= LocalFile;
  FRemoteFile:= RemoteFile;
  // Creamos un TTCPClient
  FCliente:= TTCPClient.Create(nil);
  FCliente.RemoteHost:= Host;
  FCliente.RemotePort:= Port;  
  FCliente.BlockMode:= bmBlocking;
end;
 
destructor TEnvio.Destroy;
begin
  // Destruimos el TTCPClient
  FCliente.Free;
  inherited;
end;
 
procedure TEnvio.Execute;
var
  Buffer: PByte;
  Leidos: Integer;
begin
  inherited;
  // Abrimos el archivo como solo lectura
  with TFileStream.Create(FLocalFile,fmOpenRead or fmShareDenyWrite) do
  try
    // Reservamos memoria para el buffer
    GetMem(Buffer,BufferSize);
    try
      // Intentamos conectar con el servidor
      FCliente.Active:= TRUE;
      try
        // Enviamos la ruta donde se debe guardar el archivo
        FCliente.Sendln(FRemoteFile);
        // En este bucle enviamos el archivo
        Leidos:= Read(Buffer^,BufferSize);
        while (Leidos > 0) and not Terminated do
        begin
          FCliente.SendBuf(Buffer^,Leidos);
          Leidos:= Read(Buffer^,BufferSize);
        end;
      finally
        // Cerramos la conexion
        FCliente.Active:= FALSE;
      end;
    finally
      FreeMem(Buffer);
    end;
  finally
    Free;
  end;
end;

Un ejemplo de como usar lo anterior:

var
  Envio: TEnvio;
begin
  with TOpenDialog.Create(nil) do
  try
    if Execute then
    begin
      Envio:= TEnvio.Create(Filename, 'C:\' +  ExtractFileName(Filename),
        txtHost.Text, '2000');
    end;
  finally
    Free;
  end;
end;

En cualquier momento podemos cancelar la transmisión utilizando "Envio.Terminate". Otras mejoras pueden ser que la ruta del archivo remoto sea relativa y no absoluta, por motivos de seguridad, o enviar junto con el archivo su hash md5 para comprobar que ha llegado bien. Pero eso lo podemos dejar para mas adelante ...

El ejemplo lo puedes bajar de aquí

Enviar un comentario nuevo

El contenido de este campo se mantiene privado y no se mostrará públicamente.