Vichingo455-RePacks
/
xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity
xtool/contrib/fundamentals/TCP/flcTCPBuffer.pas

695 lines
19 KiB
ObjectPascal
Raw Blame History

{******************************************************************************}
{ }
{ Library: Fundamentals 5.00 }
{ File name: flcTCPBuffer.pas }
{ File version: 5.08 }
{ Description: TCP buffer. }
{ }
{ Copyright: Copyright (c) 2007-2020, David J Butler }
{ All rights reserved. }
{ This file is licensed under the BSD License. }
{ See http://www.opensource.org/licenses/bsd-license.php }
{ Redistribution and use in source and binary forms, with }
{ or without modification, are permitted provided that }
{ the following conditions are met: }
{ Redistributions of source code must retain the above }
{ copyright notice, this list of conditions and the }
{ following disclaimer. }
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
{ POSSIBILITY OF SUCH DAMAGE. }
{ }
{ Github: https://github.com/fundamentalslib }
{ E-mail: fundamentals.library at gmail.com }
{ }
{ Revision history: }
{ }
{ 2008/12/23 0.01 Initial development. }
{ 2010/12/02 0.02 Revision. }
{ 2011/04/22 0.03 Simple test cases. }
{ 2011/06/16 0.04 Minor change in PeekPtr routine. }
{ 2011/09/03 4.05 Revised for Fundamentals 4. }
{ 2016/01/09 5.06 Revised for Fundamentals 5. }
{ 2019/04/10 5.07 Change default buffer size. }
{ 2019/12/29 5.08 Minimum buffer size. }
{ }
{******************************************************************************}
{$INCLUDE ../flcInclude.inc}
{$INCLUDE flcTCP.inc}
unit flcTCPBuffer;
interface
uses
{ System }
SysUtils,
{ Utils }
flcStdTypes;
{ }
{ TCP Buffer }
{ }
type
ETCPBuffer = class(Exception);
TTCPBuffer = record
Ptr : Pointer;
Size : Integer;
Min : Int32;
Max : Int32;
Head : Int32;
Used : Int32;
end;
const
ETHERNET_MTU = 1500;
ETHERNET_MTU_JUMBO = 9000;
TCP_BUFFER_DEFAULTMAXSIZE = ETHERNET_MTU_JUMBO * 8; // 72,000 bytes
TCP_BUFFER_DEFAULTMINSIZE = ETHERNET_MTU * 6; // 9,000 bytes
procedure TCPBufferInitialise(
var TCPBuf: TTCPBuffer;
const TCPBufMaxSize: Int32 = TCP_BUFFER_DEFAULTMAXSIZE;
const TCPBufMinSize: Int32 = TCP_BUFFER_DEFAULTMINSIZE);
procedure TCPBufferFinalise(var TCPBuf: TTCPBuffer);
function TCPBufferGetMaxSize(const TCPBuf: TTCPBuffer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
procedure TCPBufferSetMaxSize(
var TCPBuf: TTCPBuffer;
const MaxSize: Int32);
function TCPBufferGetMinSize(const TCPBuf: TTCPBuffer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
procedure TCPBufferSetMinSize(
var TCPBuf: TTCPBuffer;
const MinSize: Int32);
procedure TCPBufferPack(var TCPBuf: TTCPBuffer);
procedure TCPBufferResize(
var TCPBuf: TTCPBuffer;
const TCPBufSize: Int32);
procedure TCPBufferExpand(
var TCPBuf: TTCPBuffer;
const Size: Int32);
procedure TCPBufferShrink(var TCPBuf: TTCPBuffer);
procedure TCPBufferMinimize(var TCPBuf: TTCPBuffer);
procedure TCPBufferClear(var TCPBuf: TTCPBuffer);
function TCPBufferAddPtr(
var TCPBuf: TTCPBuffer;
const Size: Int32): Pointer;
procedure TCPBufferAdded(
var TCPBuf: TTCPBuffer;
const Size: Int32);
procedure TCPBufferAddBuf(
var TCPBuf: TTCPBuffer;
const Buf; const Size: Int32);
function TCPBufferPeekPtr(
const TCPBuf: TTCPBuffer;
var BufPtr: Pointer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
function TCPBufferPeek(
var TCPBuf: TTCPBuffer;
var Buf; const Size: Int32): Int32;
function TCPBufferPeekByte(
var TCPBuf: TTCPBuffer;
out B: Byte): Boolean;
function TCPBufferRemove(
var TCPBuf: TTCPBuffer;
var Buf; const Size: Int32): Int32;
function TCPBufferRemoveBuf(
var TCPBuf: TTCPBuffer;
var Buf; const Size: Int32): Boolean;
function TCPBufferDiscard(
var TCPBuf: TTCPBuffer;
const Size: Int32): Int32;
function TCPBufferUsed(const TCPBuf: TTCPBuffer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
function TCPBufferEmpty(const TCPBuf: TTCPBuffer): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
function TCPBufferAvailable(const TCPBuf: TTCPBuffer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
function TCPBufferPtr(const TCPBuf: TTCPBuffer): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
function TCPBufferLocateByteChar(const TCPBuf: TTCPBuffer;
const Delimiter: ByteCharSet; const MaxSize: Integer): Int32;
implementation
{ }
{ Resource strings }
{ }
const
SBufferOverflow = 'Buffer overflow';
{ }
{ TCP Buffer }
{ }
// Initialise a TCP buffer
procedure TCPBufferInitialise(
var TCPBuf: TTCPBuffer;
const TCPBufMaxSize: Int32;
const TCPBufMinSize: Int32);
var
L, M : Int32;
begin
TCPBuf.Ptr := nil;
TCPBuf.Size := 0;
TCPBuf.Head := 0;
TCPBuf.Used := 0;
L := TCPBufMinSize;
if L < 0 then
L := TCP_BUFFER_DEFAULTMINSIZE;
M := TCPBufMaxSize;
if M < 0 then
M := TCP_BUFFER_DEFAULTMAXSIZE;
if L > M then
L := M;
TCPBuf.Min := L;
TCPBuf.Max := M;
if L > 0 then
GetMem(TCPBuf.Ptr, L);
TCPBuf.Size := L;
end;
// Finalise a TCP buffer
procedure TCPBufferFinalise(var TCPBuf: TTCPBuffer);
var
P : Pointer;
begin
P := TCPBuf.Ptr;
if Assigned(P) then
begin
TCPBuf.Ptr := nil;
FreeMem(P);
end;
TCPBuf.Size := 0;
end;
// Gets maximum buffer size
function TCPBufferGetMaxSize(const TCPBuf: TTCPBuffer): Int32;
begin
Result := TCPBuf.Max;
end;
// Sets maximum buffer size
// Note: This limit is not enforced. It is used by TCPBufferAvailable.
procedure TCPBufferSetMaxSize(
var TCPBuf: TTCPBuffer;
const MaxSize: Int32);
var
L : Int32;
begin
L := MaxSize;
if L < 0 then
L := TCP_BUFFER_DEFAULTMAXSIZE;
TCPBuf.Max := L;
end;
// Gets minimum buffer size
function TCPBufferGetMinSize(const TCPBuf: TTCPBuffer): Int32;
begin
Result := TCPBuf.Min;
end;
procedure TCPBufferSetMinSize(
var TCPBuf: TTCPBuffer;
const MinSize: Int32);
var
L : Int32;
begin
L := MinSize;
if L < 0 then
L := TCP_BUFFER_DEFAULTMINSIZE;
TCPBuf.Min := L;
end;
// Pack a TCP buffer
// Moves data to front of buffer
// Post: TCPBuf.Head = 0
procedure TCPBufferPack(var TCPBuf: TTCPBuffer);
var
P, Q : PByte;
U, H : Int32;
begin
H := TCPBuf.Head;
if H <= 0 then
exit;
U := TCPBuf.Used;
if U <= 0 then
begin
TCPBuf.Head := 0;
exit;
end;
Assert(Assigned(TCPBuf.Ptr));
P := TCPBuf.Ptr;
Q := P;
Inc(P, H);
Move(P^, Q^, U);
TCPBuf.Head := 0;
end;
// Resize a TCP buffer
// New buffer size must be large enough to hold existing data
// Post: TCPBuf.Size = TCPBufSize
procedure TCPBufferResize(
var TCPBuf: TTCPBuffer;
const TCPBufSize: Int32);
var
U, L : Int32;
begin
L := TCPBufSize;
U := TCPBuf.Used;
// treat negative TCPBufSize parameter as zero
if L < 0 then
L := 0;
// check if shrinking buffer to less than used size
if U > L then
raise ETCPBuffer.Create(SBufferOverflow);
// check if packing required to fit buffer
if U + TCPBuf.Head > L then
TCPBufferPack(TCPBuf);
Assert(U + TCPBuf.Head <= L);
// resize
ReallocMem(TCPBuf.Ptr, L);
TCPBuf.Size := L;
end;
// Expand a TCP buffer
// Expands the size of the TCP buffer to at least Size
procedure TCPBufferExpand(
var TCPBuf: TTCPBuffer;
const Size: Int32);
var
S : Int32;
N : Int64;
I : Int64;
begin
S := TCPBuf.Size;
N := Size;
// check if expansion not required
if N <= S then
exit;
// scale up new size proportional to current size
// increase by at least quarter of current size
// this reduces the number of resizes in growing buffers
I := S + (S div 4);
if N < I then
N := I;
// ensure new size is multiple of MTU size
I := N mod ETHERNET_MTU;
if I > 0 then
Inc(N, ETHERNET_MTU - I);
// resize buffer
Assert(N >= Size);
TCPBufferResize(TCPBuf, N);
end;
// Shrink the size of a TCP buffer to release all unused memory
// Post: TCPBuf.Used = TCPBuf.Size and TCPBuf.Head = 0
procedure TCPBufferShrink(var TCPBuf: TTCPBuffer);
var
S, U : Int32;
begin
S := TCPBuf.Size;
if S <= 0 then
exit;
U := TCPBuf.Used;
if U = 0 then
begin
TCPBufferResize(TCPBuf, 0);
TCPBuf.Head := 0;
exit;
end;
if U = S then
exit;
TCPBufferPack(TCPBuf); // move data to front of buffer
TCPBufferResize(TCPBuf, U); // set size equal to used bytes
Assert(TCPBuf.Used = TCPBuf.Size);
end;
// Applies Min parameter to allocated memory
procedure TCPBufferMinimize(var TCPBuf: TTCPBuffer); {$IFDEF UseInline}inline;{$ENDIF}
var
Mi : Int32;
begin
Mi := TCPBuf.Min;
if Mi >= 0 then
if TCPBuf.Used <= Mi then
if TCPBuf.Size > Mi then
TCPBufferResize(TCPBuf, Mi);
end;
// Clear the data from a TCP buffer
procedure TCPBufferClear(var TCPBuf: TTCPBuffer); {$IFDEF UseInline}inline;{$ENDIF}
begin
TCPBuf.Used := 0;
TCPBuf.Head := 0;
TCPBufferMinimize(TCPBuf);
end;
// Returns a pointer to position in buffer to add new data of Size
// Handles resizing and packing of buffer to fit new data
function TCPBufferAddPtr(
var TCPBuf: TTCPBuffer;
const Size: Int32): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
var
P : PByte;
U : Int32;
L : Int64;
H : Int32;
begin
// return nil if nothing to add
if Size <= 0 then
begin
Result := nil;
exit;
end;
U := TCPBuf.Used;
L := U + Size;
// resize if necessary
if L > TCPBuf.Size then
TCPBufferExpand(TCPBuf, L);
// pack if necessary
if TCPBuf.Head + L > TCPBuf.Size then
TCPBufferPack(TCPBuf);
// buffer should now be large enough for new data
H := TCPBuf.Head;
Assert(TCPBuf.Size > 0);
Assert(H + L <= TCPBuf.Size);
// get buffer pointer
Assert(Assigned(TCPBuf.Ptr));
P := TCPBuf.Ptr;
Inc(P, H);
Inc(P, U);
Result := P;
end;
// Increases data used in buffer by Size.
// TCPBufferAdded should only be called in conjuction with TCPBufferAddPtr.
procedure TCPBufferAdded(
var TCPBuf: TTCPBuffer;
const Size: Int32);
begin
if Size <= 0 then
exit;
Assert(TCPBuf.Head + TCPBuf.Used + Size <= TCPBuf.Size);
Inc(TCPBuf.Used, Size);
end;
// Adds new data from a buffer to a TCP buffer
procedure TCPBufferAddBuf(
var TCPBuf: TTCPBuffer;
const Buf; const Size: Int32); {$IFDEF UseInline}inline;{$ENDIF}
var
P : PByte;
begin
if Size <= 0 then
exit;
// get TCP buffer pointer
P := TCPBufferAddPtr(TCPBuf, Size);
// move user buffer to TCP buffer
Assert(Assigned(P));
Move(Buf, P^, Size);
Inc(TCPBuf.Used, Size);
Assert(TCPBuf.Head + TCPBuf.Used <= TCPBuf.Size);
end;
// Peek TCP buffer
// Returns the number of bytes available to peek
function TCPBufferPeekPtr(
const TCPBuf: TTCPBuffer;
var BufPtr: Pointer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
var
P : PByte;
L : Int32;
begin
// handle empty TCP buffer
L := TCPBuf.Used;
if L <= 0 then
begin
BufPtr := nil;
Result := 0;
exit;
end;
// get buffer pointer
Assert(TCPBuf.Head + L <= TCPBuf.Size);
Assert(Assigned(TCPBuf.Ptr));
P := TCPBuf.Ptr;
Inc(P, TCPBuf.Head);
BufPtr := P;
// return size
Result := L;
end;
// Peek data from a TCP buffer
// Returns the number of bytes actually available and copied into the buffer
function TCPBufferPeek(
var TCPBuf: TTCPBuffer;
var Buf; const Size: Int32): Int32; {$IFDEF UseInline}inline;{$ENDIF}
var
P : Pointer;
L : Int32;
begin
// handle peeking zero bytes
if Size <= 0 then
begin
Result := 0;
exit;
end;
L := TCPBufferPeekPtr(TCPBuf, P);
// peek from TCP buffer
if L > Size then
L := Size;
Move(P^, Buf, L);
Result := L;
end;
// Peek byte from a TCP buffer
// Returns True if a byte is available
function TCPBufferPeekByte(
var TCPBuf: TTCPBuffer;
out B: Byte): Boolean;
var
P : Pointer;
L : Int32;
begin
L := TCPBufferPeekPtr(TCPBuf, P);
// peek from TCP buffer
if L = 0 then
Result := False
else
begin
B := PByte(P)^;
Result := True;
end;
end;
// Remove data from a TCP buffer
// Returns the number of bytes actually available and copied into the user buffer
function TCPBufferRemove(
var TCPBuf: TTCPBuffer;
var Buf; const Size: Int32): Int32; {$IFDEF UseInline}inline;{$ENDIF}
var
L, H, U : Int32;
begin
// peek data from buffer
L := TCPBufferPeek(TCPBuf, Buf, Size);
if L = 0 then
begin
Result := 0;
exit;
end;
// remove from TCP buffer
H := TCPBuf.Head;
U := TCPBuf.Used;
Dec(U, L);
if U = 0 then
H := 0
else
Inc(H, L);
TCPBuf.Head := H;
TCPBuf.Used := U;
TCPBufferMinimize(TCPBuf);
Result := L;
end;
// Remove data from a TCP buffer
// Returns True if Size bytes were available and copied into the user buffer
// Returns False if Size bytes were not available
function TCPBufferRemoveBuf(
var TCPBuf: TTCPBuffer;
var Buf; const Size: Int32): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
var
H, U : Int32;
P : PByte;
begin
// handle invalid size
if Size <= 0 then
begin
Result := False;
exit;
end;
// check if enough data available
U := TCPBuf.Used;
if U < Size then
begin
Result := False;
exit;
end;
// get buffer
H := TCPBuf.Head;
Assert(H + Size <= TCPBuf.Size);
P := TCPBuf.Ptr;
Assert(Assigned(P));
Inc(P, H);
Move(P^, Buf, Size);
// remove from TCP buffer
Dec(U, Size);
if U = 0 then
H := 0
else
Inc(H, Size);
TCPBuf.Head := H;
TCPBuf.Used := U;
TCPBufferMinimize(TCPBuf);
Result := True;
end;
// Discard a number of bytes from the TCP buffer
// Returns the number of bytes actually discarded from buffer
function TCPBufferDiscard(
var TCPBuf: TTCPBuffer;
const Size: Int32): Int32; {$IFDEF UseInline}inline;{$ENDIF}
var
L, U : Int32;
begin
// handle discarding zero bytes from buffer
L := Size;
if L <= 0 then
begin
Result := 0;
exit;
end;
// handle discarding the complete buffer
U := TCPBuf.Used;
if L >= U then
begin
TCPBuf.Used := 0;
TCPBuf.Head := 0;
TCPBufferMinimize(TCPBuf);
Result := U;
exit;
end;
// discard partial buffer
Inc(TCPBuf.Head, L);
Dec(U, L);
TCPBuf.Used := U;
TCPBufferMinimize(TCPBuf);
Result := L;
end;
// Returns number of bytes used in TCP buffer
function TCPBufferUsed(const TCPBuf: TTCPBuffer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
begin
Result := TCPBuf.Used;
end;
function TCPBufferEmpty(const TCPBuf: TTCPBuffer): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
begin
Result := TCPBuf.Used = 0;
end;
// Returns number of bytes available in TCP buffer
// Note: this function can return a negative number if the TCP buffer uses more bytes than set in Max
function TCPBufferAvailable(const TCPBuf: TTCPBuffer): Int32; {$IFDEF UseInline}inline;{$ENDIF}
begin
Result := TCPBuf.Max - TCPBuf.Used;
end;
// Returns pointer to TCP buffer head
function TCPBufferPtr(const TCPBuf: TTCPBuffer): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
var
P : PByte;
begin
Assert(Assigned(TCPBuf.Ptr));
P := TCPBuf.Ptr;
Inc(P, TCPBuf.Head);
Result := P;
end;
// LocateByteChar
// Returns position of Delimiter in buffer
// Returns >= 0 if found in buffer
// Returns -1 if not found in buffer
// MaxSize specifies maximum bytes before delimiter, of -1 for no limit
function TCPBufferLocateByteChar(const TCPBuf: TTCPBuffer;
const Delimiter: ByteCharSet; const MaxSize: Integer): Int32;
var
BufSize : Int32;
LocLen : Int32;
BufPtr : PByteChar;
I : Int32;
begin
if MaxSize = 0 then
begin
Result := -1;
exit;
end;
BufSize := TCPBuf.Used;
if BufSize <= 0 then
begin
Result := -1;
exit;
end;
if MaxSize < 0 then
LocLen := BufSize
else
if BufSize < MaxSize then
LocLen := BufSize
else
LocLen := MaxSize;
BufPtr := TCPBufferPtr(TCPBuf);
for I := 0 to LocLen - 1 do
if BufPtr^ in Delimiter then
begin
Result := I;
exit;
end
else
Inc(BufPtr);
Result := -1;
end;
end.
Reference in New Issue View Git Blame Copy Permalink