1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:

function BigSend(s:TSocket; buf:PChar; bufsize:integer):integer;
var
  ln, pt: integer;
  d: double;
const
  timeout: integer=5000; //5 Sekunden
begin
  d:=now;
  pt:=0;
  while (pt<bufsize) and (now-d*86400<timeout) do begin
    ln:=Send(s, buf[pt], bufsize-pt, 0); //ln = Bytes, die erfolgreich (!) gesendet wurden
    if ln>0 then begin //Wenn gesendet werden konnte
      Inc(pt, ln);
      d:=now;
    end;
  end;
end;
...
procedure Test;
var
..
  s:string;
...
begin
  ...
  SetLength(s, 65432147);
  for i:=1 to length(s) do s[i]:=Chr(Random(256));
  BigSend(MySock.SocketHandle, @s[1], Length(s));
  ...
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:

unit unitTest;

(*
  Benötigt um diesen Code hier einzufügen und auszuführen:
  1 ClientSocket "ClientSocket1"
  1 ServerSocket "ServerSocket1"
  2 Labels "Label1" "Label2"
  1 Timer "Timer1"
*)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ScktComp, WinSock, StdCtrls;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    Timer1: TTimer;
    ClientSocket1: TClientSocket;
    Label1: TLabel;
    Label2: TLabel;
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

function BigSend(s:TSocket; buf:PChar; bufsize:integer):integer;

var
  Form1: TForm1;
  buf: string='';
  bread: integer=0;

implementation

{$R *.DFM}

function BigSend(s:TSocket; buf:PChar; bufsize:integer):integer;
var
  ln, pt: integer;
  d: double;
const
  timeout: integer=5; //5 Sekunden
begin
  d:=now;
  pt:=0;
  while (pt<bufsize) and ((now-d)*86400<timeout) do begin
    ln:=Send(s, buf[pt], bufsize-pt, 0); //ln = Bytes, die erfolgreich (!) gesendet wurden
    if ln>0 then begin //Wenn gesendet werden konnte
      Inc(pt, ln);
      d:=now;
    end else begin
      //showmessage(syserrormessage(WSAGetLastError));break;
    end;
    Application.ProcessMessages;
  end;
  result:=0;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode:=0;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,ln,aln:integer;
begin
  for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do begin
    aln:=0;
    while aln<50000 do begin
      ln:=Recv(ServerSocket1.Socket.Connections[i].SocketHandle,
               buf[1+aln],50000-aln,0);
      if ln>=0 then aln:=aln+ln;
      Application.ProcessMessages;
    end;
    bread:=bread+aln;
  end;
  Label2.Caption:='Empfangen: '+IntToStr(bread)+' Bytes';
  if bread>=5000000 then timer1.enabled:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ServerSocket1.Port:=4444;
  ServerSocket1.Active:=True;
  Timer1.Interval:=100;
  SetLength(buf,5000000);
  ClientSocket1.Address:='127.0.0.1';
  CLientSocket1.Port:=4444;
  ClientSocket1.Active:=True;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
var s:string;
 i:integer;
 c:cardinal;
begin
  SetLength(s, 5000000);
  for i:=1 to length(s) do s[i]:=Chr(Random(256));
  c:=GetTickCount;
  BigSend(CLientSocket1.Socket.SocketHandle,
          @s[1],length(s));
  c:=GetTickCount-c;
  Label1.Caption:='5000000 Bytes gesendet in '+inttostr(c)+' ms';
  s:='';
end;

end.