⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wsockbuf_rtc.pas

📁 Delphi快速开发Web Server
💻 PAS
字号:
{
  "WinSock Buffer" - Copyright (c) Danijel Tkalcec
  @html(<br>)
  Based on: [
    ICS by Fran鏾is PIETTE
    francois.piette(at)overbyte.be  http://www.overbyte.be
    francois.piette(at)rtfm.be      http://www.rtfm.be/fpiette
    francois.piette(at)pophost.eunet.be
    Copyright (C) 1996-2004 by Fran鏾is PIETTE
    Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
    <francois.piette(at)overbyte.be> ]

  @exclude
}
unit WSockBuf_rtc;

{$INCLUDE rtcDefs.inc}

interface

uses
  SysUtils;

type
  TBuffer = class(TObject)
    Buf      : Pointer;
    FBufSize : Integer;
    WrCount  : Integer;
    RdCount  : Integer;
  public
    constructor Create(nSize : Integer); virtual;
    destructor  Destroy; override;
    function    Write(Data : Pointer; Len : Integer) : Integer;
    function    Read(Data : Pointer; Len : Integer) : Integer;
    function    Peek(var Len : Integer) : Pointer;
    function    Remove(Len : Integer) : Integer;
    procedure   SetBufSize(newSize : Integer);
    property    BufSize : Integer read FBufSize write SetBufSize;
  end;

implementation


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TBuffer.Create(nSize : Integer);
begin
    inherited Create;
    WrCount  := 0;
    RdCount  := 0;
    BufSize := nSize;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TBuffer.Destroy;
begin
    if Assigned(Buf) then
      FreeMem(Buf, FBufSize);

    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TBuffer.SetBufSize(newSize : Integer);
  var
    newBuf : Pointer;
  begin
  if newSize <= 0 then
    newSize := 1514;

  if newSize = FBufSize then
    Exit;

  if WrCount = RdCount then 
    begin
    { Buffer is empty }
    if Assigned(Buf) then
      FreeMem(Buf, FBufSize);
    FBufSize := newSize;
    if FBufSize>0 then
      GetMem(Buf, FBufSize)
    else
      Buf := nil;
    end
  else 
    begin
    { Buffer contains data }
    if newSize>0 then
      begin
      GetMem(newBuf, newSize);
      if WrCount>0 then
        Move(Buf^, newBuf^, WrCount);
      end
    else
      newBuf := nil;
    if Assigned(Buf) then
      FreeMem(Buf, FBufSize);
    FBufSize := newSize;
    Buf      := newBuf;
    end;
  end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBuffer.Write(Data : Pointer; Len : Integer) : Integer;
var
    Remaining : Integer;
    Copied    : Integer;
begin
    Remaining := FBufSize - WrCount;
    if Remaining <= 0 then
        Result := 0
    else begin
        if Len <= Remaining then
            Copied := Len
        else
            Copied := Remaining;
        if Copied>0 then
          Move(Data^, (PChar(Buf) + WrCount)^, Copied);
        WrCount := WrCount + Copied;
        Result  := Copied;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBuffer.Read(Data : Pointer; Len : Integer) : Integer;
var
    Remaining : Integer;
    Copied    : Integer;
begin
    Remaining := WrCount - RdCount;
    if Remaining <= 0 then
        Result := 0
    else begin
        if Len <= Remaining then
            Copied := Len
        else
            Copied := Remaining;
        if Copied>0 then
          Move((PChar(Buf) + RdCount)^, Data^, Copied);
        RdCount := RdCount + Copied;

        if RdCount = WrCount then begin
            RdCount := 0;
            WrCount := 0;
        end;

        Result := Copied;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBuffer.Peek(var Len : Integer) : Pointer;
var
    Remaining : Integer;
begin
    Remaining := WrCount - RdCount;
    if Remaining <= 0 then begin
        Len    := 0;
        Result := nil;
    end
    else begin
        Len    := Remaining;
        Result := Pointer(PChar(Buf) + RdCount);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TBuffer.Remove(Len : Integer) : Integer;
var
    Remaining : Integer;
    Removed   : Integer;
begin
    Remaining := WrCount - RdCount;
    if Remaining <= 0 then
        Result := 0
    else begin
        if Len < Remaining then
            Removed := Len
        else
            Removed := Remaining;
        RdCount := RdCount + Removed;

        if RdCount = WrCount then begin
            RdCount := 0;
            WrCount := 0;
        end;

        Result := Removed;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -