Dateigröße auslesen

[Stevie]

Zitat:

Zitat von robertthronhill

Delphi-Quellcode:

Progressbar1.Position :=(FileSize(SaveDialog1.Filename)*100)div SizeofIncomingStream;

Hab ich gerade übersehen. Geht das überhaupt? Wird die Datei nicht erst gespeichert, wenn der Stream geschlossen wird? Ich hab keine Ahnung... :gruebel:

[robertthronhill]

@ibp: Ich habe Delphi6 Enterprise Edition und da steht noch eine Zeile extra:

Zitat:

Hinweis

FileSize kann nicht für Textdateien verwendet werden.

@Stevie: Du hast recht. Sorry, ich habe nicht gewusst, dass der OnExecute-Teil nur einmal ausgeführt wird, ich hätte es mit aber denken können. Ich habe mal in der OH nachgeschaut, werden aber aus der "Hilfe" nicht schlau. Könntest du mir mal den entsprechenden Code für mein Programm schreiben, dass ich da endlich durchblicke? Wenn du den kompletten Code brauchst, dann poste ich ihn später.

Ich danke allen, die mir geholfen haben und denen, die mir noch helfen werden!

mfg
robertthronhill

[ibp]

..du sollst die txt-datei ja nicht zum bearbeiten öffnen, sondern du willst
die info, wie groß die datei ist, das kannst du dann doch so machen...

Delphi-Quellcode:

function TForm1.getfilesize(fname:tFileName):Longint;
var
   f: file of Byte;
begin
  result:=0;
  {$IOChecks OFF}
    AssignFile(f, fname);
    Reset(f);
    result := FileSize(f);
    CloseFile(f);
  {$IOChecks ON}
end;

[robertthronhill]

Ich habe das jetzt auf Stevie's Art gemacht blos irgendwo steckt noch der Wurm drin. Delphi findet keine Fehler, die ProgressBar läuft trotzdem nicht. Ich poste hier mal den kompletten SourceCode.

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ss: TServerSocket;
    Button1: TButton;
    cs: TClientSocket;
    chat: TMemo;
    LabeledEdit1: TLabeledEdit;
    Button2: TButton;
    Label2: TLabel;
    Button3: TButton;
    Edit1: TEdit;
    Button4: TButton;
    Label3: TLabel;
    Button5: TButton;
    Button6: TButton;
    IdTCPClient1: TIdTCPClient;
    IdTCPServer1: TIdTCPServer;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ProgressBar1: TProgressBar;
    Label4: TLabel;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  ip: string;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
begin
        Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
        ip:=LabeledEdit1.Text;
        cs.Host:=ip;
        cs.Active:=True;
        IdTCPClient1.Host:=ip;
end;

procedure TForm1.Button3Click(Sender: TObject);
var msg: String;
begin
        msg:=Edit1.Text;
        chat.Lines.Add(msg);
        cs.Socket.SendText(msg);
        Edit1.Text:='';
end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var rec: String;
begin
        rec:=Socket.ReceiveText;
        if (rec='Server Message: Someone is pinging you') then
        begin
                chat.Lines.Add(rec);
                cs.Socket.SendText('Server Message: Ping successful. The chat-partner answered.');
        end
        else
        chat.Lines.Add(rec);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
        cs.Socket.SendText('Server Message: Someone is pinging you');
        chat.Lines.Add('Server Message: Ping started');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        chat.Lines.Add('Server Message: Wellcome to MyChat 1.0');
        chat.Lines.Add('Server Message: Please enter your chat-partners ip in the field at the bottom of the');
        chat.Lines.Add('Server Message: programme and press connect.');
        chat.Lines.Add('Server Message: Then you can ping your chat-partner or send him/her a message.');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
        chat.Lines.Clear;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  fs: TFileStream;
begin
  if not OpenDialog1.Execute then exit;
  with IdTCPClient1 do
  begin
    fs := TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyWrite);
    Connect;
    try
      OpenWriteBuffer;
      try
        ProgressBar1.Max := fs.Size;
        WriteStream(fs, true, true);
        CloseWriteBuffer;
      except
        CancelWriteBuffer;
        raise;
      end;
    finally
      Disconnect;
      fs.Free;
    end;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  fs: TFileStream;
  SizeOfIncomingStream: integer;
