idstackwindows.pas

Indy控件的使用源代码

{ $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:  10349: IdStackWindows.pas 
{
    Rev 1.3    5/19/2003 5:58:06 PM  BGooijen
  TIdStackWindows.WSGetHostByAddr raised an ERangeError when the last number in
  the ip>127
}
{
    Rev 1.2    4/25/2003 7:01:18 PM  BGooijen
  changed TIdStackWindows.TInAddrToString back
}
{
{   Rev 1.1    4/20/03 1:51:46 PM  RLebeau
{ Updated TInAddrToString() to use inet_ntoa() instead of parsing the values
{ manually.
{ 
{ Updated TranslateStringToTInAddr() to use new TIdSTack::GetIPInfo() method.
}
{
{   Rev 1.0    2002.11.12 10:53:40 PM  czhower
}
unit IdStackWindows;

interface

uses
  Classes,
  IdStack, IdStackConsts, IdWinsock2, Windows;

type
  TIdSocketListWindows = class (TIdSocketList)
  protected
    FFDSet: TFDSet;
    //
    function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  public
    procedure Add(AHandle: TIdStackSocketHandle); override;
    procedure Remove(AHandle: TIdStackSocketHandle); override;
    function  Count: Integer; override;
  End;//TIdSocketList


  TIdStackWindows = class(TIdStack)
  protected
    procedure PopulateLocalAddresses; override;
    function WSGetLocalAddress: string; override;
    function WSGetLocalAddresses: TStrings; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    function TInAddrToString(var AInAddr): string; override;
    procedure TranslateStringToTInAddr(AIP: string; var AInAddr); override;
    //
    function WSAccept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: Integer)
     : TIdStackSocketHandle; override;
    function WSBind(ASocket: TIdStackSocketHandle; const AFamily: Integer;
     const AIP: string; const APort: Integer): Integer; override;
    function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override;
    function WSConnect(const ASocket: TIdStackSocketHandle; const AFamily: Integer;
     const AIP: string; const APort: Integer): Integer; override;
    function WSGetHostByAddr(const AAddress: string): string; override;
    function WSGetHostByName(const AHostName: string): string; override;
    function WSGetHostName: string; override;
    function WSGetServByName(const AServiceName: string): Integer; override;
    function WSGetServByPort(const APortNumber: Integer): TStrings; override;
    procedure WSGetPeerName(ASocket: TIdStackSocketHandle; var VFamily: Integer;
     var VIP: string; var VPort: Integer); override;
    procedure WSGetSockName(ASocket: TIdStackSocketHandle; var VFamily: Integer;
     var VIP: string; var VPort: Integer); override;
    function WSHToNs(AHostShort: Word): Word; override;
    function WSListen(ASocket: TIdStackSocketHandle; ABackLog: Integer): Integer; override;
    function WSNToHs(ANetShort: Word): Word; override;
    function WSHToNL(AHostLong: LongWord): LongWord; override;
    function WSNToHL(ANetLong: LongWord): LongWord; override;
    function WSRecv(ASocket: TIdStackSocketHandle; var ABuffer; const ABufferLength, AFlags: Integer)
     : integer; override;
    function WSRecvFrom(const ASocket: TIdStackSocketHandle; var ABuffer;
     const ALength, AFlags: Integer; var VIP: string; var VPort: Integer): Integer; override;
    function WSSelect(ARead, AWrite, AErrors: TList; ATimeout: Integer): Integer; override;
    function WSSend(ASocket: TIdStackSocketHandle; var ABuffer;
     const ABufferLength, AFlags: Integer): Integer; override;
    function WSSendTo(ASocket: TIdStackSocketHandle; var ABuffer;
     const ABufferLength, AFlags: Integer; const AIP: string; const APort: integer): Integer;
     override;
    function WSSetSockOpt(ASocket: TIdStackSocketHandle; ALevel, AOptName: Integer; AOptVal: PChar;
     AOptLen: Integer): Integer; override;
    function WSSocket(AFamily, AStruct, AProtocol: Integer): TIdStackSocketHandle; override;
    function WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; override;
    function WSTranslateSocketErrorMsg(const AErr: integer): string; override;
    function WSGetLastError: Integer; override;
    function WSGetSockOpt(ASocket: TIdStackSocketHandle; Alevel, AOptname: Integer; AOptval: PChar; var AOptlen: Integer): Integer; override;
  end;

  TLinger = record
	  l_onoff: Word;
	  l_linger: Word;
  end;

  TIdLinger = TLinger;

implementation

uses
  IdException,
  IdGlobal, IdResourceStrings,
  SysUtils;

var
  GStarted: Boolean = False;

constructor TIdStackWindows.Create;
var
  sData: TWSAData;
begin
  inherited Create;
  if not GStarted then
  begin
    if WSAStartup($202, sData) = SOCKET_ERROR then begin
      raise  EIdStackInitializationFailed.Create(RSWinsockInitializationError);
    end;
    GStarted := True;
  end;
end;

destructor TIdStackWindows.Destroy;
begin
  //DLL Unloading and Cleanup is done at finalization
  inherited Destroy;
end;

//function TIdStackWindows.TInAddrToString(AInAddr: TInAddr): string;
function TIdStackWindows.TInAddrToString(var AInAddr): string;
begin
  with TInAddr(AInAddr).S_un_b do begin
    result := IntToStr(s_b1) + '.' + IntToStr(s_b2) + '.' + IntToStr(s_b3) + '.'    {Do not Localize}
     + IntToStr(s_b4);
  end;
  
// RL: 4/13/2003
//  Result := inet_ntoa(TInAddr(AInAddr)); //BGO: Causes socket error 0
end;

function TIdStackWindows.WSAccept(ASocket: TIdStackSocketHandle;
  var VIP: string; var VPort: Integer): TIdStackSocketHandle;
var
  i: Integer;
  Addr: TSockAddr;
begin
  i := SizeOf(addr);
  result := Accept(ASocket, @addr, @i);
  VIP := TInAddrToString(Addr.sin_addr);
  VPort := NToHs(Addr.sin_port);
end;

function TIdStackWindows.WSBind(ASocket: TIdStackSocketHandle;
  const AFamily: Integer; const AIP: string;
  const APort: Integer): Integer;
var
  Addr: TSockAddrIn;
begin
  Addr.sin_family := AFamily;
  if length(AIP) = 0 then begin
    Addr.sin_addr.s_addr := INADDR_ANY;
  end else begin
    Addr.sin_addr := TInAddr(StringToTInAddr(AIP));
  end;
  Addr.sin_port := HToNS(APort);
  result := Bind(ASocket, @addr, SizeOf(Addr));
end;

function TIdStackWindows.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
begin
  result := CloseSocket(ASocket);
end;

function TIdStackWindows.WSConnect(const ASocket: TIdStackSocketHandle;
  const AFamily: Integer; const AIP: string;
  const APort: Integer): Integer;
var
  Addr: TSockAddrIn;
begin
  Addr.sin_family := AFamily;
  Addr.sin_addr := TInAddr(StringToTInAddr(AIP));
  Addr.sin_port := HToNS(APort);
  result := Connect(ASocket, @Addr, SizeOf(Addr));
end;

function TIdStackWindows.WSGetHostByName(const AHostName: string): string;
var
  pa: PChar;
  sa: TInAddr;
  Host: PHostEnt;
begin
  Host := GetHostByName(PChar(AHostName));
  if Host = nil then begin
    CheckForSocketError(SOCKET_ERROR);
  end else begin
    pa := Host^.h_address_list^;
    sa.S_un_b.s_b1 := Ord(pa[0]);
    sa.S_un_b.s_b2 := Ord(pa[1]);
    sa.S_un_b.s_b3 := Ord(pa[2]);
    sa.S_un_b.s_b4 := Ord(pa[3]);
    result := TInAddrToString(sa);
  end;
end;

function TIdStackWindows.WSGetHostByAddr(const AAddress: string): string;
var
  Host: PHostEnt;
  LAddr: u_long;
begin
  LAddr := inet_addr(PChar(AAddress));
  Host := GetHostByAddr(@LAddr, SizeOf(LAddr), AF_INET);
  if Host = nil then begin
    CheckForSocketError(SOCKET_ERROR);
  end else begin
    result := Host^.h_name;
  end;
end;

function TIdStackWindows.WSGetHostName: string;
begin
  SetLength(result, 250);
  GetHostName(PChar(result), Length(result));
  Result := String(PChar(result));
end;

function TIdStackWindows.WSListen(ASocket: TIdStackSocketHandle;
  ABackLog: Integer): Integer;
begin
  result := Listen(ASocket, ABacklog);
end;

function TIdStackWindows.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  const ABufferLength, AFlags: Integer) : Integer;
begin
  result := Recv(ASocket, ABuffer, ABufferLength, AFlags);
end;

function TIdStackWindows.WSRecvFrom(const ASocket: TIdStackSocketHandle;
  var ABuffer; const ALength, AFlags: Integer; var VIP: string;
  var VPort: Integer): Integer;
var
  iSize: integer;
  Addr: TSockAddrIn;
begin
  iSize := SizeOf(Addr);
  result := RecvFrom(ASocket, ABuffer, ALength, AFlags, @Addr, @iSize);
  VIP := TInAddrToString(Addr.sin_addr);
  VPort := NToHs(Addr.sin_port);
end;

function TIdStackWindows.WSSelect(ARead, AWrite, AErrors: TList; ATimeout: Integer): Integer;
var
  tmTo: TTimeVal;
  FDRead, FDWrite, FDError: TFDSet;

  procedure GetFDSet(AList: TList; var ASet: TFDSet);
  var
    i: Integer;
  begin
    if assigned( AList ) then begin
      AList.Clear; // SG 18/10/00: ALWAYS clear the result list
      AList.Capacity := ASet.fd_count;
      for i := 0 to ASet.fd_count - 1 do begin
        AList.Add(TObject(ASet.fd_array[i]));
      end;
    end;
  end;

  procedure SetFDSet(AList: TList; var ASet: TFDSet);
  var
    i: integer;
  begin
    if AList <> nil then begin
      if AList.Count > FD_SETSIZE then begin
        raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
      end;
      for i := 0 to AList.Count - 1 do begin
        ASet.fd_array[i] := TIdStackSocketHandle(AList[i]);
      end;
      ASet.fd_count := AList.Count;
    end;
  end;