units/synapse/Echo.pas

   1 unit echo;
   2
   3 interface
   4
   5 uses
   6         KOL, blcksock, winsock;
   7
   8 type
   9         PTCPEchoDaemon = ^TTCPEchoDaemon;
  10         TTCPEchoDaemon = object(TThread)
  11         private
  12                 Sock : PTCPBlockSocket;
  13         public
  14                 function Execute : Integer;
  15         end;
  16
  17         PTCPEchoThrd = ^TTCPEchoThrd;
  18         TTCPEchoThrd = object(TThread)
  19         private
  20                 Sock : PTCPBlockSocket;
  21         public
  22                 function Execute : Integer;
  23         end;
  24
  25  function NewEchoDaemon : PTCPEchoDaemon;
  26
  27  function NewEchoThrd(hSock : TSocket) : PTCPEchoThrd;
  28
  29 implementation
  30
  31 { TEchoDaemon }
  32
  33 function NewEchoDaemon : PTCPEchoDaemon;
  34 begin
  35         New(Result,Create);
  36         Result.Sock := NewTCPBlockSocket('');
  37         Result.Add2AutoFree(Result.Sock);
  38         Result.AutoFree := true;
  39 //      Result.PriorityClass := NORMAL_PRIORITY_CLASS;
  40 //      Result.ThreadPriority := THREAD_PRIORITY_NORMAL;
  41         if Result.Suspended then Result.Resume;
  42 end;
  43
  44
  45 function TTCPEchoDaemon.Execute : Integer;
  46 var
  47         ClientSock : TSocket;
  48 begin
  49         Result := 0;
  50         with Sock^ do
  51                 begin
  52                         CreateSocket;
  53                         SetLinger(true,10);
  54                         Bind('0.0.0.0','echo');
  55                         Listen;
  56                         repeat
  57                                 if Terminated then Break;
  58                                 if CanRead(1000) then
  59                                         begin
  60                                                 ClientSock := Accept;
  61                                                 if LastError = 0 then NewEchoThrd(ClientSock);
  62                                         end;
  63                         until False;
  64                 end;
  65 end;
  66
  67 { TEchoThrd }
  68
  69 function NewEchoThrd(hSock : TSocket) : PTCPEchoThrd;
  70 begin
  71         New(Result,Create);
  72         Result.Sock := NewTCPBlockSocket('');
  73         Result.Add2AutoFree(Result.Sock);
  74         Result.AutoFree := true;
  75         Sock.Socket := hSock;
  76 //      Result.PriorityClass := NORMAL_PRIORITY_CLASS;
  77 //      Result.ThreadPriority := THREAD_PRIORITY_NORMAL;
  78         if Result.Suspended then Result.Resume;
  79 end;
  80
  81
  82 function TTCPEchoThrd.Execute : Integer;
  83 var
  84         b:byte;
  85 begin
  86         Result := 0;
  87         with Sock^ do
  88                 begin
  89                         repeat
  90                                 if Terminated then Break;
  91                                 b := Recvbyte(60000);
  92                                 if LastError<>0 then Break;
  93                                 Sendbyte(b);
  94                                 if LastError<>0 then Break;
  95                         until false;
  96                 end;
  97 end;
  98
  99 end.