Componentes del club

[[seoane]]

Vamos a ver Julian, un primer esbozo podría ser esto:

Código Delphi [-]
unit transfer;

interface

uses Windows, Sysutils, Classes, Winsock;

type
  EBindError = class(Exception);
  EConnectError = class(Exception);
  EWinsockError = class(Exception);

  TFileReceiver = class(TThread)
  private
    FFile: TFileStream;
    FReceived: int64;
    FServer: TSocket;
    FSocket: TSocket;
    FToken: int64;
    procedure Receive;
    function WaitForData(Count: Integer): Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(Filename: String; Port: Integer; Token: int64);
    destructor Destroy; override;
    property Received: int64 read FReceived;
  end;

  TFileSender = class(TThread)
  private
    FFile: TFileStream;
    FSended: int64;
    FSocket: TSocket;
    FToken: int64;
  protected
    procedure Execute; override;
  public
    constructor Create(Filename: String; Host: String; Port: Integer;
      Token: int64);
    destructor Destroy; override;
    property Sended: int64 read FSended;
  end;

implementation

const
  BUFFER_SIZE = 32 * 1024;

{ TFileReceiver }

constructor TFileReceiver.Create(Filename: String; Port: Integer; Token: int64);
var
  Addr: TSockAddr;
begin
  FFile:= nil;
  FReceived:= 0;
  FServer:= INVALID_SOCKET;
  FSocket:= INVALID_SOCKET;
  FToken:= Token;
  FFile:= TFileStream.Create(Filename,fmCreate or fmShareDenyWrite);
  FServer:= Socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
  if FServer = INVALID_SOCKET then
    raise EWinsockError.Create('Socket');
  Addr.sin_family:= AF_INET;
  Addr.sin_port := htons(Port);
  Addr.sin_addr.s_addr := htonl(INADDR_ANY);
  if Bind(FServer, Addr, sizeof(Addr)) = SOCKET_ERROR then
    raise EWinsockError.Create('Bind');
  if Listen(FServer, 1) = SOCKET_ERROR then
    raise EWinsockError.Create('Listen');
  FreeOnTerminate:= TRUE;
  inherited Create(TRUE);
end;

destructor TFileReceiver.Destroy;
begin
  if FSocket <> INVALID_SOCKET  then
    CloseSocket(FSocket);
  if FServer <> INVALID_SOCKET  then
    CloseSocket(FServer);
  FFile.Free;
  inherited;
end;

procedure TFileReceiver.Execute;
var
  Addr: TSockaddr;
  Size: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
begin
  while not Terminated do
  begin
    TimeVal.tv_sec:= 0;
    TimeVal.tv_usec:= 10000;
    FD_ZERO(FDSet);
    FD_SET(FServer, FDSet);
    if Select(0, @FDSet, nil, nil, @TimeVal) > 0 then
    begin
      Size:= Sizeof(Addr);
      FSocket:= Accept(FServer, @Addr, @Size);
      if FSocket <> INVALID_SOCKET then
      begin
        Receive;
        break;
      end;
    end;
  end;
end;

procedure TFileReceiver.Receive;
var
  i: Integer;
  Buffer: PChar;
  Token: int64;
begin
  if WaitForData(Sizeof(Token)) then
    if Recv(FSocket, Token, Sizeof(Token), 0) = Sizeof(Token) then
      if Token = FToken then
      begin
        GetMem(Buffer,BUFFER_SIZE);
        try
          while WaitForData(1) do
          begin
            i:= Recv(FSocket, Buffer^, BUFFER_SIZE, 0);
            if i > 0 then
            begin
              FFile.WriteBuffer(Buffer^,i);
              inc(FReceived, i);
            end else
              break;
          end;
        finally
          FreeMem(Buffer);
        end;
      end;
end;

function TFileReceiver.WaitForData(Count: Integer): Boolean;
var
  i: Integer;
  Buffer: PChar;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
