TRANSFERT DE FICHIERS (SOCKETS)

Commentaire de FFCAST le 26/08/2005 22:04:35

salut ta source est nikel merci :)

Commentaire de mecsympa le 31/01/2006 17:42:20

Ou trouver les composant TClientSocket et TServerSocket ? sur Delphi 7, il ne les trouve pas et toute les sources qui utilisent ces composants ne donne pas plus de précision sur ces 2 composants.

Commentaire de cyberelhayet le 12/12/2006 17:40:10

ok

Commentaire de AccessToYou le 10/07/2007 18:39:40

regarder la procedure >>>>
procedure TForm1.SetExecuteIt(Value: Boolean);
begin
  ...
  ...
  //trClient.Address:= Edit1.Text;
  ...
  ...
end;
Décommenter l'instruction, et dans la zone Edit1 inserer l'adresse Ip du Serveur où l'application serveur s'exécute.
Bonne prog...

Commentaire de schaillol le 11/09/2007 21:23:31

Bonjour,

merci pour cette source.
Chez moi, ça marche très bien en local (127.0.0.1). Mais en réseau local ou part internet, j'obtiens une erreur : "erreur socket asynchrone 10061" ???

Commentaire de nirG le 15/02/2009 00:15:48

Bonjour,

J'ai essayé ton appli, cependant il y a un gros bug. Je ne sais pas si sa viens de chez moi ([D7] avec indy 9) j'ai comme tu la dis plus haut j'ai rajouté le composant dclsockets70.bpl. Donc, à la compilation pas d'erreur et le programme fonctionne parfaitement.

Mais j'ai vérifié les fichier sur le serveur et ils sont tout corrompus. Je sais que je suis à la traine du poste.

Exemple :
fichier source .txt :

Salut, je suis actuellement au travail

Récupération du fichier .txt :
&   &   Salut, je suis actuellement a

Pour les images impossible de les visualiser !

Après je m'y connais vraiment pas pour te dire ou sont les fautes ^^

Cordialement.

Commentaire de AccessToYou le 14/10/2009 16:26:15

Je n'arrive pas a modifier la source (correction des erreurs),. Voila donc les deux unités Client et Serveur corrigés.

SERVEUR: ===============================================================

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ComCtrls, Gauges, ExtCtrls;

type
  TTansfState = (tsSleep, tsBegin, tsEnd, tsRun, tsAbort);
  TTrnsfertEvent = procedure(Sender: TObject; State: TTansfState) of Object;

  TBloc = packed record
    case bOperation: Byte of
       1: (fName: ShortString;
           fSize: Integer);

       2: (bReaden: Integer;
           bProgress: Integer;                                                                 {
           5124 = 5 KBytes pour chaque trame                                                    }
           bDatas: array[0..2047{ 5123}] of Char );

       3: ();
    end;

  TForm1 = class(TForm)
    FileTransfer: TServerSocket;
    LOG2: TMemo;
    Gauge1: TGauge;
    Label1: TLabel;
    Label3: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FileTransferAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FileTransferClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FileTransferClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    isTransfExecuted, CloseApplication: Boolean;
    ftSaveAs: String;
    OldSize: Integer;
    procedure SaveTransferedFile;
    procedure UpdateGauges(Value: Integer);

  public

  end;

var
  Form1: TForm1;

implementation
uses Unit2, DateUtils;

{$R *.dfm}

resourcestring

  sWaitingForRecipientsConfirmation = 'Waiting for recepient''s confirmation ...';
  sDoYouWantToReceiveFile           = 'Do you want to receive %s (%s Bytes) from %s ?';
  sOperationAccepted                = 'Operation accepted';
  sWaitingForRemoteData             = 'Waiting for remote data';
  sReceivedProgress                 = 'Received %d of %d bytes';
  sTransferComplete                 = 'File transferred completely';
  sClose                            = 'Close : ';
  sAborted                          = 'Operation aborted';
  sTransferNotComplete              = 'File transferred not completely terminated';
  sTransferBegin                    = 'Contact me at : tdjprog@yahoo.fr';

Var
  Fichier: TFileStream; //TMemoryStream;
                                                                                            {

           NOTE:-----------------------------------------------
                           If the size of file that you want to
                             receive is > 5 MB, it's recomonded
                                       to use TFileStream; else
                       you can use TFileStream or TMemoryStream                             }


procedure TForm1.FormCreate(Sender: TObject);
begin
  FileTransfer.Active:= true;
end;

procedure TForm1.FileTransferAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  LOG2.lines.Add(sClose+ Socket.RemoteAddress);
end;

procedure TForm1.FileTransferClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  LOG2.lines.Add(sClose+ Socket.RemoteAddress);
  Timer1.Enabled:= False;
  if isTransfExecuted then
  begin
    LOG2.lines.Add(sTransferNotComplete);
    SaveTransferedFile;
  end;
end;

procedure TForm1.SaveTransferedFile;                                            {
var                                                                            
  nRead: Integer;
  Buffer: array [0..5123] of Char;
  aTarget: TFileStream;                                                         }
begin
  isTransfExecuted:= False;
  Gauge1.Progress:= 0;

  ShowMessage('File saved as : '+ ftSaveAs+ #13+ 'Total size : '+ FormatFloat('0.00 K Bytes', Fichier.Size / 1024));
  Fichier.Free;
end;

procedure TForm1.UpdateGauges(Value: Integer);
begin
  Gauge1.Progress:= Value;
end;

procedure TForm1.FileTransferClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
Var Buffer:TBloc;
    Received :Integer;
    EmptyChar: Byte;
    ConfirmRecive: TForm2;
begin
  EmptyChar:= 0;
  Received:= Socket.ReceiveLength;
  if Received<= SizeOf(Buffer) then
  begin
    Socket.ReceiveBuf(Buffer,Received);
    with Buffer do
    begin
      case bOperation Of
        1: begin
             Gauge1.MaxValue:= fSize;
             LOG2.Lines.Add(sWaitingForRecipientsConfirmation);
             ConfirmRecive:= TForm2.Create(Self);
             try
               ConfirmRecive.SaveTo.Text:= 'C:\'+ fName;
               ConfirmRecive.SaveD.Filter:= ExtractFileEXT(fName)+ '|*'+ ExtractFileEXT(fName);
               ConfirmRecive.Label1.Caption:= Format(sDoYouWantToReceiveFile, [fName, inttostr(fSize), Socket.RemoteAddress]);
               if ConfirmRecive.ShowModal = mrOK then
               begin
                 LOG2.Lines.Add(sOperationAccepted);
                 ftSaveAs:= ConfirmRecive.SaveTo.Text;
                 LOG2.Lines.Add('File name: '+ fName+ ' [ '+ inttostr(fSize)+ 'Bytes ]');
                 LOG2.Lines.Add(sWaitingForRemoteData);
                 Fichier:= TFileStream.Create(ftSaveAs, fmCreate); //TMemoryStream.Create;
                 isTransfExecuted:= True;
                 Timer1.Enabled:= True;
                 LOG2.Lines.Add(sTransferBegin);
               end
               else
               begin
                 EmptyChar:= 1;
                 LOG2.Lines.Add(sAborted);
               end;
               Socket.SendBuf(EmptyChar, 1);
             finally
               ConfirmRecive.Free;
             end;
           end;
        2: begin
             // Fichier.Seek(0, soFromEnd);
             Fichier.Write(bDatas, bReaden);
             UpdateGauges(bProgress);
             Label2.Caption:= Format(sReceivedProgress, [Gauge1.Progress, Gauge1.MaxValue]);
             if CloseApplication then
             begin
               EmptyChar:= 2;
               Socket.SendBuf(EmptyChar, 1);
               isTransfExecuted:= False;
               Close;
             end;
             Socket.SendBuf(EmptyChar, 1);
           end;
      else
        LOG2.Lines.Add(sTransferComplete);
        Timer1.Enabled:= False;
        SaveTransferedFile;
      end;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var trSpeed: Real;
    Readen: LongWord;
    MilliSecToExt: Extended;
begin                                                                                          {
  Nombre de bytes transferés pour la dernière trame                                             }
  Readen:= Gauge1.Progress - OldSize;
  OldSize:= Gauge1.Progress;                                                                   {
  Vitesse du transfer (Bytes / Milli Seconde)                                                   }
  trSpeed:= Readen / Timer1.Interval;
  Label1.Caption:= FormatFloat('Transfer rate: 0.00 K Bytes/s', 1000 * trSpeed / 1024);        {
  Obtenir le nombre des bytes non transferés                                                    }
  Readen:= Gauge1.MaxValue - OldSize;
  try                                                                                          {
    Convertir 1 milli sconde en un nombre réel                                                  }
    MilliSecToExt:= EncodeTime(0,0,0,1);                                                       {
    Convertir Le temps necéssaire pour le reste en milli secondes en un nombre réel             }
    try
      MilliSecToExt:= MilliSecToExt * Readen / trSpeed;
    except
      MilliSecToExt:= MilliSecToExt * Readen;
    end;                                            {
    

    Codé le nombre obtenue en DateTime                                                          }
    Label3.Caption:= 'Time remaining: '+ FormatDateTime('hh:mm:ss.zzz', MilliSecToExt);
  Except                                                                                       {
    A la fin du transfer il y a une exception Division par zéro (trSpeed = 0)                   }
    Label3.Caption:= 'Time remaining: Inknow';
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if isTransfExecuted then
  begin
    CloseApplication:= True;
    CanClose:= False;
  end;
end;

end.

***********************************************************************

CLIENT ================================================================

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls;

type
  TTansfState = (tsSleep, tsBegin, tsEnd, tsRun, tsAbort);
  TTrnsfertEvent = procedure(Sender: TObject; State: TTansfState) of Object;

  TBloc = packed record
    case bOperation: Byte of
       1: (fName: ShortString;
           fSize: Integer);

       2: (bReaden: Integer;
           bProgress: Integer;
           bDatas: array[0..2047{ 5123}] of Char );

       3: ();
    end;

  TForm1 = class(TForm)
    trClient: TClientSocket;
    ftName: TEdit;
    bGo: TButton;
    Button1: TButton;
    ListBox1: TListBox;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    Label1: TLabel;
    procedure trClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure bGoClick(Sender: TObject);
    procedure trClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure trClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);

  private
    CurBloc: TBloc;
    FileToTransf: TFileStream;
    fExecuteIt: Boolean;
    CloseApplication: Boolean;
    procedure bGoAbortTransf(Sender: TObject);
    procedure SetExecuteIt(Value: Boolean);

  public
    property ExecuteIt: Boolean read fExecuteIt write SetExecuteIt default False;

  protected
    procedure SendCurrentBloc;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SetExecuteIt(Value: Boolean);
