unit uFileTransfer;
interface
uses
ScktComp, Classes, SysUtils, Windows;
type
TFileServer =
class(TPersistent)
protected
FServer: TServerSocket;
FFiles: TFiles;
FTime: Longword;
private
procedure ReceiveData(Sender: TObject; Socket: TCustomWinSocket);
function GetFileInfo(
var Text: AnsiString): TFileInfo;
function GetFileInfo2(
Index: Integer): TFileInfo2;
function CountFiles: Integer;
public
constructor Create;
destructor Destroy;
override;
procedure Start;
property Files[
Index: Integer]: TFileInfo2
read GetFileInfo2;
property FilesCount: Integer
read CountFiles;
end;
TFileClient =
class(TPersistent)
protected
FClient: TClientSocket;
FFile: TSendFile;
FTime: Longword;
private
procedure SendData(Sender: TObject; Socket: TCustomWinSocket);
public
constructor Create;
destructor Destroy;
override;
procedure Start(ServerAdress:
String);
procedure SendFile(Filename:
String);
end;
implementation
constructor TFileServer.Create;
begin
inherited;
FServer := TServerSocket.Create(
nil);
FServer.OnClientRead := ReceiveData;
FServer.Service := '
ftp';
FFiles := TFiles.Create;
end;
destructor TFileServer.Destroy;
begin
FServer.Free;
FFiles.Free;
inherited;
end;
procedure TFileServer.ReceiveData(Sender: TObject; Socket: TCustomWinSocket);
var Size: Integer;
Text: AnsiString;
FileInfo: TFileInfo;
Time: LongWord;
begin
while Socket.ReceiveLength > 0
do
begin
Size := Socket.ReceiveLength;
SetLength(Text, Size);
Socket.ReceiveBuf(Text[1], Size);
if Pos(#5+'
header'+#6,Text) > 0
then
begin
FileInfo := GetFileInfo(Text);
FFiles.Add(FileInfo.Filename, FileInfo.Size, Integer(Socket));
FFiles.Items[FFiles.IndexOf(Integer(Socket))].
Write(Text[1], Length(Text));
FTime := GetTickCount;
end
else
begin
FFiles.Items[FFiles.IndexOf(Integer(Socket))].
Write(Text[1], Length(Text));
end;
Time := GetTickCount-FTime;
if Time = 0
then Time := 1;
FFiles.Items[FFiles.IndexOf(Integer(Socket))].Speed := Size*1000/Time;
if FFiles.Items[FFiles.IndexOf(Integer(Socket))].FullSize = FFiles.Items[FFiles.IndexOf(Integer(Socket))].LoadedSize
then
begin
FFiles.Save(FFiles.IndexOf(Integer(Socket)));
end;
FTime := GetTickCount;
end;
end;
function TFileServer.GetFileInfo(
var Text: AnsiString): TFileInfo;
var I, ParamNo, Start:Integer;
Substring:
String;
begin
I := 0;
ParamNo := 0;
Start := 0;
while (I < Length(Text))
and (Substring <> #6+'
/header'+#7)
do
begin
case Text[I]
of
#5:Substring := '
';
#6:
begin
case ParamNo
of
1:Result.Filename := copy(Text, Start, I-Start);
2:Result.Size := StrToInt(copy(Text, Start, I-Start));
end;
inc(ParamNo);
Start := I+1;
Substring := '
';
end;
end;
Substring := Substring+Text[I];
inc(I);
end;
if Text[I] = #7
then inc(I);
Text := copy(Text, I, Length(Text));
end;
function TFileServer.GetFileInfo2(
Index: Integer): TFileInfo2;
begin
Result.FullSize := FFiles.Items[
Index].FullSize;
Result.LoadedSize := FFiles.Items[
Index].LoadedSize;
Result.Filename := FFiles.Items[
Index].Filename;
Result.Speed := FFiles.Items[
Index].Speed;
end;
function TFileServer.CountFiles: Integer;
begin
Result := FFiles.Count;
end;
procedure TFileServer.Start;
begin
FServer.Open;
end;
constructor TSendFile.Create(Filename:
String);
begin
inherited Create;
FFile := TMemoryStream.Create;
FFile.LoadFromFile(Filename);
FFilename := Filename;
end;
constructor TFileClient.Create;
begin
inherited;
FClient := TClientSocket.Create(
nil);
FClient.OnConnect := SendData;
FClient.Service := '
ftp';
end;
destructor TFileClient.Destroy;
begin
FClient.Free;
FFile.Free;
inherited;
end;
procedure TFileClient.SendData(Sender: TObject; Socket: TCustomWinSocket);
var Header: AnsiString;
begin
if Assigned(FFile)
then
begin
Header := '
';
if FFile.Stream.Position = 0
then
begin
Header := #5+'
header'+#6+ExtractFileName(FFile.Filename)+#6+IntToStr(FFile.Stream.Size)+#6+'
/header'+#7;
Socket.SendBuf(Header[1], Length(Header));
end;
Socket.SendStream(FFile.Stream);
end;
end;
procedure TFileClient.Start(ServerAdress:
String);
begin
FClient.Host := ServerAdress;
FClient.Open;
end;
procedure TFileClient.SendFile(Filename:
String);
begin
FFile := TSendFile.Create(Filename);
if FClient.Active
then SendData(Self, FClient.Socket);
end;
end.