Transfert de fichiers (sockets)

Soyez le premier à donner votre avis sur cette source.

Vue 18 482 fois - Téléchargée 4 493 fois

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.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
12
Date d'inscription
lundi 25 février 2008
Statut
Membre
Dernière intervention
25 mars 2011

Tres beau travaille je te félicite!
Messages postés
34
Date d'inscription
mardi 21 novembre 2000
Statut
Membre
Dernière intervention
16 juin 2016
1
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.
Messages postés
34
Date d'inscription
mardi 21 novembre 2000
Statut
Membre
Dernière intervention
16 juin 2016
1
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.
Messages postés
67
Date d'inscription
mercredi 4 avril 2007
Statut
Membre
Dernière intervention
19 juillet 2009

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.
Messages postés
34
Date d'inscription
mardi 21 novembre 2000
Statut
Membre
Dernière intervention
16 juin 2016
1
modifier le port.
Afficher les 15 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.