Unit FileReceiver;
Interface
uses
Classes, SysUtils, stdctrls, comctrls, IdTCPServer, FileCtrl, Windows;
type
TFileReceiver =
class
private
fServerMsgOk: Boolean;
// Optische Elemente zur Darstellung des Threads
fGB: TGroupBox;
fpBar: TProgressBar;
fLabFS: TLabel;
fLabRe: TLabel;
// Indy-Server-Thread
AThread: TIdPeerThread;
// wichtige Elemente zum Empfangen der Datei
iFileSize: Cardinal;
iReceivedBytes: Cardinal;
sFileName:
String;
iDownloadRate : Cardinal;
tmpMS: TMemoryStream;
Procedure CreateElements;
Procedure DestroyElements;
Function VBSplit(Liste: TStringList; Text2Split:
String; SeperatorStr:
String): Boolean;
Procedure UpdateProgress;
protected
//
public
Constructor Create(Thread: TIdPeerThread; Msg:
String);
Destructor Free;
Property ServerMsgOK: Boolean
read fServerMsgOk
write fServerMsgOk;
Property Filename:
String read sFileName;
Function Start(Path_to_Save_in:
String): Boolean;
End;
Implementation
Uses f_Main, Controls;
{ TFileReceiver }
Constructor TFileReceiver.Create(Thread: TIdPeerThread; 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 := 594;
fpBar.Anchors := [akLeft, akTop, akRight];
fpBar.Visible := true;
// Labels erzeugen
fLabFS := TLabel.create(fGB);
//fLabFS.Parent := fGB;
fLabFS.Left := 3;
fLabFS.top := 57;
fLabFS.Anchors := [akTop, akLeft];
fLabFS.Caption := '
Filesize: 0 KB';
fLabFS.Visible := true;
fLabRe := TLabel.create(fGB);
//fLabRe.Parent := fGB;
fLabRe.Left := 3;
fLabRe.top := 38;
fLabRe.Anchors := [akTop, akLeft];
fLabRe.Caption := '
Received Bytes: 0 KB (0 %) @ 0 kbit/s';
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(Path_to_Save_in:
String): Boolean;
Var
bError: Boolean;
bReady: Boolean;
fs: TFileStream;
downloadTime : Cardinal;
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
If directoryexists(Path_to_Save_in)
Then Begin
sFileName := Path_to_Save_in + sFileName;
End
Else Begin
// Fehler beim Erstellen der Datei aufgetreten
result := false;
sFileName := '
';
exit;
End;
Try
fs := TFileStream.Create(sFileName, fmCreate
Or fmShareExclusive);
Except
// Fehler beim Erstellen der Datei aufgetreten
result := false;
sFileName := '
';
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
downloadTime := GetTickCount;
AThread.Connection.ReadStream(tmpMS);
downloadTime := GetTickCount - downloadTime;
// Steht jetzt auch wirklich was im Stream drin
If tmpMS.Size > 0
Then Begin
// die gelesenen Bytes jetzt direkt in den FileStream schreiben
if downloadTime > 0
then
iDownloadRate := Round(tmpMS.Size * 8 / 1024 / downloadTime)
else
iDownloadRate := 0;
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);
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 Begin
DeleteFile(PChar(sFileName));
sFileName := '
';
End;
End;
result := FileExists(sFileName);
End;
End;
procedure TFileReceiver.UpdateProgress;
var
percent : Integer;
begin
percent := Round(iReceivedBytes / iFileSize * 100);
// Label anpassen
fLabRe.Caption := Format('
Received Bytes: %f KB (%d %%) @ %d kbit/s', [iReceivedBytes / 1024, percent, iDownloadRate]);
// neue Position setzen
fpBar.Position := percent;
// GroupBox und alle Unterelemente neu zeichnen
fgb.Repaint;
end;
End.