begin
  if not SaveDialog1.Execute then exit; 
  fs := TFileStream.Create(SaveDialog1.Filename, fmCreate or fmShareExclusive); 
  with AThread.Connection do 
    try
      ProgressBar1.Max := SizeOfIncomingStream;
      SizeOfIncomingStream := ReadInteger;
      ReadStream(fs, SizeOfIncomingStream);
    finally
      Disconnect;
      fs.Free;
    end; 
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
        cs.Active:=False;
        ss.Active:=False;
        IdTCPServer1.Active:=False;
end;

procedure TForm1.IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
        if AWorkMode = wmRead then
        ProgressBar1.StepBy(AWorkCount);
        if AWorkMode = wmWrite then
        ProgressBar1.StepBy(AWorkCount);
end;

end.

Hoffentlich findet jemand meinen Fehler. Bin am verzweifeln :freak:
Danke für eurere Hilfe!

mfg
robertthronhill

[ibp]

hallo,
das verstehe ich nicht.....

Delphi-Quellcode:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread); 
var 
  fs: TFileStream; 
  SizeOfIncomingStream: integer; 
begin 
  if not SaveDialog1.Execute then exit; 
  fs := TFileStream.Create(SaveDialog1.Filename, fmCreate or fmShareExclusive); 
  with AThread.Connection do 
    try 
      ProgressBar1.Max := SizeOfIncomingStream; 
      SizeOfIncomingStream := ReadInteger; 
      ReadStream(fs, SizeOfIncomingStream); 
    finally 
      Disconnect; 
      fs.Free; 
    end; 
end;

... du deklarierst: SizeOfIncomingStream: integer;
... dann: weist du der Progressbar1.max diesen wert zu, aber wie groß ist der?
... erst danach weist du SizeOfIncomingStream den wert ReadInteger zu
.. vielleicht solltest du die codezeilen vertauschen!
gruß rene

[robertthronhill]

Danke für den Tipp. Ich habs gleich ausprobiert, es funktioniert aber immernoch nicht.

mfg
robertthronhill

[ibp]

die frage ist doch was kommt bei der progressbar an oder kommt überhaupt was an?

ProgressBar1.Max := SizeOfIncomingStream;
...
ProgressBar1.StepBy(AWorkCount);

lass dir doch mal die werte für SizeOfIncomingStream und AWorkCount anzeigen!

[robertthronhill]

Ich habe versucht das ganze Anzeigen zu lassen. In dieser:

Delphi-Quellcode:

procedure TForm1.IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
        if AWorkMode = wmRead then begin
        Label6.Caption:=IntToStr(SizeOfIncomingStream);
        Label7.Caption:=IntToStr(AWorkCount);
        ProgressBar1.StepBy(AWorkCount);
        end;
        if AWorkMode = wmWrite then begin
        Label6.Caption:=IntToStr(SizeOfIncomingStream);
        Label7.Caption:=IntToStr(AWorkCount);
        ProgressBar1.StepBy(AWorkCount);
        end;
end;

Funktion funktioniert es nicht. AWorkMode und SizeOfIncomingStream sollten aber in dieser Funktion während der Übertragung angezeit werden. Wenn ich SizeOfIncomingStream direkt nach dem Ankommen der Dateigröße beim Empfänger der Datei abfrage funktioniert es. Sourecode der Funktion bei der es funktioniert:

Delphi-Quellcode:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  fs: TFileStream;
begin
  if not SaveDialog1.Execute then exit;
  fs := TFileStream.Create(SaveDialog1.Filename, fmCreate or fmShareExclusive);
  with AThread.Connection do
    try
      SizeOfIncomingStream := ReadInteger;
      Label5.Caption:=IntToStr(SizeOfIncomingStream);
      ProgressBar1.Max := SizeOfIncomingStream;
      ReadStream(fs, SizeOfIncomingStream);
    finally
      Disconnect;
      fs.Free;
    end;
end;

Langsam habe ich das Gefühl, dass meine Funktion falsch ist.

Hoffe ihr könnt mir helfen

mfg
robertthronhill

[ibp]

dann ist da doch das problem...

das du SizeOfIncomingStream dir nicht in

procedure TForm1.IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer)

anzeigen lassen kannst ist klar da sie als lokale variable von

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);

definiert ist, sollte aber auch eine fehlermeldung gegeben haben!!!

wenn aber AWorkCount keine werte liefert, wie soll dann die progressbar was anzeigen ?

gruß rene

[Stevie]

Außerdem:
1. Lass das mit dem OpenWriteBuffer weg, denn dann wird alles intern gebuffert und du bekommst nix davon im OnWork-Event mit.
2. Beim Lesen musst du einen TMemoryStream verwenden, ihn einlesen und erst dann den SaveDialog aufrufen und das Ding speichern.

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    chat: TMemo;
    cs: TClientSocket;
    Edit1: TEdit;
    IdTCPClient1: TIdTCPClient;
    IdTCPServer1: TIdTCPServer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LabeledEdit1: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    SaveDialog1: TSaveDialog;
    ss: TServerSocket;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  ip: string;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ip := LabeledEdit1.Text;
  cs.Host := ip;
  cs.Active := True;
  IdTCPClient1.Host := ip;
end;

procedure TForm1.Button3Click(Sender: TObject);
var msg: string;
begin
  msg := Edit1.Text;
  chat.Lines.Add(msg);
  cs.Socket.SendText(msg);
  Edit1.Text := '';
end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var rec: string;
begin
  rec := Socket.ReceiveText;
  if (rec = 'Server Message: Someone is pinging you') then
  begin
    chat.Lines.Add(rec);
    cs.Socket.SendText('Server Message: Ping successful. The chat-partner answered.');
  end
  else
    chat.Lines.Add(rec);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  cs.Socket.SendText('Server Message: Someone is pinging you');
  chat.Lines.Add('Server Message: Ping started');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  chat.Lines.Add('Server Message: Wellcome to MyChat 1.0');
  chat.Lines.Add('Server Message: Please enter your chat-partners ip in the field at the bottom of the');
  chat.Lines.Add('Server Message: programme and press connect.');
  chat.Lines.Add('Server Message: Then you can ping your chat-partner or send him/her a message.');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  chat.Lines.Clear;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  fs: TFileStream;
begin
  if not OpenDialog1.Execute then exit;
  with IdTCPClient1 do
  begin
    fs := TFileStream.Create(OpenDialog1.FileName, fmShareDenyNone);
    Connect;
    try
//      OpenWriteBuffer;
      try
        ProgressBar1.Max := fs.Size;
        WriteInteger(fs.Size);
        WriteStream(fs, true, true);
//        CloseWriteBuffer;
      except
//        CancelWriteBuffer;
        raise;
      end;
    finally
      Disconnect;
      fs.Free;
    end;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
//  fs: TFileStream;
  ms: TMemoryStream;
  SizeOfIncomingStream: integer;
begin
  ms := TMemoryStream.Create;
  with AThread.Connection do
  try
    SizeOfIncomingStream := ReadInteger;
//    fs := TFileStream.Create(SaveDialog1.Filename, fmCreate or fmShareExclusive);
//    ProgressBar1.Max := SizeOfIncomingStream;
    ReadStream(ms, SizeOfIncomingStream);
    if not SaveDialog1.Execute then exit;
    ms.SaveToFile(SaveDialog1.FileName);
  finally
    Disconnect;
    FreeAndNil(ms);
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  cs.Active := False;
  ss.Active := False;
  IdTCPServer1.Active := False;
end;

procedure TForm1.IdTCPClient1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then
    ProgressBar1.StepBy(AWorkCount);
  if AWorkMode = wmWrite then
    ProgressBar1.StepBy(AWorkCount);
end;

end.

Das funktioniert auf jeden Fall!