begin
  Result:= FALSE;
  GetMem(Buffer,Count);
  try
    while not Terminated do
    begin
      TimeVal.tv_sec:= 0;
      TimeVal.tv_usec:= 10000;
      FD_ZERO(FDSet);
      FD_SET(FSocket, FDSet);
      if Select(0, @FDSet, nil, nil, @TimeVal) > 0 then
      begin
        i:= Recv(FSocket, Buffer^, Count, MSG_PEEK);
        if i > 0 then
        begin
          if i = Count then           
          begin
            Result:= TRUE;
            break;
          end else
            Sleep(10);
        end else
          break;
      end;
    end;
  finally
    FreeMem(Buffer);
  end;
end;

{ TFileSender }

constructor TFileSender.Create(Filename, Host: String; Port: Integer;
  Token: int64);
var
  Address: u_long;
  HostEnt: phostent;
  Addr: sockaddr_in;
begin
  FFile:= nil;
  FSended:= 0;
  FSocket:= INVALID_SOCKET;
  FToken:= Token;
  FFile:= TFileStream.Create(Filename,fmOpenRead or fmShareDenyWrite);
  Address:= inet_addr(Pchar(Host));
  if Address = INADDR_NONE then
  begin
    HostEnt:= gethostbyname(PChar(Host));
    if HostEnt <> nil then
      Address:= PInAddr(HostEnt.h_addr_list^)^.S_addr;
  end;
  if Address <> INADDR_NONE then
  begin
    FSocket:= Socket(AF_INET, SOCK_STREAM, 0);
    if FSocket = INVALID_SOCKET then
      raise EWinsockError.Create('Socket');
    Addr.sin_family:= AF_INET;
    Addr.sin_addr.S_addr:= Address;
    Addr.sin_port:= htons(Port);
    if Winsock.Connect(FSocket, Addr, Sizeof(Addr)) = SOCKET_ERROR then
      raise EConnectError.Create('Connect');
  end else
    raise EConnectError.Create('Connect');
  FreeOnTerminate:= TRUE;
  inherited Create(TRUE);
end;

destructor TFileSender.Destroy;
begin
  if FSocket <> INVALID_SOCKET  then
    CloseSocket(FSocket);
  FFile.Free;
  inherited;
end;

procedure TFileSender.Execute;
var
  i,j: Integer;
  Buffer: PChar;
begin
  if Send(FSocket,FToken,Sizeof(FToken),0) = Sizeof(FToken) then
  begin
    GetMem(Buffer,BUFFER_SIZE);
    try
      i:= FFile.Read(Buffer^,BUFFER_SIZE);
      while (i > 0) and not Terminated do
      begin
        j:= Send(FSocket,Buffer^,i,0);
        if i > 0 then
        begin
          inc(FSended,j);
          if j <> i then
            FFile.Seek(j-i,soCurrent)
        end else
          break;
        i:= FFile.Read(Buffer^,BUFFER_SIZE);
      end;
    finally
      FreeMem(Buffer);
    end;
  end;
end;

var
  WSAData: TWSAData;

procedure Startup;
begin
  if WSAStartup(MAKEWORD(1, 1), WSAData) <> 0 then
    raise EWinsockError.Create('WSAStartup');
end;

procedure Cleanup;
begin
  if WSACleanup <> 0 then
    raise EWinsockError.Create('WSACleanup');
end;

initialization
  Startup;

finalization
  Cleanup;

end.

Son dos clases descendientes de la clase TThread. Solo utilizo funciones del Winsock, nada de librerias.

Y un ejemplo de como usarla seria el siguiente:
- Uno de los usuarios del chat decide mandar un archivo a otro, así que le manda un mensaje pidiéndole permiso.
- El otro crea una instancia del TFileReceive y le devuelve un mensaje con el numero de puerto y un código de seguridad (token)
- Ahora el primero crea una instancia del TFileSender, usando el puerto y el token que acaba de recibir, y envía el archivo.

Esto llevado a código:

Código Delphi [-]
// Para crear el receptor
with TFileReceiver.Create('c:\borrame.exe',61985,789) do
  begin
    Resume;
  end;

