{ $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:  24026: IdStackDotNet.pas
{
{   Rev 1.23    10/28/2003 10:12:36 PM  BGooijen
{ DotNet
}
{
{   Rev 1.22    10/26/2003 10:31:16 PM  BGooijen
{ oops, checked in debug version <g>, this is the right one
}
{
{   Rev 1.21    10/26/2003 5:04:26 PM  BGooijen
{ UDP Server and Client
}
{
{   Rev 1.20    10/21/2003 11:03:50 PM  BGooijen
{ More SendTo, ReceiveFrom
}
{
{   Rev 1.19    10/21/2003 9:24:32 PM  BGooijen
{ Started on SendTo, ReceiveFrom
}
{
{   Rev 1.18    10/19/2003 5:21:30 PM  BGooijen
{ SetSocketOption
}
{
{   Rev 1.17    10/11/2003 4:16:40 PM  BGooijen
{ Compiles again
}
{
{   Rev 1.16    10/5/2003 9:55:28 PM  BGooijen
{ TIdTCPServer works on D7 and DotNet now
}
{
{   Rev 1.15    10/5/2003 3:10:42 PM  BGooijen
{ forgot to clone the Sockets list in some Select methods, + added Listen and
{ Accept
}
{
{   Rev 1.14    10/5/2003 1:52:14 AM  BGooijen
{ Added typecasts with network ordering calls, there are required for some
{ reason
}
{
{   Rev 1.13    10/4/2003 10:39:38 PM  BGooijen
{ Renamed WSXXX functions in implementation section too
}
{
{   Rev 1.12    04/10/2003 22:32:00  HHariri
{ moving of WSNXXX method to IdStack and renaming of the DotNet ones
}
{
{   Rev 1.11    04/10/2003 21:28:42  HHariri
{ Netowkr ordering functions
}
{
{   Rev 1.10    10/3/2003 11:02:02 PM  BGooijen
{ fixed calls to Socket.Select
}
{
{   Rev 1.9    10/3/2003 11:39:38 PM  GGrieve
{ more work
}
{
{   Rev 1.8    10/3/2003 12:09:32 AM  BGooijen
{ DotNet
}
{
{   Rev 1.7    10/2/2003 8:23:52 PM  BGooijen
{ .net
}
{
{   Rev 1.6    10/2/2003 8:08:52 PM  BGooijen
{ .Connect works not in .net
}
{
{   Rev 1.5    10/2/2003 7:31:20 PM  BGooijen
{ .net
}
{
{   Rev 1.4    10/2/2003 6:12:36 PM  GGrieve
{ work in progress (hardly started)
}
{
{   Rev 1.3    2003.10.01 9:11:24 PM  czhower
{ .Net
}
{
{   Rev 1.2    2003.10.01 5:05:18 PM  czhower
{ .Net
}
{
{   Rev 1.1    2003.10.01 1:12:40 AM  czhower
{ .Net
}
{
{   Rev 1.0    2003.09.30 10:35:40 AM  czhower
{ Initial Checkin
}
unit IdStackDotNet;

interface

uses
  IdCoreGlobal, IdStack, IdStackConsts,
  System.Collections;

type

  TIdSocketListDotNet = class(TIdSocketList)
  protected
     Sockets:ArrayList;

     function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Add(AHandle: TIdStackSocketHandle); override;
    procedure Remove(AHandle: TIdStackSocketHandle); override;
    function Count: Integer; override;
    procedure Clear; override;
    function Clone: TIdSocketList; override;
    function Contains(AHandle: TIdStackSocketHandle): boolean; override;
    class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
     AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
    function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean;
     override;
    function SelectReadList(var VSocketList: TIdSocketList;
     const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  end;

  TIdStackDotNet = class(TIdStack)
  protected
    function ReadHostName: string; override;
    function HostByName(const AHostName: string): string; override;
  public
    procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string;
                    const APort: Integer); override;
    procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
                    const APort: TIdPort); override;
    procedure Disconnect(ASocket: TIdStackSocketHandle); override;
    procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
                    var VPort: Integer); override;
    procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
                    var VPort: TIdPort); override;
    function  NewSocketHandle(const ASocketType:TIdSocketType;
                    const AProtocol: TIdSocketProtocol;
                    const AOverlapped: Boolean = False) : TIdStackSocketHandle; override;
    // Result:
    // > 0: Number of bytes received
    //   0: Connection closed gracefully
    // Will raise exceptions in other cases
    function Receive(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes) : Integer; override;
    function Send(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
                   const AOffset: Integer): Integer; override;

    function ReceiveFrom(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
             var VIP: string; var VPort: Integer): Integer; override;
    function SendTo(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
             const AOffset: Integer; const AIP: string; const APort: integer
             ): Integer; override;

    function HostToNetwork(AHostShort: Word): Word; override;
    function NetworkToHost(ANetShort: Word): Word; override;
    function HostToNetwork(AHostLong: LongWord): LongWord; override;
    function NetworkToHost(ANetLong: LongWord): LongWord; override;

    procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);override;
    function Accept(ASocket: TIdStackSocketHandle;
      var VIP: string; var VPort: Integer):TIdStackSocketHandle; override;
      
    procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel:TIdSocketOptionLevel;
      AOptName: TIdSocketOption; AOptVal: Integer); overload;override;
  end;

implementation

uses
  IdException,
  System.Net,
  System.Net.Sockets;

{ TIdStackDotNet }

function BuildException(AException : System.Exception) : Exception;
var
  LSocketError : System.Net.Sockets.SocketException;
begin
  if AException is System.Net.Sockets.SocketException then
    begin
    LSocketError := AException as System.Net.Sockets.SocketException;
    result := EIdSocketError.createError(LSocketError.ErrorCode, LSocketError.Message)
    end
  else
    begin
    result := EIdWrapperException.create(AException.Message, AException);
    end;
end;

procedure TIdStackDotNet.Bind(ASocket: TIdStackSocketHandle; const AIP: string;
  const APort: Integer);
var
  LEndPoint : IPEndPoint;
begin
  try
    LEndPoint := IPEndPoint.Create(IPAddress.Parse(AIP), APort);
    ASocket.Bind(LEndPoint);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

procedure TIdStackDotNet.Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  const APort: TIdPort);
var
  LEndPoint : IPEndPoint;
begin
  try
    LEndPoint := IPEndPoint.Create(IPAddress.Parse(AIP), APort);
    ASocket.Connect(LEndPoint);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

procedure TIdStackDotNet.Disconnect(ASocket: TIdStackSocketHandle);
begin
  try
    ASocket.Close;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

procedure TIdStackDotNet.Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);
begin
  try
    ASocket.Listen(ABackLog);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.Accept(ASocket: TIdStackSocketHandle;
  var VIP: string; var VPort: Integer):TIdStackSocketHandle;
begin
  try
    result := ASocket.Accept();
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

procedure TIdStackDotNet.GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: Integer);
var
  LEndPoint : EndPoint;
begin
  try
    LEndPoint := ASocket.remoteEndPoint;
    VIP := (LEndPoint as IPEndPoint).Address.ToString;
    VPort := (LEndPoint as IPEndPoint).Port;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

procedure TIdStackDotNet.GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort);
var
  LEndPoint : EndPoint;
begin
  try
    LEndPoint := ASocket.localEndPoint;
    VIP := (LEndPoint as IPEndPoint).Address.ToString;
    VPort := (LEndPoint as IPEndPoint).Port;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.HostByName(const AHostName: string): string;
begin
  try
   result := Dns.Resolve(AHostName).AddressList[0].ToString;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.NewSocketHandle(const ASocketType:TIdSocketType;
  const AProtocol: TIdSocketProtocol; const AOverlapped: Boolean): TIdStackSocketHandle;
begin
  try
    result := Socket.Create(AddressFamily.InterNetwork, ASocketType, AProtocol);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.ReadHostName: string;
begin
  try
    result := System.Net.DNS.GetHostName;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.Receive(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes): Integer;
begin
  try
    result := ASocket.Receive(ABuffer,length(ABuffer),SocketFlags.None);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.Send(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes; const AOffset: Integer): Integer;
begin
  try
    result := ASocket.Send(ABuffer,AOffset,Length(ABuffer),SocketFlags.None);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.ReceiveFrom(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
             var VIP: string; var VPort: Integer): Integer;
var
  LEndPoint : EndPoint;
begin
  Result := 0; // to make the compiler happy
  LEndPoint := IPEndPoint.Create(IPAddress.Any, 0);
  try
    try
      Result := ASocket.ReceiveFrom(ABuffer,SocketFlags.None,LEndPoint);
    except
      on e:exception do begin
        raise BuildException(e);
      end;
    end;
    VIP := IPEndPoint(LEndPoint).Address.ToString;
    VPort := IPEndPoint(LEndPoint).Port;
  finally
    LEndPoint.free;
  end;
end;

function TIdStackDotNet.SendTo(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
             const AOffset: Integer; const AIP: string; const APort: integer
             ): Integer;
var
  LEndPoint : EndPoint;
begin
  Result := 0; // to make the compiler happy
  LEndPoint := IPEndPoint.Create(IPAddress.Parse(AIP), APort);
  try
    try
      Result := ASocket.SendTo(ABuffer,SocketFlags.None,LEndPoint);
    except
      on e:exception do begin
        raise BuildException(e);
      end;
    end;
  finally
    LEndPoint.free;
  end;
end;


//////////////////////////////////////////////////////////////



constructor TIdSocketListDotNet.Create;
begin
  inherited Create;
  Sockets:=ArrayList.Create;
end;

destructor TIdSocketListDotNet.Destroy;
begin
  Sockets.free;
  inherited Destroy;
end;

procedure TIdSocketListDotNet.Add(AHandle: TIdStackSocketHandle);
begin
  Sockets.Add(AHandle);
end;

procedure TIdSocketListDotNet.Clear;
begin
  Sockets.Clear;
end;

function TIdSocketListDotNet.Contains(AHandle: TIdStackSocketHandle): Boolean;
begin
  result:=Sockets.Contains(AHandle);
end;

function TIdSocketListDotNet.Count: Integer;
begin
  result:=Sockets.Count;
end;

function TIdSocketListDotNet.GetItem(AIndex: Integer): TIdStackSocketHandle;
begin
  result:=(Sockets.Item[AIndex]) as TIdStackSocketHandle;
end;

procedure TIdSocketListDotNet.Remove(AHandle: TIdStackSocketHandle);
begin
  Sockets.Remove(AHandle);
end;

function TIdSocketListDotNet.SelectRead(const ATimeout: Integer): Boolean;
var
  LTempSockets:ArrayList;
begin
  try
    // DotNet updates this object on return, so we need to copy it each time we need it
    LTempSockets:=ArrayList(Sockets.Clone);
    try
      if ATimeout=IdTimeoutInfinite then begin
        Socket.Select(LTempSockets,nil,nil,MaxLongint);
      end else begin
        Socket.Select(LTempSockets,nil,nil,ATimeout*1000);
      end;
      result := LTempSockets.Count > 0;
    finally
      LTempSockets.free;
    end;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdSocketListDotNet.SelectReadList(var VSocketList: TIdSocketList; const ATimeout: Integer): Boolean;
var
  LTempSockets:ArrayList;
begin
  try
    // DotNet updates this object on return, so we need to copy it each time we need it
    LTempSockets:=ArrayList(Sockets.Clone);
    try
      if ATimeout=IdTimeoutInfinite then begin
        Socket.Select(LTempSockets,nil,nil,MaxLongint);
      end else begin
        Socket.Select(LTempSockets,nil,nil,ATimeout*1000);
      end;
      result := LTempSockets.Count > 0;
    finally
      LTempSockets.free;
    end;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

class function TIdSocketListDotNet.Select(AReadList, AWriteList,
 AExceptList: TIdSocketList; const ATimeout: Integer): Boolean;
begin
  try
    if ATimeout=IdTimeoutInfinite then begin
      Socket.Select(
        TIdSocketListDotNet(AReadList).Sockets,
        TIdSocketListDotNet(AWriteList).Sockets,
        TIdSocketListDotNet(AExceptList).Sockets,MaxLongint);
    end else begin
      Socket.Select(
        TIdSocketListDotNet(AReadList).Sockets,
        TIdSocketListDotNet(AWriteList).Sockets,
        TIdSocketListDotNet(AExceptList).Sockets,ATimeout*1000);
    end;
    result:=
      (TIdSocketListDotNet(AReadList).Sockets.Count>0) or
      (TIdSocketListDotNet(AWriteList).Sockets.Count>0) or
      (TIdSocketListDotNet(AExceptList).Sockets.Count>0);
  except
    on e:ArgumentNullException do begin
      result:=false;
    end;
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdSocketListDotNet.Clone: TIdSocketList;
begin
  Result:=TIdSocketListDotNet.Create; //BGO: TODO: make prettier
  TIdSocketListDotNet(Result).Sockets.Free;
  TIdSocketListDotNet(Result).Sockets:=ArrayList(Sockets.Clone);
end;

function TIdStackDotNet.HostToNetwork(AHostLong: LongWord): LongWord;
begin
  Result := LongWord(IPAddress.HostToNetworkOrder(integer(AHostLong)));
end;

function TIdStackDotNet.HostToNetwork(AHostShort: Word): Word;
begin
  Result := Word(IPAddress.HostToNetworkOrder(ShortInt(AHostShort)));
end;

function TIdStackDotNet.NetworkToHost(ANetLong: LongWord): LongWord;
begin
  Result := LongWord(IPAddress.NetworkToHostOrder(integer(ANetLong)));
end;

function TIdStackDotNet.NetworkToHost(ANetShort: Word): Word;
begin
  Result := Word(IPAddress.NetworkToHostOrder(ShortInt(ANetShort)));
end;

procedure TIdStackDotNet.SetSocketOption(ASocket: TIdStackSocketHandle; 
  ALevel:TIdSocketOptionLevel; AOptName: TIdSocketOption; AOptVal: Integer);
begin
  ASocket.SetSocketOption(ALevel, AOptName, AOptVal);
end;



initialization
  GSocketListClass := TIdSocketListDotNet;
end.