begin
  if fExecuteIt <> Value then
  begin
    fExecuteIt:= Value;
    if Value then
    begin
      FileToTransf:= TFileStream.Create(ftName.Text, fmOpenRead);
      FileToTransf.Seek(0, 0);
      CurBloc.bOperation:= 1;
      CurBloc.fName:= ExtractFileName(ftName.Text);
      CurBloc.fSize:= FileToTransf.Size;
      trClient.Address:= Edit1.Text;
      trClient.Open;
    end
    else
    begin
      trClient.Close;
      FileToTransf.Free;
    end;
  end;
end;

procedure TForm1.SendCurrentBloc;
begin
  with CurBloc Do
  begin
    bOperation:= 2;
    bReaden:= FileToTransf.Read(bDatas, 2047); // 1024);
    bProgress:= bProgress+ bReaden;
  end;
                                                                               {
  bOperation = 2:
       ___________________________________________________________________
       IDENTIFIER         TYPE            FORMAT           NUMBER OF BYTES
       ===================================================================
       bOperation         Byte            Unsigned 8 bit         8 / 8 = 1
       bReaden            Integer         Signed 32 bit         32 / 8 = 4
       bProgress          Integer         Signed 32 bit         32 / 8 = 4
       bDatas             Array           1 to 5123 Bytes  CurBloc.bReaden
       ===================================================================
                                                                                }
  trClient.Socket.SendBuf(CurBloc, 1+ 4+ 4+ CurBloc.bReaden);
end;

procedure TForm1.trClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  bGo.Enabled:= True;
end;

procedure TForm1.bGoClick(Sender: TObject);
begin
                                                                               {
  bOperation = 1:
       ___________________________________________________________________
       IDENTIFIER         TYPE            FORMAT           NUMBER OF BYTES
       ===================================================================
       bOperation         Byte            Unsigned 8 bit         8 / 8 = 1
       fName              ShortString     2 to 256 Bytes               256
       fSize              Integer         Signed 32 bit         32 / 8 = 4
       ===================================================================

  La taille de fName doit être 256, pour envoyer l'identificateur fSize correctement.
  Size of fName must be 256, [not Length(fName)+ 1] to send the correct value of fSize identifier
                                                                                }
  trClient.Socket.SendBuf(CurBloc, 1+ 256+ 4);
  bGo.OnClick:= bGoAbortTransf;
  bGo.Caption:= 'Abort';
end;

procedure TForm1.bGoAbortTransf(Sender: TObject);
begin
  ExecuteIt:= False;
  bGo.Enabled:= False;
  bGo.OnClick:= bGoClick;
  bGo.Caption:= 'GO';
end;

procedure TForm1.trClientRead(Sender: TObject; Socket: TCustomWinSocket);
var SendAgain: Byte;
begin
  Socket.ReceiveBuf(SendAgain, 1);
  case SendAgain of
    1: begin
         ListBox1.Items.Add('Transfer aborted...');
         bGo.Click;
         Exit;
       end;
    2: begin
         ListBox1.Items.Add('Connection closed by server...');
         bGo.Click;
         Exit;
       end;
  end;
  if CloseApplication then
  begin
    ExecuteIt:= False;
    Close;
  end;
  with CurBloc do
    case bOperation of
      1: begin
           bProgress:= 0;
           SendCurrentBloc;
         end;
      2: begin
           if bProgress >= FileToTransf.Size then
           begin
             ListBox1.Items.Add('Transfer completed.');
             bOperation:= 3;
             trClient.Socket.SendBuf(CurBloc, 1);
             bGo.Click;
           end
           else
             SendCurrentBloc;
         end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    ftName.Text:= OpenDialog1.FileName;
    ExecuteIt:= True;
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if fExecuteIt then
  begin
    CloseApplication:= True;
    CanClose:= False;
  end;
end;

procedure TForm1.trClientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ExecuteIt:= False;
end;

end.