Einzelnen Beitrag anzeigen

hugo1990

Registriert seit: 27. Dez 2006
166 Beiträge
 
Turbo Delphi für Win32
 
#6

Re: Problem mit SendStream und ReceiveBuf bei großen Dateien

  Alt 1. Mär 2008, 13:14
Ich poste jetzt einfach mal de gesamten Quellcode, vllt kann mir ja dann jemand sagen, was ich falsch mache, dass der Server den Clienten immer nach der Übertragung von 64 KB kickt.
Delphi-Quellcode:
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.
  Mit Zitat antworten Zitat