•  
Создано: 18.02.2011 1:45:42 · Исправлено: 18.02.2011 1:45:42 · Прочтений: 1234

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  56386: IdSocketHandle.pas 
{
{   Rev 1.4    09/06/2004 09:48:42  CCostelloe
{ Kylix 3 patch
}
{
{   Rev 1.3    4/26/04 12:40:26 PM  RLebeau
{ Removed recursion from Readable()
}
{
{   Rev 1.2    2004.03.07 11:48:48 AM  czhower
{ Flushbuffer fix + other minor ones found
}
{
{   Rev 1.1    3/6/2004 5:16:14 PM  JPMugaas
{ Bug 67 fixes.  Do not write to const values.
}
{
{   Rev 1.0    2004.02.03 3:14:40 PM  czhower
{ Move and updates
}
{
{   Rev 1.23    2/2/2004 12:09:16 AM  JPMugaas
{ GetSockOpt should now work in DotNET.
}
{
{   Rev 1.22    2/1/2004 6:10:46 PM  JPMugaas
{ GetSockOpt.
}
{
{   Rev 1.21    12/31/2003 9:51:58 PM  BGooijen
{ Added IPv6 support
}
{
{   Rev 1.20    10/26/2003 12:29:40 PM  BGooijen
{ DotNet
}
{
{   Rev 1.19    10/22/2003 04:40:48 PM  JPMugaas
{ Should compile with some restored functionality.  Still not finished.
}
{
{   Rev 1.18    2003.10.11 5:50:26 PM  czhower
{ -VCL fixes for servers
{ -Chain suport for servers (Super core)
{ -Scheduler upgrades
{ -Full yarn support
}
{
{   Rev 1.17    10/5/2003 9:55:30 PM  BGooijen
{ TIdTCPServer works on D7 and DotNet now
}
{
{   Rev 1.16    2003.10.02 12:44:42 PM  czhower
{ Fix for Bind, Connect
}
{
{   Rev 1.15    2003.10.02 10:16:28 AM  czhower
{ .Net
}
{
{   Rev 1.14    2003.10.01 9:11:20 PM  czhower
{ .Net
}
{
{   Rev 1.13    2003.10.01 5:05:14 PM  czhower
{ .Net
}
{
{   Rev 1.12    2003.10.01 2:30:40 PM  czhower
{ .Net
}
{
{   Rev 1.10    10/1/2003 12:14:12 AM  BGooijen
{ DotNet: removing CheckForSocketError
}
{
{   Rev 1.9    2003.10.01 1:12:36 AM  czhower
{ .Net
}
{
{   Rev 1.8    2003.09.30 1:23:02 PM  czhower
{ Stack split for DotNet
}
{
{   Rev 1.7    20.09.2003 16:33:28  ARybin
{ bug fix:
{ NOT Integer <> 0 is not boolean operation, because:
{ (NOT Integer) = inverted integer
}
{
{   Rev 1.6    2003.07.14 1:57:24 PM  czhower
{ -First set of IOCP fixes.
{ -Fixed a threadsafe problem with the stack class.
}
{
{   Rev 1.5    7/1/2003 05:20:36 PM  JPMugaas
{ Minor optimizations.  Illiminated some unnecessary string operations.
}
{
{   Rev 1.4    7/1/2003 03:39:52 PM  JPMugaas
{ Started numeric IP function API calls for more efficiency.
}
{
    Rev 1.3    5/11/2003 11:59:06 AM  BGooijen
  Added OverLapped property
}
{
    Rev 1.2    5/11/2003 12:35:30 AM  BGooijen
  temporary creates overlapped socked handles
}
{
{   Rev 1.1    3/21/2003 01:50:08 AM  JPMugaas
{ SetBinding method added as per request received in private E-Mail.
}
{
{   Rev 1.0    11/13/2002 08:58:46 AM  JPMugaas
}
unit IdSocketHandle;

interface

uses
  Classes,
  IdException, IdGlobal, IdStackConsts, IdStack;

type
  TIdSocketHandle = class;

  TIdSocketHandles = class(TOwnedCollection)
  protected
    FDefaultPort: TIdPort;
    //
    function GetItem(Index: Integer): TIdSocketHandle;
    procedure SetItem(Index: Integer; const Value: TIdSocketHandle);
  public
    constructor Create(AOwner: TComponent); reintroduce;
    function Add: TIdSocketHandle; reintroduce;
    function BindingByHandle(const AHandle: TIdStackSocketHandle): TIdSocketHandle;
    property Items[Index: Integer]: TIdSocketHandle read GetItem write SetItem; default;
    //
    property DefaultPort: TIdPort read FDefaultPort write FDefaultPort;
  end;

  TIdSocketHandle = class(TCollectionItem)
  protected
    FClientPortMin: Integer;
    FClientPortMax: Integer;
    FHandle: TIdStackSocketHandle;
    FHandleAllocated: Boolean;
    FIP: string;
    FPeerIP: string;
    FPort: TIdPort;
    FPeerPort: TIdPort;
    FReadSocketList: TIdSocketList;
    FOverLapped:boolean;
    FIPVersion: TIdIPVersion;
    //
    function BindPortReserved: Boolean;
    procedure SetOverLapped(const AValue:boolean);
    procedure SetHandle(AHandle: TIdStackSocketHandle);
    procedure SetIPVersion(const Value: TIdIPVersion);
    function TryBind: Boolean;
  public
    function Accept(ASocket: TIdStackSocketHandle): Boolean;
{$IFDEF LINUX}
    procedure AllocateSocket(const ASocketType: TIdSocketType = TIdSocketType(Id_SOCK_STREAM);
     const AProtocol: TIdSocketProtocol = Id_IPPROTO_IP);
{$ELSE}
    procedure AllocateSocket(const ASocketType: TIdSocketType = Id_SOCK_STREAM;
     const AProtocol: TIdSocketProtocol = Id_IPPROTO_IP);
{$ENDIF}
    // Returns True if error was ignored (Matches iIgnore), false if no error occurred
    procedure Assign(Source: TPersistent); override;
    procedure Bind;
    procedure CloseSocket; virtual;
    procedure Connect; virtual;
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
//    procedure GetSockOpt(level, optname: Integer; optval: PChar; optlen: Integer);
    procedure Listen(const anQueueCount: integer = 5);
    function Readable(AMSec: Integer = IdTimeoutDefault): boolean;
    function Receive(var VBuffer: TIdBytes): Integer;
    function RecvFrom(var ABuffer : TIdBytes; var VIP: string;
      var VPort: Integer): Integer;
    procedure Reset(const AResetLocal: boolean = True);
    function Send(
      const ABuffer: TIdBytes;
      AOffset: Integer;
      ASize: Integer = -1
      ): Integer;
    procedure SendTo(const AIP: string; const APort: Integer; const ABuffer : TIdBytes);
    procedure SetPeer(const AIP: string; const APort: TIdPort);
    procedure SetBinding(const AIP: string; const APort: TIdPort);
    procedure GetSockOpt(ALevel:TIdSocketOptionLevel; AOptName: TIdSocketOption; out VOptVal: Integer);
    procedure SetSockOpt(ALevel:TIdSocketOptionLevel; AOptName: TIdSocketOption; AOptVal: Integer);
    function Select(ATimeout: Integer = IdTimeoutInfinite): Boolean;
    procedure UpdateBindingLocal;
    procedure UpdateBindingPeer;
    //
    property HandleAllocated: Boolean read FHandleAllocated;
    property Handle: TIdStackSocketHandle read FHandle;
    property OverLapped:boolean read FOverLapped write SetOverLapped;
    property PeerIP: string read FPeerIP;
    property PeerPort: TIdPort read FPeerPort;
  published
    property ClientPortMin : TIdPort read FClientPortMin write FClientPortMin default 0;
    property ClientPortMax : TIdPort read FClientPortMax write FClientPortMax default 0;
    property IP: string read FIP write FIP;
    property IPVersion: TIdIPVersion read FIPVersion write SetIPVersion default ID_DEFAULT_IP_VERSION;
    property Port: TIdPort read FPort write FPort;
  end;

implementation

uses
  IdAntiFreezeBase, IdComponent, IdResourceStrings,
  SysUtils;

{ TIdSocketHandle }

//procedure TIdSocketHandle.AllocateSocket(
// const ASocketType: TIdSocketType = Id_SOCK_STREAM;
// const AProtocol: TIdSocketProtocol = Id_IPPROTO_IP);
procedure TIdSocketHandle.AllocateSocket(
 const ASocketType: TIdSocketType;
 const AProtocol: TIdSocketProtocol);
begin
  // If we are reallocating a socket - close and destroy the old socket handle
  CloseSocket;
  if HandleAllocated then begin
    Reset;
  end;
  // Set property so it calls the writer
  SetHandle(GStack.NewSocketHandle(ASocketType, AProtocol, FIPVersion ,FOverLapped));
end;

procedure TIdSocketHandle.CloseSocket;
begin
  if HandleAllocated then begin
    // Must be first, closing socket will trigger some errors, and they
    // may then call (in other threads) Connected, which in turn looks at
    // FHandleAllocated.
    FHandleAllocated := False;
    GStack.Disconnect(Handle);
    SetHandle(Id_INVALID_SOCKET);
  end;
end;

procedure TIdSocketHandle.Connect;
begin
  GStack.Connect(Handle, PeerIP, PeerPort, FIPVersion);
  // UpdateBindingLocal needs to be called even though Bind calls it. After
  // Bind is may be 0.0.0.0 (INADDR_ANY). After connect it will be a real IP.
  UpdateBindingLocal;
  //TODO: Could Peer binding ever be other than what we specified above?
  // Need to reread it?
  UpdateBindingPeer;
end;

destructor TIdSocketHandle.Destroy;
begin
  CloseSocket;
  inherited;
end;

function TIdSocketHandle.Receive(var VBuffer: TIdBytes): Integer;
begin
  Result := GStack.Receive(Handle, VBuffer);
end;

function TIdSocketHandle.Send(
  const ABuffer: TIdBytes;
  AOffset: Integer;
  ASize: Integer = -1
  ): Integer;
begin
  Result := GStack.Send(Handle, ABuffer, AOffset, ASize);
end;

procedure TIdSocketHandle.SetSockOpt(ALevel:TIdSocketOptionLevel; 
      AOptName: TIdSocketOption; AOptVal: Integer);
begin
  GStack.SetSocketOption(Handle,ALevel,AOptName,AOptVal);
////  (GStack as TIdStackBSDBase).WSSetSockOpt(Handle, level, optname, optval, optlen);
end;

procedure TIdSocketHandle.SendTo(const AIP: string; const APort: Integer; const ABuffer : TIdBytes);
begin
  GStack.SendTo(Handle, ABuffer, 0, AIP, APort);
end;

function TIdSocketHandle.RecvFrom(var ABuffer : TIdBytes; var VIP: string;
 var VPort: Integer): Integer;
begin
  Result := GStack.ReceiveFrom(Handle,ABuffer,VIP,VPort);
//  (GStack as TIdStackBSDBase).WSRecvFrom(Handle, ABuffer, ALength, AFlags, VIP, VPort, IPVersion);
end;

procedure TIdSocketHandle.Bind;
begin
  if (Port = 0) and (FClientPortMin <> 0) and (FClientPortMax <> 0) then begin
    if (FClientPortMin > FClientPortMax) then begin
      raise EIdInvalidPortRange.CreateFmt(RSInvalidPortRange
       , [FClientPortMin, FClientPortMax]);
    end else if not BindPortReserved then begin
      raise EIdCanNotBindPortInRange.CreateFmt(RSCanNotBindRange
       , [FClientPortMin, FClientPortMax]);
    end;
  end else if not TryBind then begin
    raise EIdCouldNotBindSocket.Create(RSCouldNotBindSocket);
  end;
end;

procedure TIdSocketHandle.SetPeer(const AIP: string; const APort: TIdPort);
begin
  FPeerIP := AIP;
  FPeerPort := APort;
end;

procedure TIdSocketHandle.SetBinding(const AIP: string; const APort: TIdPort);
begin
  FIP := AIP;
  FPort := APort;
end;

procedure TIdSocketHandle.SetOverLapped(const AValue:boolean);
begin
  // TODO: check for HandleAllocated
  FOverLapped := AValue;
end;

procedure TIdSocketHandle.Listen(const anQueueCount: integer);
begin
  GStack.Listen(Handle, anQueueCount);
end;

function TIdSocketHandle.Accept(ASocket: TIdStackSocketHandle): Boolean;
var
  LAcceptedSocket: TIdStackSocketHandle;
begin
  Reset;
  LAcceptedSocket := GStack.Accept(ASocket, FIP, FPort, FIPVersion);
  result := (LAcceptedSocket <> Id_INVALID_SOCKET);
  if result then begin
    SetHandle(LAcceptedSocket);
    // UpdateBindingLocal is necessary as it may be listening on multiple IPs/Ports
    UpdateBindingLocal;
    UpdateBindingPeer;
  end;
end;

constructor TIdSocketHandle.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  Reset;
  FClientPortMin := 0;
  FClientPortMax := 0;
  if Assigned(ACollection) then begin
    Port := TIdSocketHandles(ACollection).DefaultPort;
  end;
end;

function TIdSocketHandle.Readable(AMSec: Integer = IdTimeoutDefault): Boolean;

  function CheckIsReadable(AMSec: Integer): Boolean;
  begin
    if HandleAllocated then begin
      Result := Select(AMSec);
    end else begin
      raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
    end;
  end;

begin
  if TIdAntiFreezeBase.ShouldUse then begin
    if AMSec = IdTimeoutInfinite then begin
      repeat
        Result := CheckIsReadable(GAntiFreeze.IdleTimeOut);
      until Result;
      Exit;
    end else if AMSec > GAntiFreeze.IdleTimeOut then begin
      Result := CheckIsReadable(AMSec - GAntiFreeze.IdleTimeOut);
      if Result then begin
        Exit;
      end;
      AMSec := GAntiFreeze.IdleTimeOut;
    end;
  end;
  Result := CheckIsReadable(AMSec);
end;

procedure TIdSocketHandle.Assign(Source: TPersistent);
var
  LSource: TIdSocketHandle;
begin
  if ClassType <> Source.ClassType then begin
    inherited
  end else begin
    LSource := TIdSocketHandle(Source);
    FIP := LSource.FIP;
    Port := LSource.Port;
    FPeerIP := LSource.FPeerIP;
    FPeerPort := LSource.FPeerPort;
    FIPVersion := LSource.IPVersion;
  end;
end;

procedure TIdSocketHandle.UpdateBindingLocal;
begin
  GStack.GetSocketName(Handle, FIP, FPort);
end;

procedure TIdSocketHandle.UpdateBindingPeer;
begin
  GStack.GetPeerName(Handle, FPeerIP, FPeerPort);
end;

procedure TIdSocketHandle.Reset(const AResetLocal: boolean = True);
begin
  SetHandle(Id_INVALID_SOCKET);
  if AResetLocal then begin
    FIP := '';
    FPort := 0;
  end;
  FPeerIP := '';
  FPeerPort := 0;
  FIPVersion := ID_DEFAULT_IP_VERSION ;
end;

function TIdSocketHandle.TryBind: Boolean;
begin
  try
    GStack.Bind(Handle, FIP, Port, FIPVersion);
    Result := True;
    UpdateBindingLocal;
  except
    Result := False;
  end;
end;

function TIdSocketHandle.BindPortReserved: Boolean;
var
  i : Integer;
begin
  Result := false;
  for i := FClientPortMax downto FClientPortMin do begin
    FPort := i;
    if TryBind then begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure TIdSocketHandle.GetSockOpt(ALevel:TIdSocketOptionLevel; AOptName: TIdSocketOption; out VOptVal: Integer);
begin
  GStack.GetSocketOption(Handle,ALevel,AOptName,VOptVal);
end;

function TIdSocketHandle.Select(ATimeOut: Integer = IdTimeoutInfinite): Boolean;
begin
  Result := FReadSocketList.SelectRead(ATimeOut);
  TIdAntiFreezeBase.DoProcess(Result = False);
end;

procedure TIdSocketHandle.SetHandle(AHandle: TIdStackSocketHandle);
begin
  FHandle := AHandle;
  FHandleAllocated := Handle <> Id_INVALID_SOCKET;
  FreeAndNil(FReadSocketList);
  if HandleAllocated then begin
    FReadSocketList := TIdSocketList.CreateSocketList;
    FReadSocketList.Add(Handle);
  end;
end;

procedure TIdSocketHandle.SetIPVersion(const Value: TIdIPVersion);
begin
  if Value <> FIPVersion then begin
    if HandleAllocated then begin
      raise EIdCannotSetIPVersionWhenConnected.Create(RSCannotSetIPVersionWhenConnected);
    end;
    FIPVersion := Value;
  end;
end;

{ TIdSocketHandles }

function TIdSocketHandles.Add: TIdSocketHandle;
begin
  Result := inherited Add as TIdSocketHandle;
  Result.Port := DefaultPort;
end;

function TIdSocketHandles.BindingByHandle(const AHandle: TIdStackSocketHandle): TIdSocketHandle;
var
  i: integer;
begin
  Result := nil;
  i := Count - 1;
  while (i >= 0) and (Items[i].Handle <> AHandle) do begin
    dec(i);
  end;
  if i >= 0 then begin
    Result := Items[i];
  end;
end;

constructor TIdSocketHandles.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TIdSocketHandle);
end;

function TIdSocketHandles.GetItem(Index: Integer): TIdSocketHandle;
begin
  Result := TIdSocketHandle(inherited Items[index]);
end;

procedure TIdSocketHandles.SetItem(Index: Integer; const Value: TIdSocketHandle);
begin
  inherited SetItem(Index, Value);
end;

end.