TestTC.pas

   1 unit TestTC;
   2 INTERFACE
   3 IMPLEMENTATION
   4 USES ServerLoop
   5     ,TC
   6     ,MemStream
   7     ,NetAddr
   8     ,SysUtils
   9     ;
  10 type t=object
  11  tcs:TC.tTCS;
  12  cnt:byte;
  13  buf: array [1..4096] of char;
  14  procedure CanSend;
  15 end;
  16
  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;
  29
  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;
  47
  48 BEGIN
  49  test;
  50 END.