// Para crear el emisor
begin
 with TFileSender.Create(ParamStr(0),'127.0.0.1',61985,789) do
  begin
    Resume;
  end;
end;

El receptor y el emisor solo se tienen que poner de acuerdo en el puerto y el token, si el emisor y el receptor ya mantienen una conexión de chat no sera difícil implementar un protocolo para hacer eso.

Bueno, son las 3 AM y esto es todo lo que se me ocurre

Espero que se me entienda.

[Julián]

Jau!

tengo muy poco tiempo estos días, mas que poco ninguno,por eso no he podido poner esto antes:

icsChatComponents

Ahí van los componentes para tener un servidor y cliete chat, con el código fuente y una demo.
Mi consejo es que, a quien le interese el tema, pruebe la demo antes que nada. Y despues que se ponga a mirar el código chapucerillo, jeje.

Para probar la demo no hay mas que ejecutarla, y activar el servidor, y despues si activa el cliente se conecta al server. Despues puede ejecutar otra instancia del programa y conectarse al mismo server ( Con otro Nick para que no de error, claro!!)

Gueno, ya me direis, un saludo!

Lo olvidava: para instalar los componentres se necesitan los ICS de Fpiette.

[dec]

Hola,

Está muy bien Julián. La "demo" por lo menos funciona estupendamente.

[Julián]

Empezado por dec

Hola,

Está muy bien Julián. La "demo" por lo menos funciona estupendamente.

Jau!

Pues si, si miras el código encontraras unas cosas bastante retorcidas en los procesos de conexión y validación de clientes al servidor de chat, y sé que dicho código es en teoría, merecedor de un buen suspenso en un éxamen de programación en una universidad.

Perooooooo... el hecho cierto y comprobado es que funciona, cmo tu dices, bien. ¿y como me atrevo a afirmar eso?

Ahí vá: el desarrollo de ese código tuvo duras pruebas que superar. Era para el ajedrezchat, que se usaba, y se sigue usando, en los canales #delphi y #ajedrez del irc-hispano, y en esa epoca había 3 o 4 hijosdelagranputa que se dedicaban a sabotear y a putear a los usuarios de estos canales, y en concreto al ajedrezchat. De manera que yo sacaba una versión del programa, lo daba a probar, y automáticamente, ahí tenias a esos 4 cabrones conectandose por telnet y por ssh a cualquier ajedrezchat que se pusiera de server. Incluso se hacian programillas con un botón "Conectar un socket al ajedrezchat" el cual pulsaban rapida y repetidamente hasta que reventaban literalmente cualquier ajederzchat de servidor. Un infierno.

Pero yo soy muy cabezón. Y el resultado será un código muy remendao, pero, despues de perder alguna batalla, gané la guerra. Con un par.

No dudo que algún experto programador o hacrker o lo sea sea capaz, incluso fácilmente, de tumbarme un server de ajedrezchat. Pero aquellos cuatro hackercillos de pacotilla no pudieron, tuvieron que rendirse, humillados y derrotados, y agachar su vacía cabeza y retirarse avergonzados.

Así que, algún experto podrá criticar, con gran razón, mi código, y yo se lo agradeceré (aún mas le agradecería que lo arreglara). Pero el hecho, el hecho cierto, es que funcionar, funciona, y muy bien. Y eso es lo que yo pretendía.

Por cierto, que estuve probando con los INDY, antes que los ICS, pero toido lo que conseguía era tremendamente vulnerable a cualquier ataque, aunque fuera un pequeño 'flood'. Por eso tuve que volverme a los ICS.

Un saludo!

[[maeyanes]]

Hola!

Tengo un componente basado en el código de la UIApp de Román, aprovecho para subirlo y lo usen en los componentes Club Delphi, claro siempre y cuando Román no ponga ningún pero al regresar...

No soy bueno poniendo comentarios y hay libertad absoluta para modificar los que ya vienen en el código fuente (sobre todo la noticia inicial )...

El zip contiene el código fuente y las imagenes para usar en la paleta de componentes...



Saludos...