Ver Mensaje Individual
  #117  
Antiguo 30-09-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Reputación: 24
seoane Va por buen camino
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.

Última edición por seoane fecha: 30-09-2007 a las 03:27:12.
Responder Con Cita