begin process at 2010 02 10 11:59:15
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Réseau & Internet

 > TRANSFERT DE FICHIERS (SOCKETS)

TRANSFERT DE FICHIERS (SOCKETS)


 Information sur la source

Note :
9,5 / 10 - par 2 personnes
9,50 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Réseau & Internet Classé sous :transferer, fichiers, sockets Niveau :Expert Date de création :20/07/2005 Date de mise à jour :19/10/2009 15:56:38 Vu / téléchargé :10 907 / 3 174

Auteur : AccessToYou

Ecrire un message privé
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (15)
Ajouter un commentaire et/ou une note


 Description

   Ce programme vous permet de transferer des fichiers par SOCKETS, avec un traitement optimale des erreurs lors du transfert entre client et serveur. La vitesse du transfert peut atteindre 2 MB/s et plus. vous pouver transferer n'importe q'elle taille de fichier.

   Voir le code c'est gratuit.



 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

19 octobre 2009 15:56:38 :
Bug01: Interruption du transfert Bug02: Format de fichier transféré incorrecte

 Sources du même auteur

Source avec Zip CODAGE DÉCODAGE PDU 7BITS
Source avec Zip TBLOBFIELD
Source avec Zip TDJHSOCKETS COMPONENTS

 Sources de la même categorie

Source avec Zip BASE64/BASE64URL ENCODE/DECODE par f0xi
Source avec Zip AFFICHAGE DES INFODFS par fbalien
Source avec Zip Source avec une capture INTRA MESSENGER - DELPHI par keket
Source avec Zip CODAGE DÉCODAGE PDU 7BITS par AccessToYou
Source avec Zip Source avec une capture SIMPLEWEBBROWSER par cantador

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture NETTOYAGE AUTOMATIQUE DE NOMS DE FICHIERS par John Dogget
Source avec Zip Source avec une capture CYBERCOMPTEUR par HAFTARIFOUAD
Source avec Zip SAVE PROJET (V1.2.0.0) par EricStib
Source avec Zip Source avec une capture UN CRYPTEUR-DÉCRYPTEUR par supersnail
Source avec Zip UN PTIT CODE CLEANER (.BAT) POUR CEUX QUI VEULENT POSTER LEU... par hurrycane

Commentaires et avis

Commentaire de djmmix le 20/07/2005 12:37:04

salut ta source est nikel mais permet telle de telecharger sur internet et pourquoi ta pas combiner les deux pour pouvoir telecharger des fichier car sa m interesserai de faire un logiciel de telechargement maison qui pourrai upload et download(voila pourquoi je veut combiner les deux).

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

salut ta source est nikel merci :)

Commentaire de tichau4 le 01/11/2005 12:07:22

L'adresse ip du serveur est son adresse ip local ou interent !
Je n'arrive pas a avoir le bouton GO Alumé !

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 TheRealMithrandir le 20/05/2006 22:46:11

Mecsympa:

J'ignore si tu as trouvé la réponse a ta question. Alors je la poste ici. Ses composants ne sont plus supportés dans Delphi 7 a cause de l'intégration des composants Indy. Tu peux néanmoins les utiliser en ajoutant le paquet correspondant qui se trouve dans le répertoire bin de delphi et qui s'appelle dclsockets70.bpl (menu de delphi composant / installer un paquet / ajouter)

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

ok

Commentaire de labchara le 09/07/2007 12:21:16

Code super sympa , trés lisible , felicitations
je l'ai essayé en local ca marche super
par contre en reseau le bouton OK reste inactif meme en changeant l'adresse IP hote

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 AccessToYou le 10/07/2007 18:44:14

Activer le boutton GO dans l'inspecteur d'objet ou ajouter
l'instruction bGo.Enabled:= True; dans l'evennement OnCreate de la fiche pricipale.

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 AccessToYou le 16/09/2007 03:35:13

modifier le port.

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 06/07/2009 16:33:22

Salut NIRG;
  Minimiser la taille du tableau [bDatas] dans la déclaration:
    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..1023] of Char );

       3: ();
    end;
coté serveur et client.
recomplier et bonne prog.

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.

Commentaire de damahom le 29/01/2010 01:42:06

Tres beau travaille je te félicite!

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

copie de fichiers vers un répertoire aléatoire et non défini [ par sasa ] Voilà j'ai quelques problèmes à créer une applicationEn fait je n'arrive pas à trouver la commande pour copier certains fichiers d'un CD vers un réper Uploader des fichiers sur un FTP ? [ par ELECTRORESiSTiK ] Salut, je voudrais faire un petit client FTP qui ne fait que l'upload de fichier ou de répertoire sur un FTP... Pourriez-vous m'aider... Je en sais pa fichiers .ini encore une petite fois ! [ par finipe ] Bonjour à tous... Je cherche tant bien que mal à récupérer toutes mes sections d'un fichier .ini (enfin les trucs entre []), afin de les mettre dans u Delphi 5 , Paradox et "Blob OLE fichiers Word" [ par lomig ] Bonjour, je travaille actuellement sur une BDD dont une des tables contient un champ contenant un fichiers word (liens OLE).j'ai bien compris que pour Lien vers des fichiers dans une bdd??? [ par pedrito83 ] débutant confirmé ;-)Voilà, je dois programmer en Delphi2 (oui je sais on en est au 6 ) et je débute en delphi (1 semaine que je programme seulement ) Glissage de fichiers !!! [ par MAsterC ] Si je crée un programme dans Delphi(6) du même style que "Bloc-note de Windows". Puis si je ouvrir mon "Bloc-note de Windows" et que je prend un (Fich Aide pour un éditeur de Texte ! dans un richedit. [ par nirousse ] Je désire ouvrir des fichiers texte avec mon logiciel.Mais, je ne sais pas comment je dois faire pour ouvrir l'un après l'autre les fichiers.Une boucl Les 10 derniers fichiers ouverts ! [ par nirousse ] Toujours pour mon éditeur de texte, je voudrais faire un sous-menu ou je mettrais les 10 derniers fichiers ouverts.Est-ce que quelqu'un aurait une ast DELPHIX : fichiers *.DXG et *.DXW [ par mipou ] J'aimerais savoir comment on fait pour créer lesfichiers :*.dxg : images et *.dxw : sonsque l'on utilise dans les animations des 'sprite'.J'en ai récu progressbar et upload aide urgente merci [ par ELECTRORESiSTiK ] Salut,J'ai fait un petit programme qui envoi des fichiers se trouvant dans une listbox, je voudrais voir la progression de l'upload de chaque fichier


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 1,201 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales