nhcnetclasses.pas

NetHook API 对战平台内核库是一套实现时下流行的网络对战平台[如浩方、VS]同样功能的通用内核库

{*************************************************************************}
{ 单元说明: 杂项类库                                                      }
{*************************************************************************}

unit NhcNetClasses;

interface

uses
  Windows, SysUtils, Classes, NhContainers, NhSocketObj;

type

{ TUdpPacket - UDP包的相关数据 }

  TUdpPacket = class(TObject)
  private
    FPacketBuffer: PChar;
    FPacketSize: Integer;
    FPeerAddr: TPeerAddress;
  public
    constructor Create;
    destructor Destroy; override;

    procedure SetPacket(const APacketBuffer; APacketSize: Integer;
      const APeerAddr: TPeerAddress);

    property PacketBuffer: PChar read FPacketBuffer;
    property PacketSize: Integer read FPacketSize;
    property PeerAddr: TPeerAddress read FPeerAddr;
  end;

{ TUdpPacketCache - UDP包缓冲器 }

  TUdpPacketCache = class(TSyncObject)
  private
    FItems: TList;            // TUdpPacket[]
    FMaxSize: Integer;        // 最大容量

    function GetCount: Integer;
    function GetItems(Index: Integer): TUdpPacket;
    procedure SetMaxSize(Value: Integer);
  public
    constructor Create(MaxSize: Integer = 0);
    destructor Destroy; override;

    function Add(const PacketBuffer; PacketSize: Integer; const PeerAddr: TPeerAddress): Boolean;
    function Extract: TUdpPacket;
    procedure Delete(Index: Integer);
    procedure Clear;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: TUdpPacket read GetItems;
    property MaxSize: Integer read FMaxSize write SetMaxSize;
  end;

{ TTcpPacket - TCP包的相关数据 }

  TTcpPacket = class(TObject)
  private
    FConnection: TTcpConnection;
    FPacketBuffer: PChar;
    FPacketSize: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    procedure SetPacket(AConnection: TTcpConnection;
      const APacketBuffer; APacketSize: Integer);

    property Connection: TTcpConnection read FConnection;
    property PacketBuffer: PChar read FPacketBuffer;
    property PacketSize: Integer read FPacketSize;
  end;

{ TTcpPacketCache - TCP包缓冲器 }

  TTcpPacketCache = class(TSyncObject)
  private
    FItems: TList;            // TTcpPacket[]
    FMaxSize: Integer;        // 最大容量

    function GetCount: Integer;
    function GetItems(Index: Integer): TTcpPacket;
    procedure SetMaxSize(Value: Integer);
  public
    constructor Create(MaxSize: Integer = 0);
    destructor Destroy; override;

    function Add(Connection: TTcpConnection; const PacketBuffer;
      PacketSize: Integer): Boolean;
    function Extract: TTcpPacket;
    procedure Delete(Index: Integer);
    procedure Clear;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: TTcpPacket read GetItems;
    property MaxSize: Integer read FMaxSize write SetMaxSize;
  end;

implementation

{ TUdpPacket }

constructor TUdpPacket.Create;
begin
  inherited;
end;

destructor TUdpPacket.Destroy;
begin
  if FPacketBuffer <> nil then
    FreeMem(FPacketBuffer);
  inherited;
end;

procedure TUdpPacket.SetPacket(const APacketBuffer; APacketSize: Integer;
  const APeerAddr: TPeerAddress);
begin
  if FPacketBuffer <> nil then
    FreeMem(FPacketBuffer);
  GetMem(FPacketBuffer, APacketSize);
  Move(APacketBuffer, FPacketBuffer^, APacketSize);
  FPacketSize := APacketSize;
  FPeerAddr := APeerAddr;
end;

{ TUdpPacketCache }

constructor TUdpPacketCache.Create(MaxSize: Integer);
begin
  inherited Create;
  ThreadSafe := True;
  FItems := TList.Create;
  SetMaxSize(MaxSize);
end;

destructor TUdpPacketCache.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TUdpPacketCache.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TUdpPacketCache.GetItems(Index: Integer): TUdpPacket;
begin
  Assert((Index >= 0) and (Index < FItems.Count));
  Lock;
  try
    Result := TUdpPacket(FItems[Index]);
  finally
    Unlock;
  end;
end;

procedure TUdpPacketCache.SetMaxSize(Value: Integer);
begin
  if Value < 0 then Value := 0;
  FMaxSize := Value;
