Indy TCP/IP-Komponente: BytesSent/BytesReceived..?

[HenryX14]

Hallo,

Folgende Frage: Ich übertrage eine Datei mit Hilfe der TCP Komponente von Indy. Jetzt will ich da aber auch irgendeine art Statusanzeige haben, wie weit die Dateiübertragung fortgeschritten ist. Also: Wie kriege ich heraus wieviel Bytes übertragen worden sind und woher weiss der Empfänger wie groß die Datei ist?

Hier die Programmzeilen:

Server: (Empfänger)

Delphi-Quellcode:

unit uServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, IdBaseComponent, IdComponent,
  IdTCPServer;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
idtcpserver1.Active := false;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  stream: TFileStream;
begin
if FileExists('C:\test.jpg') then
        DeleteFile('C:\test.jpg');
    Stream := TFileStream.Create('C:\test.jpg',fmCreate);
    while Athread.Connection.Connected do
        Athread.Connection.ReadStream(Stream,-1,true);
    FreeAndNil(Stream);
end;

end.

Und Hier der Client: (Sender)

Delphi-Quellcode:

unit uClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls;

type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  stream: TFileStream;
begin
idTCPClient1.Connect(1000);
Stream := TFileStream.Create('C:\Dokumente und Einstellungen\HenryB\Eigene Dateien\Eigene Bilder\Danielfrage.jpg',fmOpenRead   + fmShareDenyNone);
idTCPClient1.OpenWriteBuffer;
idTCPClient1.WriteStream(Stream);
idTCPClient1.CloseWriteBuffer;
FreeAndNil(Stream);
idtcpclient1.Disconnect;
end;

end.

Vielen Dank schonmal im vorraus!

[sakura]

Bevor Du die Datei versendest, solltest Du einfach eine Information an den Sender mitgeben, wie die Datei heisst und wie groß diese ist. Damit weiss der dann schon einmal wieviel kommen wird und kann dass am Ende auch kontrollieren! Wenn Du die Daten in einen Stream speicherst, kannst Du gleichzeitig auch immer erfahren, wieviele Daten schon da sind.

...:cat:...

[HenryX14]

Das Problem dabei ist folgendes: Das programm (der Thread) "friert" ein, bis die datei übertragen ist. erst dann gibt er die vollständige größe zurück:

Delphi-Quellcode:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  stream: TFileStream;
  income,filename,groesse, filename2: String;
  i: Integer;
begin
income := AThread.Connection.ReadLn();
label1.Caption := income;
i := pos('|',income);
filename := copy(income,1,i-1);
label4.Caption := filename;
groesse := copy(income,i,length(income));
filename2 := extractfilename(filename);
label3.Caption := 'C:\'+filename2;
if FileExists('C:\'+filename2) then
        DeleteFile('C:\'+filename2);
    Stream := TFileStream.Create('C:\'+filename2,fmCreate);
    while Athread.Connection.Connected do begin
        Athread.Connection.ReadStream(Stream,-1,true);
        label5.Caption := IntToStr(AThread.Connection.RecvBufferSize);
        label2.Caption := IntToStr(stream.Size);
        end;
    FreeAndNil(Stream);
end;

Wie kann ich verhindern, dass der thread einfriert?

MfG Henry

[sakura]

Einfach die Komponente TIdAntiFreeze (Palette: Indy Misc) aufs Form packen und schon sollte es funktionieren.

...:cat:...

[Luckie]

Kennen die Indy's nicht sowas wie OnWork oder wie das bei denen heißt?

[HenryX14]

Hi,

Ok, AntiFreeze Komponente ist drauf. Ruckelt auch nicht mehr. Jedoch erhalte ich wie erst am Ende der Übertragung die empfangenen bytes. Mit OnWorkBegin, OnWork, OnWorkEnd hab ichs auch versucht. Funktioniert nicht. Hier der Code:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  stream: TFileStream;
  filename: TFileName;
begin
if opendialog1.Execute then
filename := opendialog1.FileName;
if fileexists(filename) then
begin
idTCPClient1.Connect(1000);
Stream := TFileStream.Create(filename,fmOpenRead   + fmShareDenyNone);
showmessage('Größe der Datei: '+IntToStr(stream.Size));
idTCPClient1.WriteLn(filename+'|'+IntToStr(stream.Size));
idTCPClient1.OpenWriteBuffer;
idTCPClient1.WriteStream(Stream);
idTCPClient1.CloseWriteBuffer;
FreeAndNil(Stream);
idtcpclient1.Disconnect;
end;
end;

procedure TForm1.IdTCPClient1WorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
progressbar1.Max := AWorkCountMax;
end;

procedure TForm1.IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
progressbar1.Position := AWorkCount;
end;

procedure TForm1.IdTCPClient1WorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
Progressbar1.Position := 0;
end;

Klappt nicht. Es scheint als würden dir Ereignisse nicht aufgerufen werden. Auf jedenfall tut sich in der ProgressBar nichts.... :x

Trotzem schonmal danke!

[HenryX14]

hab die Sache noch weiter eingegrenzt: OnWorkBegin wir korrekt ausgelöst. OnWorkEnd auch. Nur OnWork wird während der übertragung nicht ausgelöst! Woran kann das liegen? Weiterhin auffällig ist, das OnWorkEnd, und OnWorkBegin gleichzeitig ausgelöst werden. Überprüft hab ich das so:

Delphi-Quellcode:

procedure TForm1.IdTCPClient1WorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
progressbar1.Max := AWorkCountMax;
label5.Caption := 'OnWorkBegin wurde aufgerufen!: '+IntToStr(AWorkCountMax);
end;

procedure TForm1.IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
progressbar1.Position := AWorkCount;
label3.Caption := 'OnWork wurde aufgerufen!';
end;

procedure TForm1.IdTCPClient1WorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
Progressbar1.Position := 0;
label4.Caption := 'OnWorkEnd wurde aufgerufen!';
end;

komische sache. Ich prüfe das ganze lokal (d.h. server und client laufen gleichzeitig auf dem selben rechner..). Kann das vielleicht daran liegen?

[HenryX14]

:?: kann doch nicht soo kompliziert sein, oder? Hat nicht jemand einen Tip für mich? BITTE! :?:

[cgimda]

Das Problem habe ich auch.