AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte Beispiel zum Versenden von Dateien mit Indy

Beispiel zum Versenden von Dateien mit Indy

Ein Thema von DataCool · begonnen am 12. Dez 2003 · letzter Beitrag vom 20. Okt 2008
Antwort Antwort
Seite 6 von 6   « Erste     456
Benutzerbild von DataCool
DataCool
Registriert seit: 10. Feb 2003
Hi Leute,

auf vielfachen Wunsch habe ich nochmal ein Beispiel zum Versenden von Dateien mit Indy erstellt.

Das Beispiel enthält Client und Server incl. Sourcecode natürlich.

Desweiteren verfügen Client und Server über eine Progressbar die den Übertragungsstatus anzeigt und eine Anzeige der aktuellen Sendegeschwindigkeit.

Würde mich über ein kleines Feeedback freuen

Gruß Data
Angehängte Dateien
Dateityp: zip filesend_clientserver_197.zip (445,0 KB, 2006x aufgerufen)
Der Horizont vieler Menschen ist ein Kreis mit Radius Null, und das nennen sie ihren Standpunkt.
 
Benutzerbild von DataCool
DataCool

 
Delphi 10.3 Rio
 
#51
  Alt 13. Jul 2008, 22:01
Freut mich immer wieder zu hören ^^^^

Greetz Data
  Mit Zitat antworten Zitat
Andi067
 
#52
  Alt 16. Okt 2008, 13:37
So, weil ich jetzt auch recht lange gesucht habe und immer wieder "nur" auf dieses schöne Beispiel mit Indy 9 gekommen bin, hab ich es dann mal angepackt und eine (bei mir) mit Indy10 lauffähige Version hinbekommen. Leider tuts die Anzeige im Server nicht so ganz, war mir aber nicht wirklich wichtig. Ansonsten kann ja vieleicht jemand was damit anfangen...

F_Main.pas Server:
Delphi-Quellcode:
unit f_Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,IdCustomTCPServer,
  IdTCPServer, ComCtrls, IdStreamVCL,idtask,idcontext;

type
   TfrmMainServer = class(TForm)
    gb_Einstellungen: TGroupBox;
    ed_Port: TEdit;
    TcpServer: TIdTCPServer;
    IdAntiFreeze1: TIdAntiFreeze;
    Label1: TLabel;
    cmd_StartServer: TButton;
    cmd_EndServer: TButton;
    Label2: TLabel;
    lab_SvrStatus: TLabel;
    gb_Threads: TGroupBox;
    ScrollBox1: TScrollBox;
    gb_Test: TGroupBox;
    pBar: TProgressBar;
    Label3: TLabel;
    lab_FileSize: TLabel;
    Label5: TLabel;
    lab_ReceivedBytes: TLabel;
    procedure TcpServerExecute(AContext: TIdContext);
    procedure cmd_StartServerClick(Sender: TObject);
    procedure cmd_EndServerClick(Sender: TObject);
// procedure TcpServerExecute1(AThread: TIdPeerThread);
    procedure FormShow(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  frmMainServer: TfrmMainServer;

implementation

uses FileReceiver;

{$R *.DFM}

procedure TfrmMainServer.cmd_StartServerClick(Sender: TObject);
begin
   // erstmal eventuelle bestehende Verbindungen trennen
   TcpServer.Active := false;
   // Bindings leeren
   TcpServer.Bindings.Clear;
   // Port zuweisen, wenn kein gültiger Wert eingetragen ist 9876 als Standard verwenden
   TcpServer.DefaultPort := StrToIntDef(ed_Port.Text,9876);
   try
      TcpServer.Active := true;
   except
      raise;
   end;
   // Ist der Server erfolgreich gestartet worden ?
   if TcpServer.Active then begin
      // jetzt die Anzeige-Elemente dem Status anpassen
      cmd_EndServer.Enabled := true;
      cmd_StartServer.Enabled := false;
      lab_SvrStatus.Font.Color := clGreen;
      lab_SvrStatus.Caption := 'Gestartet';
   end;
end;

procedure TfrmMainServer.cmd_EndServerClick(Sender: TObject);
begin
   // Server anhalten/deaktivieren
   try
      TcpServer.Active := false;
   except
      raise;
   end;
   // Ist der Server erfolgreich beendet worden
   if not TcpServer.Active then begin
      // jetzt die Anzeige-Elemente dem Status anpassen
      cmd_EndServer.Enabled := false;
      cmd_StartServer.Enabled := true;
      lab_SvrStatus.Font.Color := clRed;
      lab_SvrStatus.Caption := 'Deaktiviert';
   end;
end;

procedure TfrmMainServer.TcpServerExecute(AContext: TIdContext);
Var sClientMsg : String;
      FileReceiver : TFileReceiver;
begin
   try
      // Clientnachricht lesen
      sClientMsg := AContext.Connection.IOHandler.ReadLn(#$A,5500);
      FileReceiver := TFileReceiver.Create(AContext,sClientMsg);
      try
         // gültige Nachricht vom Client ?
         if FileReceiver.ServerMsgOK then begin
            // Datei jetzt empfangen
            if FileReceiver.Start then
               // Bestätigung zum Clientschreiben
               AContext.Connection.IOHandler.WriteLn('FILEOK')
            else
               // Error-Nachricht schreiben
               AContext.Connection.IOHandler.WriteLn('FILEERROR');
         end;
      finally
         FileReceiver.free;
      end;
   except
      AContext.Connection.Disconnect;
   end;
end;

{procedure TfrmMainServer.TcpServerExecute1(AThread: TIdPeerThread);
Var sClientMsg : String;
      FileReceiver : TFileReceiver;
begin
   try
      // Clientnachricht lesen
      sClientMsg := AThread.Connection.ReadLn(#$A,5500);
      FileReceiver := TFileReceiver.Create(AThread,sClientMsg);
      try
         // gültige Nachricht vom Client ?
         if FileReceiver.ServerMsgOK then begin
            // Datei jetzt empfangen
            if FileReceiver.Start then
               // Bestätigung zum Clientschreiben
               AThread.Connection.WriteLn('FILEOK')
            else
               // Error-Nachricht schreiben
               AThread.Connection.WriteLn('FILEERROR');
         end;
      finally
         FileReceiver.free;
      end;
   except
      AThread.Connection.Disconnect;
   end;
end;
}

procedure TfrmMainServer.FormShow(Sender: TObject);
begin
   // test-groupbox löschen
   gb_Test.free;
end;

end.

Filereceiver.pas
Delphi-Quellcode:
unit FileReceiver;

interface

uses Classes, SysUtils, stdctrls, comctrls, IdTCPServer,
//Neu
   idcontext;

type

   TFileReceiver = Class
      private
         fServerMsgOk : Boolean;
         // Optische Elemente zur Darstellung des Threads
         fGB : TGroupBox;
         fpBar : TProgressBar;
         fLabFSText : TLabel;
         fLabFS : TLabel;
         fLabReText : TLabel;
         fLabRe : TLabel;
         // Indy-Server-Thread
//alt         AThread : TIdPeerThread;
         AThread : TIdContext;
         // wichtige Elemente zum Empfangen der Datei
         iFileSize : Cardinal;
         iReceivedBytes : Cardinal;
         sFileName : String;
         tmpMS : TMemoryStream;
         procedure CreateElements;
         procedure DestroyElements;
         Function VBSplit(Liste : TStringList; Text2Split : String; SeperatorStr : String) : Boolean;
         procedure UpdateProgress;
      protected
         //
      public
//alt Constructor Create(Thread : TIdPeerThread; Msg : String);
      Constructor Create(Thread : TIdContext; Msg : String);
         Destructor Free;

         property ServerMsgOK : Boolean read fServerMsgOk write fServerMsgOk;
         
         function Start : Boolean;
   end;

implementation

uses f_Main, Controls;

{ TFileReceiver }

constructor TFileReceiver.Create(Thread: TIdContext; Msg: String);
Var strL : TStringList;
begin
   fServerMsgOk := false;
   AThread := Thread;
   if AThread = Nil then
      exit;
   // Zwischenspeicher zum empfangen der Pakete erzeugen
   tmpMS := TMemoryStream.Create;
   // Nachricht vom Client splitten
   strL := TStringList.create;
   try
      VBSplit(strL,Msg,'|');
      // eine gültige Client-Nachricht besteht aus zwei Teilen
      if strL.Count = 2 then begin
         // zweites Elemt die Gesamtdateigrösse
         iFileSize := StrToIntDef(strL[0],0);
         fLabFS.Caption := Inttostr(iFileSize)+' Bytes';
         // drittes Element enthält den Filenamen
         sFileName := strL[1];
         //prüfen, ob gültige Werte übertragen wurden
         fServerMsgOk := ((iFileSize > 0) and (Length(sFileName) > 0));
      end;
   finally
      strL.free;
   end;
   CreateElements;
end;

destructor TFileReceiver.Free;
begin
   tmpMS.Clear;
   FreeAndNil(tmpMS);
  DestroyElements;
end;


procedure TFileReceiver.CreateElements;
begin
   // GroupBox erzeigen
   fGB := TGroupBox.Create(frmMainServer.ScrollBox1);
   fGB.Parent := frmMainServer.ScrollBox1;
   fGB.Height := 57;
   fGB.Align := alTop;
   fGB.Caption := 'Client('+AThread.Connection.Socket.Binding.PeerIP+') überträgt '+sFileName;
   fGB.Visible := true;

   // Progressbar erzeugen
   fpBar := TProgressBar.Create(fGB);
//   fpBar.Parent := fGB;
   fpBar.Left := 8;
   fpBar.Top := 24;
   fpBar.Width := 337;
   fpBar.Anchors := [akLeft,akTop,akRight];
   fpBar.Visible := true;

   // Labels erzeugen
   fLabFSText := TLabel.create(fGB);
//    fLabFSText.Parent := fGB;
   fLabFSText.Left := 368;
   fLabFSText.top := 16;
   fLabFSText.Anchors := [akTop,akRight];
   fLabFSText.Caption := 'Filesize: ';
   fLabFSText.Visible := true;

   fLabFS := TLabel.create(fGB);
//   fLabFS.Parent := fGB;
   fLabFS.Caption := '0,00 KB';
   fLabFS.left := 547;
   fLabFS.top := 16;
   fLabFS.Anchors := [akTop,akRight];
   fLabFS.Alignment := taRightJustify;
   fLabFS.Visible := true;
   fLabFS.Caption := FormatFloat('0.00',iFileSize/1024)+' KB';

   fLabReText := TLabel.create(fGB);
//   fLabReText.Parent := fGB;
   fLabReText.Left := 368;
   fLabReText.top := 32;
   fLabReText.Anchors := [akTop,akRight];
   fLabReText.Caption := 'Received: ';
   fLabReText.Visible := true;

   fLabRe := TLabel.create(fGB);
 //   fLabRe.Parent := fGB;
   fLabRe.Caption := '0,00 KB';
   fLabRe.left := 547;
   fLabRe.top := 32;
   fLabRe.Anchors := [akTop,akRight];
   fLabRe.Alignment := taRightJustify;
   fLabRe.Visible := true;

   //fgb.Repaint;
   frmMainServer.ScrollBox1.Repaint;

end;

procedure TFileReceiver.DestroyElements;
begin
   // hier nur die Groupbox freigeben, alle anderen Controls nicht Childs der GroupBox
   // und werden somit mit freigegeben
   fGB.free;
end;

// ********* VBSplit ***********************************************************
// Author 23.3.2001 J. Freese alias DataCool
// Function Splits a string in different substring speraded by SeperatorStr
// Param List where the substrings were added
// Text2Split string which should be splitted
// SeperatorStr String which are used as Seperator
// Return true if success
function TFileReceiver.VBSplit(Liste: TStringList; Text2Split, SeperatorStr: String): Boolean;
Var Posi     : Longint;
      strTemp : String;
      strPart : String;
      bInLoop : Boolean;
      sepLen : Longint;
begin
   result := true;
   bInLoop := false;
   try
      //Liste leeren
      Liste.clear;
      strTemp := Text2Split;
      sepLen := Length(SeperatorStr);
      Posi := Pos(SeperatorStr,strTemp);
      While Posi > 0 do begin
         bInLoop := true;
         strPart := Copy(strTemp,1,Posi-1);
         Liste.Add(strPart);
         strTemp := copy(strTemp,Posi+sepLen,Length(strTemp)-(Posi+sepLen-1));
         Posi := Pos(SeperatorStr,strTemp);
      end;
      if (bInLoop) or (Length(strTemp)>0) then
         Liste.add(strTemp);
   except
      Result := false;
   end;
end;

function TFileReceiver.Start : Boolean;
Var bError : Boolean;
      bReady : Boolean;
      fs : TFileStream;
begin
   result := true;
   if iFileSize > 0 then begin
      // Alle Startwerte setzen
      bError := false;
      bReady := false;
      iReceivedBytes := 0;
      // erstmal versuchen die Datei zu erstellen
      // das Zielverzeichnis wo die Daten gespeichert werden sollen könnt Ihr nachher selber bestimmen
      sFileName := 'C:\'+sFileName;
      try
         fs := TFileStream.Create(sFileName,fmCreate or fmShareExclusive);
      except
         // Fehler beim Erstellen der Datei aufgetreten
         result := false;
         exit;
      end;
      try
         // Solange keine Abbruch Bediengung erreicht ist Stream-Pakete lesen
         While //(not AThread.Terminated) and
            (AThread.Connection.Connected) and
                  (not bError) and (not bReady) do begin
            // Buffer(Speicher-Stream) leeren
            tmpMS.clear;
            try
               // versuchen Stream zu Lesen
               AThread.Connection.IOHandler.ReadStream(tmpMS);
               // Steht jetzt auch wirklich was im Stream drin
               if tmpMS.Size > 0 then begin
                  // die gelesenen Bytes jetzt direkt in den FileStream schreiben
                  fs.copyFrom(tmpMS,0);
                  // Anzahl der gelesenen Bytes erhöhen
                  iReceivedBytes := iReceivedBytes + tmpMS.Size;
                  // jetzt durch den Thread die Methode UpdateProgress ausführen
                  // dieses muss mit Syncronize gemacht werden, mehr dazu in Delphi Hilfe
                //   AThread.Synchronize(UpdateProgress);
           updateProgress;
               end;
               bReady := (fs.Size = iFileSize);
            except
               // Fehler beim Lesen des Stream aufgetreten, Speicher leeren
               tmpMS.Clear;
               // Vorgang abbrechen
               bError := true;
            end;
         end;
      finally
         fs.free;
         if bError then
            DeleteFile(sFileName);
      end;
      result := FileExists(sFileName);
   end;
end;

procedure TFileReceiver.UpdateProgress;
Var ipBarPos : Longint;
begin
   // Label anpassen
   fLabRe.Caption := FormatFloat('0.00',iReceivedBytes/1024)+' KB';
   // Prozent-Wert für Progressbar-Fortschritt ausrechnen
   ipBarPos := Round(iReceivedBytes/iFileSize*100);
   // neue Position setzen
   fpBar.Position := ipBarPos;
   // GroupBox und alle Unterelemente neu zeichnen
   fgb.Repaint;
end;

end.
und schließlich F_Main.pas (Client)

Delphi-Quellcode:
unit f_Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
   IdTCPConnection, IdTCPClient, Buttons, ComCtrls;

Const

   // jede Datei wird in mehere Stücke a folgende Größe zerlegt
   cFileSplitSize : Longint = 20*1024; // Bytes = 20 KB

   // Trennzeichen was bei der Kommunikation mit dem Server benutzt wird
   cSplitChar : String = '|';

type
  TfrmMainClient = class(TForm)
    gb_Server: TGroupBox;
    Ed_ServerIP: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    ed_Port: TEdit;
    TcpCon: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;
    gb_File: TGroupBox;
    ed_File: TEdit;
    sb_FindFile: TSpeedButton;
    OpenDlg: TOpenDialog;
    cmd_Send: TBitBtn;
    pBar_SendProgress: TProgressBar;
    lab_SendProgress: TLabel;
    lab_SendSpeedText: TLabel;
    lab_Speed: TLabel;
    procedure sb_FindFileClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure cmd_SendClick(Sender: TObject);
  private
      { Private-Deklarationen }
      procedure HideSendComponents;
      procedure ShowSendComponents;
      function checkValues : Boolean;
  public
      { Public-Deklarationen }
      iFileSize : Longint;
  end;

var
  frmMainClient: TfrmMainClient;

implementation

{$R *.DFM}

// Datei die verschickt werden soll suchen
procedure TfrmMainClient.sb_FindFileClick(Sender: TObject);
begin
   // Wenn kein Startverzeichnis gesetzt ist
   if OpenDlg.InitialDir = 'then
      // setzen wir das Startverzeichnis auf das Anwendungsverzeichnis
      OpenDlg.InitialDir := ExtractFilePath(Application.ExeName);
   // OpenFileDialog ausführen
   if OpenDlg.Execute then begin
      ed_File.Text := OpenDlg.FileName;
   end;
end;

// Alle Komponenten die zum Anzeigen des Sendevorgangs benötigt werden einblenden
procedure TfrmMainClient.ShowSendComponents;
begin
   frmMainClient.Height := 226;
   lab_SendProgress.Visible := true;
   lab_SendSpeedText.Visible := true;
   lab_Speed.Visible := true;
   pBar_SendProgress.Visible := true;
end;

// Alle Komponenten die zum Anzeigen des Sendevorgangs benötigt werden ausblenden
procedure TfrmMainClient.HideSendComponents;
begin
   lab_SendProgress.Visible := false;
   lab_SendSpeedText.Visible := false;
   lab_Speed.Visible := false;
   pBar_SendProgress.Visible := false;
   frmMainClient.Height := 190;
end;


procedure TfrmMainClient.FormShow(Sender: TObject);
begin
   // Beim Start des Programms Sende-Komponenten ausblenden
   HideSendComponents;
end;

// alle Angaben die zum Versenden der Datei benötigt werden, auf Gültigkeit überprüfen
function TfrmMainClient.checkValues: Boolean;
Var iTmp : Longint;
begin
   result := true;
   // Ist eine Server-IP angegeben ?
   if Length(trim(Ed_ServerIP.Text)) = 0 then begin
      Messagedlg('Bitte tragen Sie die IP-Adresse des Servers ein !',mtInformation,[mbok],0);
      Ed_ServerIP.SetFocus;
      result := false;
      exit;
   end;
   // Handelt es sich bei der Port-Angabe um einen ganzzahligen Wert ?
   iTmp := StrToIntDef(ed_Port.text,-1);
   if iTmp = -1 then begin
      Messagedlg('Bitte tragen Sie eine gültige Portnummer ein !',mtInformation,[mbok],0);
      ed_Port.SetFocus;
      result := false;
      exit;
   end;
   // überprüfen, ob die Datei die verschickt werden soll existiert
   if not FileExists(ed_File.Text) then begin
      Messagedlg('Die angegebene Datei existiert nicht, bitte wählen Sie eine Datei aus!',mtInformation,[mbok],0);
      ed_File.SetFocus;
      result := false;
      exit;
   end;
end;

procedure TfrmMainClient.cmd_SendClick(Sender: TObject);
Var fs : TFileStream; // Zum Lesen der Datei
      tmpMs : TMemoryStream; // temporärer Speicherstream zum Splitten der Datei, ab bestimmter Grösse
      iTmpSize : Longint; // Zähler um sich zu merken, wieviel Bytes schon gebuffert/gesendet wurden wurden
      iNextSize : Longint; // Byte-Anzahl die gelesen werden sollen
      bError : Boolean; // Bool-Schalter für Fehlererkennung
      sMsgToSvr : String; // Nachricht für den Server
      iSendTime : Cardinal; // Zeitmesser auch nachher zum lesen
      iTimeDiff : Cardinal; // Var zum Zeit-Differenz berechnen
      BytesperSek : Double;
      sCmd : String;
begin
   // als erstes die Usereingaben prüfen
   if not checkValues then exit;

   // als erstes versuchen die Datei zu öffnen, so das niemand mehr in diese Datei schreiben kann
   try
      fs := TFileStream.Create(ed_File.Text,fmOpenRead or fmShareDenyWrite);
   except
      MessageDlg(ed_File.Text+' kann nicht geöffnet werden ! '+#10#13
               +'Wahrscheinlich ist diese Datei von einer anderen Anwendung geöffnet !',
               mtError,[mbok],0);
      exit;
   end;
   // Verbindung zum Server herstellen
   TcpCon.Disconnect;
   TcpCon.Host := Ed_ServerIP.text;
   TcpCon.Port := StrToIntDef(ed_Port.Text,9876);
   // Versuchen eine Verbindung zum Server herzustellen
   try
      TcpCon.Connect(5000); // max. 5 Sek. um die Verbindung zum Server herzustellen
   except
      Messagedlg('Es konnte keine Verbindung zum Server: '+Ed_ServerIP.text+' auf Port: '+ed_Port.Text+' hergestelt werden!',
             mtError,[mbok],0);
      exit;
   end;
   if TcpCon.Connected then begin
      // Übertragungskomponenten anzeigen
      ShowSendComponents;
      // jetzt muss der Server natürlich wissen wieviele Bytes vom Client kommen,
      // und wie die Datei heisst
      sMsgToSvr := inttostr(fs.size)+cSplitChar+ExtractFileName(ed_File.Text);
      // Nachricht zum Server schicken
      TcpCon.WriteLn(sMsgToSvr);
      // Server ist bereit zum Empfangen und die Verbindung besteht jetzt anfangen
      // die Datei zu Senden
      tmpMS := TMemoryStream.Create;
      try
         // Gesamtgrösse der Datei merken
         iFileSize := fs.Size;
         // Bufferzähler auf Null u. Error auf false
         iTmpSize := 0;
         bError := false;
         // Stream Position wieder auf Anfang setzen (nur zur Sicherheit)
         fs.Position := 0;
         // Solange nicht alle Daten im versendet wurden, diese Stückweise versenden
         while (iTmpSize < iFileSize) and (not bError) do begin
            tmpMs.clear;
             // Anwenung etwas Zeit zur Nachrichten-Verarbeitung geben
            Application.ProcessMessages;
            iSendTime := GetTickCount;
            try
               // als ersten berechnen wie viel Bytes zum Senden noch da sind
               iNextSize := iFileSize - iTmpSize;
               // Wenn die Byte Anzahl > der FileSplitSize ist, dann muss weiter gesplittet werden
               if iNextSize > cFileSplitSize then
                  iNextSize := cFileSplitSize;
               iTmpSize := iTmpSize + tmpMs.CopyFrom(fs,iNextSize);
               TcpCon.OpenWriteBuffer;
               TcpCon.WriteStream(tmpMS,true,true);
               TcpCon.CloseWriteBuffer;
               // Wenn die Übertragung im Lan über Delphi getestet wird, bitte folgendes Sleep
               // aktivieren, das verlangsamt zwar die Übertragung, aber ansonsten gibt es
               // bei der Berechnung der Sendegeschwindigkeit, divion 0 error
               sleep(25); // im realen Betrieb auskommentieren
               // Zeit die fürs Senden gebraucht wurde ausrechnen
               iTimeDiff := GetTickCount - iSendTime;
               // Fortschrittsanzeige aktualisieren
               pBar_SendProgress.Position := Round(iTmpSize/iFileSize*100);
               pBar_SendProgress.Repaint;
               // aktuelle Geschwindigkeit ausrechnen
               try
                  BytesperSek := round(tmpMs.Size/1024/iTimeDiff*1000);
               except
                  BytesperSek :=0;
               end;
               // Geschwindigkeit anzeigen
               lab_Speed.Caption := FormatFloat('0.00',BytesperSek)+ ' KB/Sek.';
               lab_Speed.Repaint;
            except
               bError := true;
            end;
         end;
         // Bestätigung vom Server lesen
         try
            sCmd := TcpCon.ReadLn(#$A,7500);
         except
            sCmd := 'TimeOut-Error';
         end;
         // Verbindung trennen
         TcpCon.Disconnect;
      finally
         tmpMs.Clear;
         FreeAndNil(tmpMs);
      end;
      HideSendComponents;
      // War die Übertragung der DAtei erfolgreich ?
      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;


end.
Vieleicht hilfts ja jemandem...
Gruß
A
  Mit Zitat antworten Zitat
Benutzerbild von hincapie
hincapie

 
Delphi 5 Professional
 
#53
  Alt 20. Okt 2008, 10:09
Zitat von hincapie:
Bin noch nicht entscheidend weiter gekommen:
Nochmal meine Frage:
Wie bringe ich den Server dazu, die empfangenen Dateien an alle Clients weiterzuverteilen?
Ich zitiere mich ausnahmsweise mal selber, da ich zu dieser Frage inzwischen eine Antwort gefunden habe, die ich teilweise schon in diesem Thread beschrieben habe: http://www.delphipraxis.net/internal...=954701#954701

Also, hier nochmal ausführlich, mit Indy 9 erstellt und getestet:

Ich drücke auf einen Button, um eine Datei zu versenden:
Delphi-Quellcode:
procedure TForm1.FileButtonClick(Sender: TObject);
Var
  fs : TFileStream; // Zum Lesen der Datei
  iTmpSize : Longint; // Zähler um sich zu merken, wieviel Bytes schon gebuffert/gesendet wurden wurden
  SendSize,
  SendSize1 : Longint; // Byte-Anzahl die gelesen werden sollen
  bError : Boolean; // Bool-Schalter für Fehlererkennung
  sMsgToSvr : String; // Nachricht für den Server
begin
  // als erstes die Usereingaben prüfen
  Timer2.Enabled := False;
  if OpenDialog1.Execute then
  begin
    FileSend := OpenDialog1.FileName;
    if not FileExists(FileSend) then
    begin
      Messagedlg('Die angegebene Datei existiert nicht, bitte wählen Sie eine Datei aus!',mtInformation,[mbok],0);
      exit;
    end;
    // als erstes versuchen die Datei zu öffnen, so das niemand mehr in diese Datei schreiben kann
    try
      fs := TFileStream.Create(FileSend,fmOpenRead or fmShareDenyWrite);
    except
      MessageDlg(FileSend+' kann nicht geöffnet werden ! '+#10#13
        +'Wahrscheinlich ist diese Datei von einer anderen Anwendung geöffnet !',
        mtError,[mbok],0);
      exit;
    end;
    if IdTcpClient1.Connected then
    begin
      // Übertragungskomponenten anzeigen
      TBXAlignmentPanel1.Visible := True;
      ProgressBar1.Visible := True;
      ProgressBar1.Position := 0;
      // jetzt muss der Server natürlich wissen wieviele Bytes vom Client kommen,
      // und wie die Datei heisst
      sMsgToSvr := ExtractFileName(FileSend);
      try
        try
          bError := false;
          SendSize := fs.Size;
          SendSize1 := SendSize;
          ProgressBar1.Min := 0;
          ProgressBar1.Max := iTmpSize;
          ProgressBar1.Position := 0;
          while iTmpSize > 0 do
          begin
            SendSize1 := iTmpSize;
            if SendSize1 > 1024 then SendSize1 := 1024;
            Dec(iTmpSize, SendSize1);
            ProgressBar1.Position := ProgressBar1.Position + SendSize1;
          end;
          IdTcpClient1.WriteInteger(4);
          IdTcpClient1.WriteLn(sMsgToSvr);
          IdTcpClient1.WriteInteger(SendSize);
          idTCPClient1.OpenWriteBuffer;
          idTcpClient1.WriteStream(fs, False, False, SendSize);
          idTCPClient1.CloseWriteBuffer;
        finally
          fs.Free;
          TBXAlignmentPanel1.Visible := False;
          ProgressBar1.Visible := False;
          ProgressBar1.Position := 0;
        end;
      except
        on E: Exception do
        begin
          ShowMessage(E.Message);
          bError := true;
          Log(101, E.Message);
        end;
      end;
      // War die Übertragung der DAtei erfolgreich ?
      if not bError then
      begin
        Log(100, 'File ' + sMsgToSvr + ' with ' + IntToStr(SendSize) + ' kbs has been sent!');
        PostMessage(avatar, 'File ' + sMsgToSvr + ' with ' + IntToStr(SendSize) + ' kbs has been sent!');
      end;
      if bError then
      begin
        Log(101, 'Failed to send the file!');
        PostMessage(avatar, 'Failed to send the file!');
      end;
    end;
  end;
end;
Der Server erhält den entsprechenden Befehl, die Größe der Datei sowie die Datei selber und schickt sie an alle angeschlossenen Clients:
(Achtung, hier ist die Lösung etwas anders als urprünglich gepostet, die Datei 'FileReceiver.pas' habe ich ganz weg gelassen)
Delphi-Quellcode:
procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);
var
  Client : TSimpleClient;
  Com, // System command
  sMsgToClt, FileName, Msg: String;
  Count, FileSize, Cmd: Integer;
  ts : TMemoryStream;
  List : TList;
  CS : TCriticalSection;
begin
  { Get the clients package info }
  Client := Pointer(AThread.Data);
  { Check to see if the clients name has been assigned yet }
  if Client.Name = 'Logging Inthen
  begin
    { if not, assign the name and announce the client }
    Cmd := AThread.Connection.ReadInteger;
    if cmd = 2 then
    begin
      ... {Behandlung beim Einloggen eines Clients, tut hier nichts zur Sache, daher weggelassen}
    end;
  end
  else
  begin
    { If name is set, then send the message }
    Cmd := AThread.Connection.ReadInteger;
    if cmd = 4 then
    begin
      try
        try
          Msg := AThread.Connection.ReadLn;
          FileName := Msg;
          CS := TCriticalSection.Create;
          CS.Enter;
          sMsgToClt := '#' + FileName; //ExtractFileName(FileName);
          ts := TMemoryStream.Create; //(FileName, fmCreate or fmShareDenyNone);
          FileSize := AThread.Connection.ReadInteger();
          AThread.Connection.ReadStream(ts, FileSize, False);
          Log(Format('Getting client upload %5d, %s', [FileSize, FileName]));
          List := TcpServer.Threads.LockList;
          try
            for Count := 0 to List.Count -1 do
            try
              TIdPeerThread(List.Items[Count]).Connection.WriteLn(sMsgToClt);
              TIdPeerThread(List.Items[Count]).Connection.WriteInteger(FileSize);
              TIdPeerThread(List.Items[Count]).Connection.OpenWriteBuffer;
              TIdPeerThread(List.Items[Count]).Connection.WriteStream(ts, True, False, FileSize);
              TIdPeerThread(List.Items[Count]).Connection.CloseWriteBuffer;
              Log('File ' + ExtractFileName(FileName) + ' sent to clients!');
            except
              TIdPeerThread(List.Items[Count]).Stop;
              Log('Error while sending file to clients!');
            end;
          finally
            TcpServer.Threads.UnlockList;
            CS.Leave;
          end;
        except
          ShowMessage('Error');
          Log('Error on getting file');
        end;
      finally
        ts.free;
      end;
      Exit;
    end;
    if cmd = 5 then
    begin
      ...
    end;
  end;
So, die Datei kommt bei den einzelnen Clients an, entweder in einer Timer-Routine oder einem Thread:
Delphi-Quellcode:
procedure TForm1.GetAct;
var
  Cmd, Com, Msg, Msg1, Msg2 : String;
  FileSize: integer;
  ftmpStream : TFileStream;
  ms : TMemoryStream;
begin
  if not IdTcpClient1.Connected then
    exit;
  try
    Msg := IdTCPClient1.ReadLn('', 5);
    if Msg <> 'then
    begin
      Msg1 := Copy(Msg, 3, Length(Msg) -1);
      if Msg[1] = '#then //send files
      begin
        msg2 := Copy(Msg, 2, Length(Msg));
        if FileExists(ProgDir + Msg2) then
          DeleteFile(ProgDir + Msg2);
        ftmpStream := TFileStream.Create(ProgDir + Msg2, fmCreate or fmShareDenyNone);
        try
          try
            FileSize := IdTCPClient1.ReadInteger();
            IdTCPClient1.ReadStream(fTmpStream, FileSize, False);
            Log(100, 'File ' + Msg2 + ' with ' + IntToStr(FileSize) + ' kbs received!');
            PostMessage(avatar, 'File ' + Msg2 + ' with ' + IntToStr(FileSize) + ' kbs received!');
            Application.ProcessMessages;
          except
            Log(101, 'Error on filetransfer!');
            exit;
          end;
        finally
          FreeAndNil(fTmpStream);
          Timer2.Enabled := True;
        end;
      end;
      if Msg[1] = '°then
      begin
        ...
      end;
    end
    except
    ...
  end;
Ich habe versucht, das ganze recht einfach zu halten und daher lediglich beim Versand eine optische Anzeige eingefügt, ansonsten gibt es entsprechende Mitteilungen über Größe und Namen der gesendeten bzw, empfangenen Datei..
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 21:24 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz