home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / unity / d23456 / SYNAPSE.ZIP / source / demo / echo / echo.pas next >
Encoding:
Pascal/Delphi Source File  |  2001-02-24  |  1.7 KB  |  98 lines
  1. unit echo;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, blcksock, winsock;
  7.  
  8. type
  9.   TTCPEchoDaemon = class(TThread)
  10.   private
  11.     Sock:TTCPBlockSocket;
  12.   public
  13.     Constructor Create;
  14.     Destructor Destroy; override;
  15.     procedure Execute; override;
  16.   end;
  17.  
  18.   TTCPEchoThrd = class(TThread)
  19.   private
  20.     Sock:TTCPBlockSocket;
  21.   public
  22.     Constructor Create (hsock:tSocket);
  23.     Destructor Destroy; override;
  24.     procedure Execute; override;
  25.   end;
  26.  
  27. implementation
  28.  
  29. { TEchoDaemon }
  30.  
  31. Constructor TTCPEchoDaemon.Create;
  32. begin
  33.   sock:=TTCPBlockSocket.create;
  34.   FreeOnTerminate:=true;
  35.   Priority:=tpNormal;
  36.   inherited create(false);
  37. end;
  38.  
  39. Destructor TTCPEchoDaemon.Destroy;
  40. begin
  41.   Sock.free;
  42. end;
  43.  
  44. procedure TTCPEchoDaemon.Execute;
  45. var
  46.   ClientSock:TSocket;
  47. begin
  48.   with sock do
  49.     begin
  50.       CreateSocket;
  51.       setLinger(true,10);
  52.       bind('0.0.0.0','echo');
  53.       listen;
  54.       repeat
  55.         if terminated then break;
  56.         if canread(1000) then
  57.           begin
  58.             ClientSock:=accept;
  59.             if lastError=0 then TTCPEchoThrd.create(ClientSock);
  60.           end;
  61.       until false;
  62.     end;
  63. end;
  64.  
  65. { TEchoThrd }
  66.  
  67. Constructor TTCPEchoThrd.Create(Hsock:TSocket);
  68. begin
  69.   sock:=TTCPBlockSocket.create;
  70.   Sock.socket:=HSock;
  71.   FreeOnTerminate:=true;
  72.   Priority:=tpNormal;
  73.   inherited create(false);
  74. end;
  75.  
  76. Destructor TTCPEchoThrd.Destroy;
  77. begin
  78.   Sock.free;
  79. end;
  80.  
  81. procedure TTCPEchoThrd.Execute;
  82. var
  83.   b:byte;
  84. begin
  85.   with sock do
  86.     begin
  87.       repeat
  88.         if terminated then break;
  89.         b:=recvbyte(60000);
  90.         if lastError<>0 then break;
  91.         sendbyte(b);
  92.         if lastError<>0 then break;
  93.       until false;
  94.     end;
  95. end;
  96.  
  97. end.
  98.