AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi Problem mit Datei versenden!
Thema durchsuchen
Ansicht
Themen-Optionen

Problem mit Datei versenden!

Ein Thema von monty.ms · begonnen am 16. Okt 2005 · letzter Beitrag vom 17. Okt 2005
 
monty.ms

Registriert seit: 19. Nov 2004
76 Beiträge
 
#1

Problem mit Datei versenden!

  Alt 16. Okt 2005, 18:25
Hallo,

Ich hatte in dem Forum ein Tutorial gefunde, welches ich gleich mal ausprobiert habe!

http://www.delphipraxis.net/internal...ct.php?t=14914

Ich hab versucht das in mein Programm hinzu zufügen, allerdings will es bei mir nicht so richtig funktionieren..
Hier ist mal mein Code, vielleicht findet ihr ja den Fehler.


SERVER:

Delphi-Quellcode:
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
VAR sClientMsg : String;
    FileReceiver : TFileReceiver;
begin

 TRY
  sClientMsg := AThread.Connection.ReadLn(#$A,5500);
  FileReceiver := TFileReceiver.Create(AThread,sClientMsg);
  TRY
    IF FileReceiver.ServerMsgOK then
     BEGIN
      IF FileReceiver.Start then
       AThread.Connection.WriteLn('FILEOK')
      ELSE
       AThread.Connection.WriteLn('FILEERROR');
     END;
  FINALLY
   FileReceiver.free;
  END;

 EXCEPT
  AThread.Connection.Disconnect;
 END;

end;


CLIENT:

Delphi-Quellcode:
procedure TForm1.Button3Click(Sender: TObject);
VAR tmpMS : TMemoryStream;
iTmpSize : Longint;
iNextSize : Longint;
bError : Boolean;
sMsgToSvr : String;
iSendTime : Cardinal;
iTimeDiff : Cardinal;
BytesperSek : Double;
sCmd : String;

begin
 idTCPClient1.Disconnect;
 idTCPClient1.Host := Edit3.Text;
 idTCPClient1.Port := StrToIntDef(Edit4.Text,1563);

 TRY
  idTCPClient1.Connect(timeout);
 EXCEPT
  MessageDlg('Es konnte keine Verbindung zum Server: '+Edit3.Text+' auf Port: '+Edit4.Text+' hergestellt werden!', mtError,[mbOK],0);
 END;

 if idTCPClient1.Connected then begin
 sMsgToSvr := inttostr(fs.Size)+cSplitChar+ExtractFileName(Edit5.Text);
 idTCPClient1.WriteLn(sMsgToSvr);


 tmpMS := TMemoryStream.Create;
 
 TRY
 iFileSize := fs.Size;
 iTmpSize := 0;
 bError := false;
 Fs.Position := 0;

  WHILE (iTmpSize < iFileSize) and (not bError) DO BEGIN
   tmpMS.Clear;
   Application.ProcessMessages;
   iSendTime := GetTickCount;

   TRY
    iNextSize := iFileSize - iTmpSize;

    IF iNextSize > cFileSplitSize then
     iNextSize := cFileSplitSize;

    iTmpSize := iTmpSize + tmpMS.CopyFrom(fs,iNextSize);
    idTCPClient1.OpenWriteBuffer;
    idTCPClient1.WriteStream(tmpMS,true,true);
    idTCPClient1.CloseWriteBuffer;

    iTimeDiff := GetTickCount - iSendTime;

    ProgressBar1.Position := Round(iTmpSize/iFileSize*100);
    ProgressBar1.Repaint;

     TRY
      BytesperSek := Round(tmpMS.Size/1024/iTimeDiff*1000);
     EXCEPT
      BytesperSek := 0;
     END;

    Label16.Caption := FormatFloat('0.00',BytesperSek)+' KB/Sek';
    Label16.Repaint;

   EXCEPT
    bError := true;
   END;
  END;

   TRY
    sCmd := idTCPClient1.ReadLn(#$A,7500);
   EXCEPT
    sCmd := 'TimeOut-Error';
   END;

   idTCPClient1.Disconnect;

 FINALLY
  tmpMS.Clear;
  FreeAndNil(tmpMS);
 END;

 IF (not bError) and (sCmd = 'FILEOK') THEN
   Messagedlg('Datei wurde erfolgreich versendet!',mtInformation,[mbok],0)
 else
    Messagedlg('Fehler beim versenden der Datei!',mtError,[mbok],0)
 end;

end;
Die Variable fs und iFileSize habe ich unter private deklariert

Das Compilieren funktioniert einwandfrei, allerdings wenn ich die Datei senden will, kommt die Nachricht: "Fehler beim Versenden der Datei"! Eigentlich ist es ja fast das selbe wie im Tutorial und das funktioniert.

Oder liegt es an der FileReceiver.pas/FileReceiver.dcu ?

Danke schonmal für die Hilfe..

mfg. Monty
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 06:31 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz