home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / COMM / CTA6_SRC.ZIP / WSOCKBUF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-12-28  |  6.3 KB  |  220 lines

  1. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2.  
  3. Author:       Franτois PIETTE
  4. Description:  TBuffer is an object wich buffers data in a single dynamically
  5.               allocated memory block. It is a kind of FIFO wich manages
  6.               characters in bloc of various sizes.
  7. EMail:        francois.piette@pophost.eunet.be    
  8.               francois.piette@rtfm.be             http://www.rtfm.be/fpiette
  9. Creation:     April 1996
  10. Version:      2.01
  11. Support:      Use the mailing list twsocket@rtfm.be See website for details.
  12. Legal issues: Copyright (C) 1997, 1998 by Franτois PIETTE
  13.               Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
  14.               <francois.piette@pophost.eunet.be>
  15.  
  16.               This software is provided 'as-is', without any express or
  17.             implied warranty.  In no event will the author be held liable
  18.               for any  damages arising from the use of this software.
  19.  
  20.               Permission is granted to anyone to use this software for any
  21.               purpose, including commercial applications, and to alter it
  22.               and redistribute it freely, subject to the following
  23.               restrictions:
  24.  
  25.               1. The origin of this software must not be misrepresented,
  26.                  you must not claim that you wrote the original software.
  27.                  If you use this software in a product, an acknowledgment 
  28.                  in the product documentation would be appreciated but is
  29.                  not required.
  30.  
  31.               2. Altered source versions must be plainly marked as such, and
  32.                  must not be misrepresented as being the original software.
  33.  
  34.               3. This notice may not be removed or altered from any source
  35.                  distribution.
  36. Updates:
  37. Mar 06, 1998  V2.00 Added a property and a parameter for the create method
  38.               to select the buffer size. Using a 0 value will make the object
  39.               use the default 1514 bytes (the largest size for an ethernet
  40.               packet).
  41. Jul 08, 1998  V2.01 Adadpted for Delphi 4
  42.  
  43.  
  44.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  45. unit WSockbuf;
  46.  
  47. interface
  48.  
  49. uses
  50.   SysUtils;
  51.  
  52. const
  53.   WSockBufVersion = 201;
  54.  
  55. type
  56.   TBuffer = class(TObject)
  57.     Buf      : Pointer;
  58.     FBufSize : Integer;
  59.     WrCount  : Integer;
  60.     RdCount  : Integer;
  61.   public
  62.     constructor Create(nSize : Integer); virtual;
  63.     destructor  Destroy; override;
  64.     function    Write(Data : Pointer; Len : Integer) : Integer;
  65.     function    Read(Data : Pointer; Len : Integer) : Integer;
  66.     function    Peek(var Len : Integer) : Pointer;
  67.     function    Remove(Len : Integer) : Integer;
  68.     procedure   SetBufSize(newSize : Integer);
  69.     property    BufSize : Integer read FBufSize write SetBufSize;
  70.   end;
  71.  
  72. implementation
  73.  
  74.  
  75. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  76. constructor TBuffer.Create(nSize : Integer);
  77. begin
  78.     inherited Create;
  79.     WrCount  := 0;
  80.     RdCount  := 0;
  81.     BufSize := nSize;
  82. end;
  83.  
  84.  
  85. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  86. destructor TBuffer.Destroy;
  87. begin
  88.     if Assigned(Buf) then
  89.         FreeMem(Buf, FBufSize);
  90.  
  91.     inherited Destroy;
  92. end;
  93.  
  94.  
  95. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  96. procedure TBuffer.SetBufSize(newSize : Integer);
  97. var
  98.     newBuf : Pointer;
  99. begin
  100.     if newSize <= 0 then
  101.         newSize := 1514;
  102.  
  103.     if newSize = FBufSize then
  104.         Exit;
  105.  
  106.     if WrCount = RdCount then begin
  107.         { Buffer is empty }
  108.         if Assigned(Buf) then
  109.             FreeMem(Buf, FBufSize);
  110.         FBufSize := newSize;
  111.         GetMem(Buf, FBufSize);
  112.     end
  113.     else begin
  114.         { Buffer contains data }
  115.         GetMem(newBuf, newSize);
  116.         Move(Buf^, newBuf^, WrCount);
  117.         if Assigned(Buf) then
  118.             FreeMem(Buf, FBufSize);
  119.         FBufSize := newSize;
  120.         Buf      := newBuf;
  121.     end;
  122. end;
  123.  
  124.  
  125. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  126. function TBuffer.Write(Data : Pointer; Len : Integer) : Integer;
  127. var
  128.     Remaining : Integer;
  129.     Copied    : Integer;
  130. begin
  131.     Remaining := FBufSize - WrCount;
  132.     if Remaining <= 0 then
  133.         Result := 0
  134.     else begin
  135.         if Len <= Remaining then
  136.             Copied := Len
  137.         else
  138.             Copied := Remaining;
  139.         Move(Data^, (PChar(Buf) + WrCount)^, Copied);
  140.         WrCount := WrCount + Copied;
  141.         Result  := Copied;
  142.     end;
  143. end;
  144.  
  145.  
  146. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  147. function TBuffer.Read(Data : Pointer; Len : Integer) : Integer;
  148. var
  149.     Remaining : Integer;
  150.     Copied    : Integer;
  151. begin
  152.     Remaining := WrCount - RdCount;
  153.     if Remaining <= 0 then
  154.         Result := 0
  155.     else begin
  156.         if Len <= Remaining then
  157.             Copied := Len
  158.         else
  159.             Copied := Remaining;
  160.         Move((PChar(Buf) + RdCount)^, Data^, Copied);
  161.         RdCount := RdCount + Copied;
  162.  
  163.         if RdCount = WrCount then begin
  164.             RdCount := 0;
  165.             WrCount := 0;
  166.         end;
  167.  
  168.         Result := Copied;
  169.     end;
  170. end;
  171.  
  172.  
  173. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  174. function TBuffer.Peek(var Len : Integer) : Pointer;
  175. var
  176.     Remaining : Integer;
  177. begin
  178.     Remaining := WrCount - RdCount;
  179.     if Remaining <= 0 then begin
  180.         Len    := 0;
  181.         Result := nil;
  182.     end
  183.     else begin
  184.         Len    := Remaining;
  185.         Result := PChar(Buf) + RdCount;
  186.     end;
  187. end;
  188.  
  189.  
  190. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  191. function TBuffer.Remove(Len : Integer) : Integer;
  192. var
  193.     Remaining : Integer;
  194.     Removed   : Integer;
  195. begin
  196.     Remaining := WrCount - RdCount;
  197.     if Remaining <= 0 then
  198.         Result := 0
  199.     else begin
  200.         if Len < Remaining then
  201.             Removed := Len
  202.         else
  203.             Removed := Remaining;
  204.         RdCount := RdCount + Removed;
  205.  
  206.         if RdCount = WrCount then begin
  207.             RdCount := 0;
  208.             WrCount := 0;
  209.         end;
  210.  
  211.         Result := Removed;
  212.     end;
  213. end;
  214.  
  215.  
  216. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  217.  
  218. end.
  219.  
  220.