idstackdotnet.pas

网络控件适用于Delphi6

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
    if ASocket.Connected or (VIP<>'') then begin
      LEndPoint := ASocket.localEndPoint;
      VIP := (LEndPoint as IPEndPoint).Address.ToString;
      VPort := (LEndPoint as IPEndPoint).Port;
    end;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.HostByName(const AHostName: string;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
var
  LIP:array of IPAddress;
  a:integer;
begin
  try
    LIP := Dns.Resolve(AHostName).AddressList;
    for a:=low(LIP) to high(LIP) do begin
      if LIP[a].AddressFamily=IdIPFamily[AIPVersion] then begin
        result := LIP[a].toString;
        exit;
      end;
    end;
    raise System.Net.Sockets.SocketException.Create(11001);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.HostByAddress(const AAddress: string;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
begin
  try
    result := Dns.GetHostByAddress(AAddress).HostName;
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;


function TIdStackDotNet.NewSocketHandle(const ASocketType:TIdSocketType;
  const AProtocol: TIdSocketProtocol; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION; const AOverlapped: Boolean = false): TIdStackSocketHandle;
begin
  try
    case AIPVersion of
      Id_IPv4: result := Socket.Create(AddressFamily.InterNetwork, ASocketType, AProtocol);
      Id_IPv6: result := Socket.Create(AddressFamily.InterNetworkV6, ASocketType, AProtocol);
      else
        raise EIdException.Create('Invalid socket type'); {do not localize}
    end;
  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; var VBuffer: TIdBytes): Integer;
begin
  try
    result := ASocket.Receive(VBuffer,length(VBuffer),SocketFlags.None);
  except
    on e:exception do begin
      raise BuildException(e);
    end;
  end;
end;

function TIdStackDotNet.Send(
  ASocket: TIdStackSocketHandle;
  const ABuffer: TIdBytes;
  AOffset: Integer = 0;
  ASize: Integer = -1
  ): Integer;
begin
  if ASize = -1 then begin
    ASize := Length(ABuffer) - AOffset;
  end;
  try
    Result := ASocket.Send(ABuffer, AOffset, ASize, SocketFlags.None);
  except
    on E: Exception do begin
      raise BuildException(E);
    end;
  end;
end;

function TIdStackDotNet.ReceiveFrom(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
             var VIP: string; var VPort: Integer;
             const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer;
var
  LEndPoint : EndPoint;
begin
  Result := 0; // to make the compiler happy
  LEndPoint := IPEndPoint.Create(IPAddress.Any, 0);
  try
    try
      Result := ASocket.ReceiveFrom(VBuffer,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;
             const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION
             ): 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(AValue: Word): Word;
begin
  Result := Word(IPAddress.HostToNetworkOrder(ShortInt(AValue)));
end;

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

function TIdStackDotNet.HostToNetwork(AValue: Int64): Int64;
begin
  Result := IPAddress.HostToNetworkOrder(AValue);
end;

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

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

function TIdStackDotNet.NetworkToHost(AValue: Int64): Int64;
begin
  Result := IPAddress.NetworkToHostOrder(AValue);
end;

procedure TIdStackDotNet.GetSocketOption(ASocket: TIdStackSocketHandle;
  ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  out AOptVal: Integer);
var L : System.Object;
begin
  L := ASocket.GetSocketOption(ALevel,AoptName);
  AOptVal := Integer(L);
end;

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

function TIdStackDotNet.SupportsIPv6:boolean;
begin
  result := Socket.SupportsIPv6;
end;

function TIdStackDotNet.GetLocalAddresses: TIdStrings;
begin
  if FLocalAddresses = nil then
  begin
    FLocalAddresses := TIdStringList.Create;
  end;
  PopulateLocalAddresses;
  Result := FLocalAddresses;

end;

procedure TIdStackDotNet.PopulateLocalAddresses;
var LAddr : IPAddress;
  LHost : IPHostEntry;
  i : Integer;
begin
 FLocalAddresses.Clear;
  LAddr := IPAddress.Any;
  LHost := DNS.GetHostByAddress(LAddr);
  if Length(LHost.AddressList)>0 then
  begin
    for i := Low(LHost.AddressList) to High(LHost.AddressList) do
    begin
      FLocalAddresses.Add(LHost.AddressList[i].ToString);
    end;
  end;
end;

function TIdStackDotNet.GetLocalAddress: string;
begin
  Result := LocalAddresses[0];
end;



initialization
  GSocketListClass := TIdSocketListDotNet;
end.