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;
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;
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
[-]
with TFileReceiver.Create('c:\borrame.exe',61985,789) do
begin
Resume;
end;
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.