 |
 |
 |
 |
 |
|
Antwort
|
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
Der Horizont vieler Menschen ist ein Kreis mit Radius Null, und das nennen sie ihren Standpunkt.
|
Delphi 5 Professional |
#53
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?   http://www.delphipraxis.net/internal...=954701#954701Also, hier nochmal ausführlich, mit Indy 9 erstellt und getestet: Ich drücke auf einen Button, um eine Datei zu versenden:
Delphi-Quellcode:
Der Server erhält den entsprechenden Befehl, die Größe der Datei sowie die Datei selber und schickt sie an alle angeschlossenen Clients:
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; (Achtung, hier ist die Lösung etwas anders als urprünglich gepostet, die Datei 'FileReceiver.pas' habe ich ganz weg gelassen)
Delphi-Quellcode:
So, die Datei kommt bei den einzelnen Clients an, entweder in einer Timer-Routine oder einem Thread:
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 In' then 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;
Delphi-Quellcode:
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..
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; |
Zitat
|
ForumregelnEs 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
|
|
Linear-Darstellung
