Work to Store.
[brdnet.git] / TestTC.pas
blob846caba98aaa16613a428cede88aba828e967ad6
1 unit TestTC;
2 INTERFACE
3 IMPLEMENTATION
4 USES ServerLoop
5 ,TC
6 ,MemStream
7 ,NetAddr
8 ,SysUtils
10 type t=object
11 tcs:TC.tTCS;
12 cnt:byte;
13 buf: array [1..4096] of char;
14 procedure CanSend;
15 end;
17 procedure t.CanSend;
18 var s:tMemoryStream;
19 var size:word;
20 begin
21 s.Init(@buf,0,4096);
22 size:=tcs.MaxSize(4096);
23 tcs.WriteHeaders(s);
24 if size>s.size then size:=s.size;
25 s.Skip(size-1);
26 s.WriteByte(9);
27 tcs.Send(s);
28 end;
30 procedure Test;
31 var o:^t;
32 var oi:word;
33 const opt='-test-tc';
34 begin
35 oi:=OptIndex(opt);
36 if oi>0 then begin
37 assert(OptParamCount(oi)=1,opt+'(rcpt:tNetAddr) '+IntToStr(OptParamCount(oi)));
38 New(o);
39 with o^ do begin
40 cnt:=0;
41 tcs.Init(paramstr(oi+1));
42 tcs.CanSend:=@CanSend;
43 tcs.Start;
44 end;
45 end;
46 end;
48 BEGIN
49 test;
50 END.