end;

function TUdpPacketCache.Add(const PacketBuffer; PacketSize: Integer;
  const PeerAddr: TPeerAddress): Boolean;
var
  UdpPacket: TUdpPacket;
begin
  Lock;
  try
    Result := (PacketSize > 0) and ((FItems.Count < FMaxSize) or (FMaxSize = 0));
    if Result then
    begin
      UdpPacket := TUdpPacket.Create;
      UdpPacket.SetPacket(PacketBuffer, PacketSize, PeerAddr);
      FItems.Add(UdpPacket);
    end;
  finally
    Unlock;
  end;
end;

function TUdpPacketCache.Extract: TUdpPacket;
begin
  Lock;
  try
    if FItems.Count > 0 then
    begin
      Result := TUdpPacket(FItems[0]);
      FItems.Delete(0);
    end else
      Result := nil;
  finally
    Unlock;
  end;
end;

procedure TUdpPacketCache.Delete(Index: Integer);
begin
  Lock;
  try
    if (Index >= 0) and (Index < FItems.Count) then
    begin
      TUdpPacket(FItems[Index]).Free;
      FItems.Delete(Index);
    end;
  finally
    Unlock;
  end;
end;

procedure TUdpPacketCache.Clear;
var
  I: Integer;
begin
  Lock;
  try
    for I := 0 to FItems.Count - 1 do
      TUdpPacket(FItems[I]).Free;
    FItems.Clear;
  finally
    Unlock;
  end;
end;

{ TTcpPacket }

constructor TTcpPacket.Create;
begin
  inherited;
end;

destructor TTcpPacket.Destroy;
begin
  if FPacketBuffer <> nil then
    FreeMem(FPacketBuffer);
  inherited;
end;

procedure TTcpPacket.SetPacket(AConnection: TTcpConnection;
  const APacketBuffer; APacketSize: Integer);
begin
  FConnection := AConnection;
  if FPacketBuffer <> nil then
    FreeMem(FPacketBuffer);
  GetMem(FPacketBuffer, APacketSize);
  Move(APacketBuffer, FPacketBuffer^, APacketSize);
  FPacketSize := APacketSize;
end;

{ TTcpPacketCache }

constructor TTcpPacketCache.Create(MaxSize: Integer);
begin
  inherited Create;
  ThreadSafe := True;
  FItems := TList.Create;
  SetMaxSize(MaxSize);
end;

destructor TTcpPacketCache.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TTcpPacketCache.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TTcpPacketCache.GetItems(Index: Integer): TTcpPacket;
begin
  Assert((Index >= 0) and (Index < FItems.Count));
  Lock;
  try
    Result := TTcpPacket(FItems[Index]);
  finally
    Unlock;
  end;
end;

procedure TTcpPacketCache.SetMaxSize(Value: Integer);
begin
  if Value < 0 then Value := 0;
  FMaxSize := Value;
end;

function TTcpPacketCache.Add(Connection: TTcpConnection;
  const PacketBuffer; PacketSize: Integer): Boolean;
var
  TcpPacket: TTcpPacket;
begin
  Lock;
  try
    Result := (PacketSize > 0) and ((FItems.Count < FMaxSize) or (FMaxSize = 0));
    if Result then
    begin
      TcpPacket := TTcpPacket.Create;
      TcpPacket.SetPacket(Connection, PacketBuffer, PacketSize);
      FItems.Add(TcpPacket);
    end;
  finally
    Unlock;
  end;
end;

function TTcpPacketCache.Extract: TTcpPacket;
begin
  Lock;
  try
    if FItems.Count > 0 then
    begin
      Result := TTcpPacket(FItems[0]);
      FItems.Delete(0);
    end else
      Result := nil;
  finally
    Unlock;
  end;
end;

procedure TTcpPacketCache.Delete(Index: Integer);
begin
  Lock;
  try
    if (Index >= 0) and (Index < FItems.Count) then
    begin
      TTcpPacket(FItems[Index]).Free;
      FItems.Delete(Index);
    end;
  finally
    Unlock;
  end;
end;

procedure TTcpPacketCache.Clear;
var
  I: Integer;
begin
  Lock;
  try
    for I := 0 to FItems.Count - 1 do
      TTcpPacket(FItems[I]).Free;
    FItems.Clear;
  finally
    Unlock;
  end;
end;

end.