Indy/Lib/System/IdWship6.pas

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.0    2004.02.03 3:14:52 PM  czhower
  Move and updates

  Rev 1.2    10/15/2003 9:43:20 PM  DSiders
  Added localization comments.

  Rev 1.1    1-10-2003 19:44:28  BGooijen
  fixed leak in CloseLibrary()

  Rev 1.0    11/13/2002 09:03:24 AM  JPMugaas
}

unit IdWship6;

interface

{$I IdCompilerDefines.inc}

{$IFDEF FPC}
  {$IFDEF WIN32}
    {$ALIGN OFF}
  {$ELSE}
    //It turns out that Win64 and WinCE require record alignment
    {$PACKRECORDS C}
  {$ENDIF}
{$ELSE}
  {$IFDEF WIN64}
    {$ALIGN ON}
    {$MINENUMSIZE 4}
  {$ELSE}
    {$MINENUMSIZE 4}
    {$IFDEF REQUIRES_PROPER_ALIGNMENT}
      {$ALIGN ON}
    {$ELSE}
      {$ALIGN OFF}
      {$WRITEABLECONST OFF}
    {$ENDIF}
  {$ENDIF}
{$ENDIF}

uses
  {$IFDEF HAS_TInterlocked}
  syncobjs, //here to facilitate inlining with Delphi
  {$ENDIF}
  IdGlobal,
  Windows,
  IdWinsock2;

const
  Wship6_dll =   'Wship6.dll';    {do not localize}
  iphlpapi_dll = 'iphlpapi.dll';  {do not localize}
  fwpuclnt_dll = 'Fwpuclnt.dll'; {Do not localize}

  // Error codes from getaddrinfo().

  //JPM
  //Note that I am adding a GIA_ prefix on my own because
  //some names here share some names defined in IdWinsock2 causing
  //an unpredictible problem. The values are not defined the same in IdWinsock2
  {$EXTERNALSYM GIA_EAI_ADDRFAMILY}
  GIA_EAI_ADDRFAMILY = 1  ; // Address family for nodename not supported.
  {$EXTERNALSYM GIA_EAI_AGAIN}
  GIA_EAI_AGAIN      = 2  ; // Temporary failure in name resolution.
  {$EXTERNALSYM GIA_EAI_BADFLAGS}
  GIA_EAI_BADFLAGS   = 3  ; // Invalid value for ai_flags.
  {$EXTERNALSYM GIA_EAI_FAIL}
  GIA_EAI_FAIL       = 4  ; // Non-recoverable failure in name resolution.
  {$EXTERNALSYM GIA_EAI_FAMILY}
  GIA_EAI_FAMILY     = 5  ; // Address family ai_family not supported.
  {$EXTERNALSYM GIA_EAI_MEMORY}
  GIA_EAI_MEMORY     = 6  ; // Memory allocation failure.
  {$EXTERNALSYM GIA_EAI_NODATA}
  GIA_EAI_NODATA     = 7  ; // No address associated with nodename.
  {$EXTERNALSYM GIA_EAI_NONAME}
  GIA_EAI_NONAME     = 8  ; // Nodename nor servname provided, or not known.
  {$EXTERNALSYM GIA_EAI_SERVICE}
  GIA_EAI_SERVICE    = 9  ; // Servname not supported for ai_socktype.
  {$EXTERNALSYM GIA_EAI_SOCKTYPE}
  GIA_EAI_SOCKTYPE   = 10 ; // Socket type ai_socktype not supported.
  {$EXTERNALSYM GIA_EAI_SYSTEM}
  GIA_EAI_SYSTEM     = 11 ; // System error returned in errno.

  {$EXTERNALSYM NI_MAXHOST}
  NI_MAXHOST  = 1025;      // Max size of a fully-qualified domain name.
  {$EXTERNALSYM NI_MAXSERV}
  NI_MAXSERV  =   32;      // Max size of a service name.

  // Flags for getnameinfo().

  {$EXTERNALSYM NI_NOFQDN}
  NI_NOFQDN       =   $1  ;  // Only return nodename portion for local hosts.
  {$EXTERNALSYM NI_NUMERICHOST}
  NI_NUMERICHOST  =   $2  ;  // Return numeric form of the host's address.
  {$EXTERNALSYM NI_NAMEREQD}
  NI_NAMEREQD     =   $4  ;  // Error if the host's name not in DNS.
  {$EXTERNALSYM NI_NUMERICSERV}
  NI_NUMERICSERV  =   $8  ;  // Return numeric form of the service (port #).
  {$EXTERNALSYM NI_DGRAM}
  NI_DGRAM        =   $10 ;  // Service is a datagram service.

  //JPM - These may not be supported in WinCE 4.2
  {$EXTERNALSYM PROTECTION_LEVEL_RESTRICTED}
  PROTECTION_LEVEL_RESTRICTED   = 30;  //* for Intranet apps      /*
  {$EXTERNALSYM PROTECTION_LEVEL_DEFAULT}
  PROTECTION_LEVEL_DEFAULT      = 20;  //* default level          /*
  {$EXTERNALSYM PROTECTION_LEVEL_UNRESTRICTED}
  PROTECTION_LEVEL_UNRESTRICTED = 10;  //* for peer-to-peer apps  /*

  {$EXTERNALSYM SOCKET_SETTINGS_GUARANTEE_ENCRYPTION}
  SOCKET_SETTINGS_GUARANTEE_ENCRYPTION = $00000001;
  {$EXTERNALSYM SOCKET_SETTINGS_ALLOW_INSECURE}
  SOCKET_SETTINGS_ALLOW_INSECURE = $00000002;
  
  {$EXTERNALSYM SOCKET_INFO_CONNECTION_SECURED}
  SOCKET_INFO_CONNECTION_SECURED =  $00000001;
  {$EXTERNALSYM SOCKET_INFO_CONNECTION_ENCRYPTED}
  SOCKET_INFO_CONNECTION_ENCRYPTED = $00000002;

type
  // RLebeau: find a better place for this
  {$IFNDEF HAS_UInt64}
  {$EXTERNALSYM UINT64}
  UINT64 = {$IFDEF HAS_QWord}QWord{$ELSE}Int64{$ENDIF};
  {$ENDIF}

  {$NODEFINE PPaddrinfo}
  PPaddrinfo = ^PAddrInfo;
  {$NODEFINE PPaddrinfoW}
  PPaddrinfoW = ^PAddrInfoW;

  {$IFNDEF WINCE}
  {$EXTERNALSYM SOCKET_SECURITY_PROTOCOL}
  {$EXTERNALSYM SOCKET_SECURITY_PROTOCOL_DEFAULT}
  {$EXTERNALSYM SOCKET_SECURITY_PROTOCOL_IPSEC}
  {$EXTERNALSYM SOCKET_SECURITY_PROTOCOL_INVALID}
  SOCKET_SECURITY_PROTOCOL = (
    SOCKET_SECURITY_PROTOCOL_DEFAULT, SOCKET_SECURITY_PROTOCOL_IPSEC, SOCKET_SECURITY_PROTOCOL_INVALID
    );

  {$EXTERNALSYM SOCKET_SECURITY_SETTINGS_IPSEC}
  SOCKET_SECURITY_SETTINGS_IPSEC = record
    SecurityProtocol : SOCKET_SECURITY_PROTOCOL;
    SecurityFlags : ULONG;
    IpsecFlags : ULONG;
    AuthipMMPolicyKey : TGUID;
    AuthipQMPolicyKey : TGUID;
    Reserved : TGUID;
    Reserved2 : UINT64;
    UserNameStringLen : ULONG;
    DomainNameStringLen : ULONG;
    PasswordStringLen : ULONG;
  //  wchar_t AllStrings[0];
  end;
  {$EXTERNALSYM PSOCKET_SECURITY_SETTINGS_IPSEC}
  PSOCKET_SECURITY_SETTINGS_IPSEC = ^SOCKET_SECURITY_SETTINGS_IPSEC;
  {$EXTERNALSYM SOCKET_SECURITY_SETTINGS}
  SOCKET_SECURITY_SETTINGS = record
    SecurityProtocol : SOCKET_SECURITY_PROTOCOL;
    SecurityFlags : ULONG;
  end;
  {$EXTERNALSYM PSOCKET_SECURITY_SETTINGS}
  PSOCKET_SECURITY_SETTINGS = ^SOCKET_SECURITY_SETTINGS;
  {$EXTERNALSYM SOCKET_PEER_TARGET_NAME}
  SOCKET_PEER_TARGET_NAME = record
    SecurityProtocol : SOCKET_SECURITY_PROTOCOL;
    PeerAddress : SOCKADDR_STORAGE;
    PeerTargetNameStringLen : ULONG;
    //wchar_t AllStrings[0];
  end;
  {$EXTERNALSYM PSOCKET_PEER_TARGET_NAME}
  PSOCKET_PEER_TARGET_NAME = ^SOCKET_PEER_TARGET_NAME;

  {$EXTERNALSYM SOCKET_SECURITY_QUERY_INFO}
  SOCKET_SECURITY_QUERY_INFO = record
     SecurityProtocol : SOCKET_SECURITY_PROTOCOL;
     Flags : ULONG;
     PeerApplicationAccessTokenHandle : UINT64;
     PeerMachineAccessTokenHandle : UINT64;
  end;
  {$EXTERNALSYM PSOCKET_SECURITY_QUERY_INFO}
  PSOCKET_SECURITY_QUERY_INFO = ^SOCKET_SECURITY_QUERY_INFO;
  {$EXTERNALSYM SOCKET_SECURITY_QUERY_TEMPLATE}
  SOCKET_SECURITY_QUERY_TEMPLATE = record
    SecurityProtocol : SOCKET_SECURITY_PROTOCOL;
    PeerAddress : SOCKADDR_STORAGE;
    PeerTokenAccessMask : ULONG;
  end;
  {$EXTERNALSYM PSOCKET_SECURITY_QUERY_TEMPLATE}
  PSOCKET_SECURITY_QUERY_TEMPLATE = ^SOCKET_SECURITY_QUERY_TEMPLATE;

//callback defs
type
  {$EXTERNALSYM LPLOOKUPSERVICE_COMPLETION_ROUTINE}
  LPLOOKUPSERVICE_COMPLETION_ROUTINE = procedure (const dwError, dwBytes : DWORD; lpOverlapped : LPWSAOVERLAPPED); stdcall;
{$ENDIF}

type
  {$EXTERNALSYM LPFN_GETADDRINFO}
  LPFN_GETADDRINFO = function(NodeName: PIdAnsiChar; ServiceName: PIdAnsiChar; Hints: Paddrinfo; ppResult: PPaddrinfo): Integer; stdcall;
  {$EXTERNALSYM LPFN_GETADDRINFOW}
  LPFN_GETADDRINFOW = function(NodeName: PWideChar; ServiceName: PWideChar; Hints: PaddrinfoW; ppResult: PPaddrinfoW): Integer; stdcall;
  {$EXTERNALSYM LPFN_GETNAMEINFO}
  //The IPv6 preview for Win2K defines hostlen and servelen as size_t but do not use them
  //for these definitions as the newer SDK's define those as DWORD.
  LPFN_GETNAMEINFO = function(sa: psockaddr; salen: u_int; host: PIdAnsiChar; hostlen: u_int; serv: PIdAnsiChar; servlen: u_int; flags: Integer): Integer; stdcall;
  {$EXTERNALSYM LPFN_GETNAMEINFOW}
  LPFN_GETNAMEINFOW = function(sa: psockaddr; salen: u_int; host: PWideChar; hostlen: u_int; serv: PWideChar; servlen: u_int; flags: Integer): Integer; stdcall;
  {$EXTERNALSYM LPFN_FREEADDRINFO}
  LPFN_FREEADDRINFO = procedure(ai: Paddrinfo); stdcall;
  {$EXTERNALSYM LPFN_FREEADDRINFOW}
  LPFN_FREEADDRINFOW = procedure(ai: PaddrinfoW); stdcall;

//function GetAdaptersAddresses( Family:ULONG; Flags:ULONG; Reserved:Pointer; pAdapterAddresses: PIP_ADAPTER_ADDRESSES; pOutBufLen:PULONG):ULONG;stdcall;  external iphlpapi_dll;

{ the following are not used, nor tested}
{function getipnodebyaddr(const src:pointer;  len:integer; af:integer;var error_num:integer) :phostent;stdcall; external Wship6_dll;
procedure freehostent(ptr:phostent);stdcall; external Wship6_dll;
function inet_pton(af:integer; const src:pchar; dst:pointer):integer;stdcall; external Wship6_dll;
function inet_ntop(af:integer; const src:pointer; dst:pchar;size:integer):pchar;stdcall; external Wship6_dll;
}
 {$IFNDEF WINCE}
  {$EXTERNALSYM LPFN_INET_PTON}
  LPFN_INET_PTON = function (af: Integer; const src: PIdAnsiChar; dst: Pointer): Integer; stdcall;
  {$EXTERNALSYM LPFN_INET_PTONW}
  LPFN_INET_PTONW = function (af: Integer; const src: PWideChar; dst: Pointer): Integer; stdcall;
  {$EXTERNALSYM LPFN_INET_NTOP}
  LPFN_INET_NTOP = function (af: Integer; const src: Pointer; dst: PIdAnsiChar; size: size_t): PIdAnsiChar; stdcall;
  {$EXTERNALSYM LPFN_INET_NTOPW}
  LPFN_INET_NTOPW = function (af: Integer; const src: Pointer; dst: PWideChar; size: size_t): PIdAnsiChar; stdcall;

{ end the following are not used, nor tested}
//These are provided in case we need them later
//Windows Vista
  {$EXTERNALSYM LPFN_GETADDRINFOEXA}
  LPFN_GETADDRINFOEXA = function(pName : PIdAnsiChar; pServiceName : PIdAnsiChar;
    const dwNameSpace: DWord; lpNspId : LPGUID; hints : PADDRINFOEXA;
    var ppResult : PADDRINFOEXA; timeout : Ptimeval; lpOverlapped : LPWSAOVERLAPPED;
    lpCompletionRoutine : LPLOOKUPSERVICE_COMPLETION_ROUTINE;
    lpNameHandle : PHandle) : Integer; stdcall;
  {$EXTERNALSYM LPFN_GETADDRINFOEXW}
  LPFN_GETADDRINFOEXW = function(pName : PWideChar; pServiceName : PWideChar;
    const dwNameSpace: DWord; lpNspId : LPGUID;hints : PADDRINFOEXW;
    var ppResult : PADDRINFOEXW; timeout : Ptimeval; lpOverlapped : LPWSAOVERLAPPED;
    lpCompletionRoutine : LPLOOKUPSERVICE_COMPLETION_ROUTINE;
    lpNameHandle : PHandle) : Integer; stdcall;
  {$EXTERNALSYM LPFN_SETADDRINFOEXA}
  LPFN_SETADDRINFOEXA= function(pName : PIdAnsiChar; pServiceName : PIdAnsiChar;
    pAddresses : PSOCKET_ADDRESS; const dwAddressCount : DWord; lpBlob : LPBLOB;
    const dwFlags : DWord; const dwNameSpace : DWord; lpNspId : LPGUID;
    timeout : Ptimeval;
    lpOverlapped : LPWSAOVERLAPPED;
    lpCompletionRoutine : LPLOOKUPSERVICE_COMPLETION_ROUTINE; lpNameHandle : PHandle) : Integer; stdcall;
  {$EXTERNALSYM LPFN_SETADDRINFOEXW}
  LPFN_SETADDRINFOEXW= function(pName : PWideChar; pServiceName : PWideChar;
    pAddresses : PSOCKET_ADDRESS; const dwAddressCount : DWord; lpBlob : LPBLOB;
    const dwFlags : DWord; const dwNameSpace : DWord; lpNspId : LPGUID;
    timeout : Ptimeval;
    lpOverlapped : LPWSAOVERLAPPED;
    lpCompletionRoutine : LPLOOKUPSERVICE_COMPLETION_ROUTINE; lpNameHandle : PHandle) : Integer; stdcall;

  {$EXTERNALSYM LPFN_FREEADDRINFOEX}
  LPFN_FREEADDRINFOEX = procedure(pAddrInfoEx : PADDRINFOEXA) ; stdcall;
  {$EXTERNALSYM LPFN_FREEADDRINFOEXW}
  LPFN_FREEADDRINFOEXW = procedure(pAddrInfoEx : PADDRINFOEXW) ; stdcall;

  {$EXTERNALSYM LPFN_GETADDRINFOEX}
  {$EXTERNALSYM LPFN_SETADDRINFOEX}
  {$IFDEF UNICODE}
  LPFN_GETADDRINFOEX = LPFN_GETADDRINFOEXW;
  LPFN_SETADDRINFOEX = LPFN_SETADDRINFOEXW;
  {$ELSE}
  LPFN_GETADDRINFOEX = LPFN_GETADDRINFOEXA;
  LPFN_SETADDRINFOEX = LPFN_SETADDRINFOEXA;
  {$ENDIF}

  //  Fwpuclnt.dll - API
  {$EXTERNALSYM LPFN_WSASetSocketSecurity}
  LPFN_WSASetSocketSecurity = function (socket : TSocket;
    SecuritySettings : PSOCKET_SECURITY_SETTINGS; const SecuritySettingsLen : ULONG;
    OVERLAPPED : LPWSAOVERLAPPED; CompletionRoutine : LPWSAOVERLAPPED_COMPLETION_ROUTINE) : Integer; stdcall;
  {$EXTERNALSYM LPFN_WSADELETESOCKETPEERTARGETNAME}
  LPFN_WSADELETESOCKETPEERTARGETNAME = function (Socket : TSocket;
    PeerAddr : Psockaddr; PeerAddrLen : ULONG;
    Overlapped : LPWSAOVERLAPPED;  CompletionRoutine : LPWSAOVERLAPPED_COMPLETION_ROUTINE): Integer; stdcall;
  {$EXTERNALSYM LPFN_WSASETSOCKETPEERTARGETNAME}
  LPFN_WSASETSOCKETPEERTARGETNAME = function (Socket : TSocket;
    PeerTargetName : PSOCKET_PEER_TARGET_NAME; PeerTargetNameLen : ULONG;
    Overlapped : LPWSAOVERLAPPED; CompletionRoutine : LPWSAOVERLAPPED_COMPLETION_ROUTINE) : Integer; stdcall;
  {$EXTERNALSYM LPFN_WSAIMPERSONATESOCKETPEER}
  LPFN_WSAIMPERSONATESOCKETPEER = function (Socket : TSocket;
    PeerAddress : Psockaddr;  peerAddressLen :  ULONG) : Integer; stdcall;
  {$EXTERNALSYM LPFN_WSAQUERYSOCKETSECURITY}
  LPFN_WSAQUERYSOCKETSECURITY = function (Socket : TSocket;
    SecurityQueryTemplate : PSOCKET_SECURITY_QUERY_TEMPLATE; const SecurityQueryTemplateLen : ULONG;
    SecurityQueryInfo : PSOCKET_SECURITY_QUERY_INFO; var SecurityQueryInfoLen : ULONG;
     Overlapped : LPWSAOVERLAPPED;  CompletionRoutine : LPWSAOVERLAPPED_COMPLETION_ROUTINE) : Integer; stdcall;
  {$EXTERNALSYM LPFN_WSAREVERTIMPERSONATION}
  LPFN_WSAREVERTIMPERSONATION = function : Integer; stdcall;
{$ENDIF}

const
  {$NODEFINE fn_GetAddrInfo}
  {$NODEFINE fn_getnameinfo}
  {$NODEFINE fn_freeaddrinfo}
  {$IFNDEF WINCE}
  {$NODEFINE fn_GetAddrInfoEx}
  {$NODEFINE fn_SetAddrInfoEx}
  {$NODEFINE fn_FreeAddrInfoEx}
  {$NODEFINE fn_inet_pton}
  {$NODEFINE fn_inet_ntop}
  {$ENDIF}
  {$IFDEF UNICODE}
  // WinCE does not support GetAddrInfoW(), GetNameInfoW(), or FreeAddrInfoW().
  // To support IPv6 on WinCE when UNICODE is defined, we will use our own
  // wrappers that internally call WinCE's functions...
  fn_GetAddrInfo = {$IFDEF WINCE}'getaddrinfo'{$ELSE}'GetAddrInfoW'{$ENDIF};
  fn_getnameinfo = {$IFDEF WINCE}'getnameinfo'{$ELSE}'GetNameInfoW'{$ENDIF};
  fn_freeaddrinfo = {$IFDEF WINCE}'freeaddrinfo'{$ELSE}'FreeAddrInfoW'{$ENDIF};
    {$IFNDEF WINCE}
  fn_GetAddrInfoEx = 'GetAddrInfoExW';
  fn_SetAddrInfoEx = 'SetAddrInfoExW';
  fn_FreeAddrInfoEx = 'FreeAddrInfoExW';
  fn_inet_pton = 'InetPtonW';
  fn_inet_ntop = 'InetNtopW';
    {$ENDIF}
  {$ELSE}
  fn_GetAddrInfo = 'getaddrinfo';
  fn_getnameinfo = 'getnameinfo';
  fn_freeaddrinfo = 'freeaddrinfo';
    {$IFNDEF WINCE}
  fn_GetAddrInfoEx = 'GetAddrInfoExA';
  fn_SetAddrInfoEx = 'SetAddrInfoExA';
  fn_FreeAddrInfoEx = 'FreeAddrInfoEx';
  fn_inet_pton = 'inet_pton';
  fn_inet_ntop = 'inet_ntop';
    {$ENDIF}
  {$ENDIF}

{$UNDEF WINCE_UNICODE}
{$IFDEF WINCE}
  {$IFDEF UNICODE}
    {$DEFINE WINCE_UNICODE}
  {$ENDIF}
{$ENDIF}

var
  {$EXTERNALSYM getaddrinfo}
  {$EXTERNALSYM getnameinfo}
  {$EXTERNALSYM freeaddrinfo}
  {$IFNDEF WINCE}
  {$EXTERNALSYM inet_pton}
  {$EXTERNALSYM inet_ntop}
  {$ENDIF}
  {$IFDEF UNICODE}
    {$IFDEF WINCE}
  getaddrinfoCE: LPFN_GETADDRINFO = nil;
  getnameinfoCE: LPFN_GETNAMEINFO = nil;
  freeaddrinfoCE: LPFN_FREEADDRINFO = nil;
    {$ENDIF}
  getaddrinfo: LPFN_GETADDRINFOW = nil;
  getnameinfo: LPFN_GETNAMEINFOW = nil;
  freeaddrinfo: LPFN_FREEADDRINFOW = nil;
    {$IFNDEF WINCE}
  //These are here for completeness
  inet_pton : LPFN_inet_ptonW = nil;
  inet_ntop : LPFN_inet_ntopW = nil;
    {$ENDIF}
  {$ELSE}
  getaddrinfo: LPFN_GETADDRINFO = nil;
  getnameinfo: LPFN_GETNAMEINFO = nil;
  freeaddrinfo: LPFN_FREEADDRINFO = nil;
      {$IFNDEF WINCE}
  //These are here for completeness
  inet_pton : LPFN_inet_pton = nil;
  inet_ntop : LPFN_inet_ntop = nil;
    {$ENDIF}
  {$ENDIF}
  {$IFNDEF WINCE}
  {
  IMPORTANT!!!

  These are Windows Vista functions and there's no guarantee that you will have
  them so ALWAYS check the function pointer before calling them.
  }
  {$EXTERNALSYM GetAddrInfoEx}
  GetAddrInfoEx :  LPFN_GETADDRINFOEX = nil;
  {$EXTERNALSYM SetAddrInfoEx}
  SetAddrInfoEx : LPFN_SETADDRINFOEX = nil;
  {$EXTERNALSYM FreeAddrInfoEx}
  //You can't alias the LPFN for this because the ASCII version of this
  //does not end with an "a"
  {$IFDEF UNICODE}
  FreeAddrInfoEx : LPFN_FREEADDRINFOEXW = nil;
  {$ELSE}
  FreeAddrInfoEx : LPFN_FREEADDRINFOEX = nil;
  {$ENDIF}

  //Fwpuclnt.dll available for Windows Vista and later
  {$EXTERNALSYM WSASetSocketSecurity}
  WSASetSocketSecurity : LPFN_WSASetSocketSecurity = nil;
  {$EXTERNALSYM WSASETSOCKETPEERTARGETNAME}
  WSASetSocketPeerTargetName : LPFN_WSASETSOCKETPEERTARGETNAME = nil;
  {$EXTERNALSYM WSADELETESOCKETPEERTARGETNAME}
  WSADeleteSocketPeerTargetName : LPFN_WSADELETESOCKETPEERTARGETNAME = nil;
  {$EXTERNALSYM WSAImpersonateSocketPeer}
  WSAImpersonateSocketPeer : LPFN_WSAIMPERSONATESOCKETPEER = nil;
  {$EXTERNALSYM WSAQUERYSOCKETSECURITY}
  WSAQUERYSOCKETSECURITY : LPFN_WSAQUERYSOCKETSECURITY = nil;
  {$EXTERNALSYM WSAREVERTIMPERSONATION}
  WSARevertImpersonation : LPFN_WSAREVERTIMPERSONATION = nil;
  {$ENDIF}

var
  GIdIPv6FuncsAvailable: Boolean = False{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$ENDIF};

function gaiErrorToWsaError(const gaiError: Integer): Integer;

//We want to load this library only after loading Winsock and unload immediately
//before unloading Winsock.
procedure InitLibrary;
procedure CloseLibrary;

implementation

uses
  SysUtils;

var
  hWship6Dll : TIdLibHandle = IdNilHandle; // Wship6.dll handle
  //Use this instead of hWship6Dll because this will point to the correct lib.
  hProcHandle : TIdLibHandle = IdNilHandle;
  {$IFNDEF WINCE}
  hfwpuclntDll : TIdLibHandle = IdNilHandle;
  {$ENDIF}

function gaiErrorToWsaError(const gaiError: Integer): Integer;
begin
  case gaiError of
    GIA_EAI_ADDRFAMILY: Result := 0; // TODO: find a decent error for here
    GIA_EAI_AGAIN:      Result := WSATRY_AGAIN;
    GIA_EAI_BADFLAGS:   Result := WSAEINVAL;
    GIA_EAI_FAIL:       Result := WSANO_RECOVERY;
    GIA_EAI_FAMILY:     Result := WSAEAFNOSUPPORT;
    GIA_EAI_MEMORY:     Result := WSA_NOT_ENOUGH_MEMORY;
    GIA_EAI_NODATA:     Result := WSANO_DATA;
    GIA_EAI_NONAME:     Result := WSAHOST_NOT_FOUND;
    GIA_EAI_SERVICE:    Result := WSATYPE_NOT_FOUND;
    GIA_EAI_SOCKTYPE:   Result := WSAESOCKTNOSUPPORT;
    GIA_EAI_SYSTEM:
      begin
        Result := 0; // avoid warning
        IndyRaiseLastError;
      end;
    else
      Result := gaiError;
  end;
end;

procedure CloseLibrary;
var
  h : TIdLibHandle;
begin
  h := InterlockedExchangeTLibHandle(hWship6Dll, IdNilHandle);
  if h <> IdNilHandle then begin
    FreeLibrary(h);
  end;
  {$IFNDEF WINCE}
  h := InterlockedExchangeTLibHandle(hfwpuclntDll, IdNilHandle);
  if h <> IdNilHandle then begin
    FreeLibrary(h);
  end;
  {$ENDIF}

  {$I IdSymbolDeprecatedOff.inc}
  GIdIPv6FuncsAvailable := False;
  {$I IdSymbolDeprecatedOn.inc}

  {$IFDEF WINCE_UNICODE}
  getaddrinfoCE := nil;
  getnameinfoCE := nil;
  freeaddrinfoCE := nil;
  {$ENDIF}
  getaddrinfo := nil;
  getnameinfo := nil;
  freeaddrinfo := nil;
  {$IFNDEF WINCE}
  inet_pton := nil;
  inet_ntop := nil;
  GetAddrInfoEx := nil;
  SetAddrInfoEx := nil;
  FreeAddrInfoEx := nil;
  WSASetSocketPeerTargetName := nil;
  WSADeleteSocketPeerTargetName := nil;
  WSAImpersonateSocketPeer := nil;
  WSAQuerySocketSecurity := nil;
  WSARevertImpersonation := nil;
  {$ENDIF}
end;

{$IFDEF FPC} //{$IFDEF STRING_IS_ANSI}
  {$IFDEF UNICODE}

// FreePascal does not have PWideChar overloads of these functions

function StrComp(const Str1, Str2: PWideChar): Integer; overload;
var
  P1, P2: PWideChar;
begin
  P1 := Str1;
  P2 := Str2;
  while True do
  begin
    if (P1^ <> P2^) or (P1^ = #0) then
    begin
      Result := Ord(P1^) - Ord(P2^);
      Exit;
    end;
    Inc(P1);
    Inc(P2);
  end;
  Result := 0;
end;

function StrScan(const Str: PWideChar; Chr: WideChar): PWideChar; overload;
begin
  Result := Str;
  while Result^ <> #0 do
  begin
    if Result^ = Chr then begin
      Exit;
    end;
    Inc(Result);
  end;
  if Chr <> #0 then begin
    Result := nil;
  end;
end;

  {$ENDIF}
{$ENDIF}

// The IPv6 functions were added to the Ws2_32.dll on Windows XP and later.
// To execute an application that uses these functions on earlier versions of
// Windows, the functions are defined as inline functions in the Wspiapi.h file.
// At runtime, the functions are implemented in such a way that if the Ws2_32.dll
// or the Wship6.dll (the file containing the functions in the IPv6 Technology
// Preview for Windows 2000) does not include them, then versions are implemented
// inline based on code in the Wspiapi.h header file. This inline code will be
// used on older Windows platforms that do not natively support the functions.

// RLebeau: Wspiapi.h only defines Ansi versions of the legacy functions, but we
// need to handle Unicode as well...

function WspiapiMalloc(tSize: size_t): Pointer;
begin
  try
    GetMem(Result, tSize);
    ZeroMemory(Result, tSize);
  except
    Result := nil;
  end;
end;

procedure WspiapiFree(p: Pointer);
begin
  FreeMem(p);
end;

procedure WspiapiSwap(var a, b, c: PIdPlatformChar);
  {$IFDEF USE_INLINE}inline;{$ENDIF}
begin
  c := a;
  a := b;
  b := c;
end;

function WspiapiStrdup(const pszString: PIdPlatformChar): PIdPlatformChar; stdcall;
var
  pszMemory: PIdPlatformChar;
  cchMemory: size_t;
begin
  if pszString = nil then begin
    Result := nil;
    Exit;
  end;

  cchMemory := StrLen(pszString) + 1;
  pszMemory := PIdPlatformChar(WspiapiMalloc(cchMemory * SizeOf(TIdPlatformChar)));
  if pszMemory = nil then begin
    Result := nil;
    Exit;
  end;

  StrLCopy(pszMemory, pszString, cchMemory);
  Result := pszMemory;
end;

function WspiapiParseV4Address(const pszAddress: PIdPlatformChar; var pdwAddress: DWORD): BOOL; stdcall;
var
  dwAddress: DWORD;
  pcNext: PIdPlatformChar;
  iCount: Integer;
  {$IFDEF USE_MARSHALLED_PTRS}
  M: TMarshaller;
  {$ENDIF}
begin
  iCount := 0;

  // ensure there are 3 '.' (periods)
  pcNext := pszAddress;
  while pcNext^ <> TIdPlatformChar(0) do begin
    if pcNext^ = '.' then begin
      Inc(iCount);
    end;
    Inc(pcNext);
  end;
  if iCount <> 3 then begin
    Result := FALSE;
    Exit;
  end;

  // return an error if dwAddress is INADDR_NONE (255.255.255.255)
  // since this is never a valid argument to getaddrinfo.
  dwAddress := inet_addr(
    {$IFDEF USE_MARSHALLED_PTRS}
    M.AsAnsi(pszAddress).ToPointer
    {$ELSE}
      {$IFDEF UNICODE}
    PIdAnsiChar(AnsiString(pszAddress)) // explicit convert to Ansi
      {$ELSE}
    pszAddress
      {$ENDIF}
    {$ENDIF}
  );
  if dwAddress = INADDR_NONE then begin
    Result := FALSE;
    Exit;
  end;

  pdwAddress := dwAddress;
  Result := TRUE;
end;

function WspiapiNewAddrInfo(iSocketType, iProtocol: Integer; wPort: WORD; dwAddress: DWORD): {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF}; stdcall;
var
  ptNew: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF};
  ptAddress: PSockAddrIn;
begin
  // allocate a new addrinfo structure.
  {$IFDEF UNICODE}
  ptNew := PaddrinfoW(WspiapiMalloc(SizeOf(addrinfoW)));
  {$ELSE}
  ptNew := Paddrinfo(WspiapiMalloc(SizeOf(addrinfo)));
  {$ENDIF}
  if ptNew = nil then begin
    Result := nil;
    Exit;
  end;

  ptAddress := PSockAddrIn(WspiapiMalloc(SizeOf(sockaddr_in)));
  if ptAddress = nil then begin
    WspiapiFree(ptNew);
    Result := nil;
    Exit;
  end;
  ptAddress^.sin_family       := AF_INET;
  ptAddress^.sin_port         := wPort;
  ptAddress^.sin_addr.s_addr  := dwAddress;

  // fill in the fields...
  ptNew^.ai_family            := PF_INET;
  ptNew^.ai_socktype          := iSocketType;
  ptNew^.ai_protocol          := iProtocol;
  ptNew^.ai_addrlen           := SizeOf(sockaddr_in);
  ptNew^.ai_addr              := Psockaddr(ptAddress);

  Result := ptNew;
end;

function WspiapiQueryDNS(const pszNodeName: PIdPlatformChar; iSocketType, iProtocol: Integer;
  wPort: WORD; pszAlias: PIdPlatformChar; var pptResult: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF}): Integer; stdcall;
var
  pptNext: {$IFDEF UNICODE}PPaddrinfoW{$ELSE}PPaddrinfo{$ENDIF};
  ptHost: Phostent;
  ppAddresses: ^PInAddr;
  {$IFDEF USE_MARSHALLED_PTRS}
  M: TMarshaller;
  {$ENDIF}
begin
  pptNext := @pptResult;

  pptNext^ := nil;
  pszAlias^ := TIdPlatformChar(0);

  ptHost := gethostbyname(
    {$IFDEF USE_MARSHALLED_PTRS}
    M.AsAnsi(pszNodeName).ToPointer
    {$ELSE}
      {$IFDEF UNICODE}
    PIdAnsiChar(AnsiString(pszNodeName)) // explicit convert to Ansi
      {$ELSE}
    pszNodeName
      {$ENDIF}
    {$ENDIF}
  );
  if ptHost <> nil then begin
    if (ptHost^.h_addrtype = AF_INET) and (ptHost^.h_length = SizeOf(in_addr)) then begin
      ppAddresses := Pointer(ptHost^.h_address_list);
      while ppAddresses^ <> nil do begin
        // create an addrinfo structure...
        pptNext^ := WspiapiNewAddrInfo(iSocketType, iProtocol, wPort, ppAddresses^^.s_addr);
        if pptNext^ = nil then begin
          Result := EAI_MEMORY;
          Exit;
        end;

        pptNext := @((pptNext^)^.ai_next);
        Inc(ppAddresses);
      end;
    end;

    // pick up the canonical name.
    StrLCopy(pszAlias,
      {$IFNDEF UNICODE}
      ptHost^.h_name
      {$ELSE}
      PIdPlatformChar(TIdPlatformString(ptHost^.h_name))
      {$ENDIF}
      , NI_MAXHOST);

    Result := 0;
    Exit;
  end;

  case WSAGetLastError() of
    WSAHOST_NOT_FOUND: Result := EAI_NONAME;
    WSATRY_AGAIN:      Result := EAI_AGAIN;
    WSANO_RECOVERY:    Result := EAI_FAIL;
    WSANO_DATA:        Result := EAI_NODATA;
  else
    Result := EAI_NONAME;
  end;
end;

function WspiapiLookupNode(const pszNodeName: PIdPlatformChar; iSocketType: Integer;
  iProtocol: Integer; wPort: WORD; bAI_CANONNAME: BOOL; var pptResult: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF}): Integer; stdcall;
var
  iError: Integer;
  iAliasCount: Integer;
  szFQDN1: array[0..NI_MAXHOST-1] of TIdPlatformChar;
  szFQDN2: array[0..NI_MAXHOST-1] of TIdPlatformChar;
  pszName: PIdPlatformChar;
  pszAlias: PIdPlatformChar;
  pszScratch: PIdPlatformChar;
begin
  iAliasCount := 0;

  ZeroMemory(@szFQDN1, SizeOf(szFQDN1));
  ZeroMemory(@szFQDN2, SizeOf(szFQDN2));
  pszName := @szFQDN1[0];
  pszAlias := @szFQDN2[0];
  pszScratch := nil;
  StrLCopy(pszName, pszNodeName, NI_MAXHOST);

  repeat
    iError := WspiapiQueryDNS(pszNodeName, iSocketType, iProtocol, wPort, pszAlias, pptResult);
    if iError <> 0 then begin
      Break;
    end;

    // if we found addresses, then we are done.
    if pptResult <> nil then begin
      Break;
    end;

    // stop infinite loops due to DNS misconfiguration.  there appears
    // to be no particular recommended limit in RFCs 1034 and 1035.
    if (StrLen(pszAlias) = 0) or (StrComp(pszName, pszAlias) = 0) then begin
      iError := EAI_FAIL;
      Break;
    end;
    Inc(iAliasCount);
    if iAliasCount = 16 then begin
      iError := EAI_FAIL;
      Break;
    end;

    // there was a new CNAME, look again.
    WspiapiSwap(pszName, pszAlias, pszScratch);
  until False;

  if (iError = 0) and bAI_CANONNAME then begin
    pptResult^.ai_canonname := WspiapiStrdup(pszAlias);
    if pptResult^.ai_canonname = nil then begin
      iError := EAI_MEMORY;
    end;
  end;

  Result := iError;
end;

function WspiapiClone(wPort: WORD; ptResult: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF}): Integer; stdcall;
var
  ptNext, ptNew: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF};
begin
  ptNext := ptResult;
  while ptNext <> nil do begin
    // create an addrinfo structure...
    ptNew := WspiapiNewAddrInfo(SOCK_DGRAM, ptNext^.ai_protocol, wPort, PSockAddrIn(ptNext^.ai_addr)^.sin_addr.s_addr);
    if ptNew = nil then begin
      Break;
    end;

    // link the cloned addrinfo
    ptNew^.ai_next  := ptNext^.ai_next;
    ptNext^.ai_next := ptNew;
    ptNext          := ptNew^.ai_next;
  end;

  if ptNext <> nil then begin
    Result := EAI_MEMORY;
    Exit;
  end;

  Result := 0;
end;

procedure WspiapiLegacyFreeAddrInfo(ptHead: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF}); stdcall;
var
 ptNext: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF};
begin
  ptNext := ptHead;
  while ptNext <> nil do
  begin
    if ptNext^.ai_canonname <> nil then begin
      WspiapiFree(ptNext^.ai_canonname);
    end;
    if ptNext^.ai_addr <> nil then begin
      WspiapiFree(ptNext^.ai_addr);
    end;
    ptHead := ptNext^.ai_next;
    WspiapiFree(ptNext);
    ptNext := ptHead;
  end;
end;

{$IFNDEF HAS_TryStrToInt}
// TODO: use the implementation already in IdGlobalProtocols...
function TryStrToInt(const S: string; out Value: Integer): Boolean;
{$IFDEF USE_INLINE}inline;{$ENDIF}
var
  E: Integer;
begin
  Val(S, Value, E);
  Result := E = 0;
end;
{$ENDIF}

function WspiapiLegacyGetAddrInfo(const pszNodeName: PIdPlatformChar; const pszServiceName: PIdPlatformChar;
  const ptHints: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF};
  var pptResult: {$IFDEF UNICODE}PaddrinfoW{$ELSE}Paddrinfo{$ENDIF}): Integer; stdcall;
var
  iError: Integer;
  iFlags: Integer;
  iSocketType: Integer;
  iProtocol: Integer;
  wPort: WORD;
  iTmp: Integer;
  dwAddress: DWORD;
  ptService: Pservent;
  bClone: BOOL;
  wTcpPort: WORD;
  wUdpPort: WORD;
  {$IFDEF USE_MARSHALLED_PTRS}
  M: TMarshaller;
  {$ENDIF}
begin
  iError := 0;
  iFlags := 0;
  iSocketType := 0;
  iProtocol := 0;
  wPort := 0;
  dwAddress := 0;
  bClone := FALSE;
  wTcpPort := 0;
  wUdpPort := 0;

  // initialize pptResult with default return value.
  pptResult := nil;

  ////////////////////////////////////////
  // validate arguments...
  //

  // both the node name and the service name can't be NULL.
  if (pszNodeName = nil) and (pszServiceName = nil) then begin
    Result := EAI_NONAME;
    Exit;
  end;

  // validate hints.
  if ptHints <> nil then
  begin
    // all members other than ai_flags, ai_family, ai_socktype
    // and ai_protocol must be zero or a null pointer.
    if (ptHints^.ai_addrlen <> 0) or
       (ptHints^.ai_canonname <> nil) or
       (ptHints^.ai_addr <> nil) or
       (ptHints^.ai_next <> nil) then
    begin
      Result := EAI_FAIL;
      Exit;
    end;

    // the spec has the "bad flags" error code, so presumably we
    // should check something here.  insisting that there aren't
    // any unspecified flags set would break forward compatibility,
    // however.  so we just check for non-sensical combinations.
    //
    // we cannot come up with a canonical name given a null node name.
    iFlags := ptHints^.ai_flags;
    if ((iFlags and AI_CANONNAME) <> 0) and (pszNodeName = nil) then begin
      Result := EAI_BADFLAGS;
      Exit;
    end;

    // we only support a limited number of protocol families.
    if (ptHints^.ai_family <> PF_UNSPEC) and (ptHints^.ai_family <> PF_INET) then begin
      Result := EAI_FAMILY;
      Exit;
    end;

    // we only support only these socket types.
    iSocketType := ptHints^.ai_socktype;
    if (iSocketType <> 0) and
       (iSocketType <> SOCK_STREAM) and
       (iSocketType <> SOCK_DGRAM) and
       (iSocketType <> SOCK_RAW) then
    begin
      Result := EAI_SOCKTYPE;
      Exit;
    end;

    // REVIEW: What if ai_socktype and ai_protocol are at odds?
    iProtocol := ptHints^.ai_protocol;
  end;

  ////////////////////////////////////////
  // do service lookup...

  if pszServiceName <> nil then begin
    if TryStrToInt(pszServiceName, iTmp) and (iTmp >= 0) then begin
      wPort := htons(WORD(iTmp));
      //wTcpPort := wPort; // never used
      wUdpPort := wPort;
      if iSocketType = 0 then begin
        bClone := TRUE;
        iSocketType := SOCK_STREAM;
      end;
    end else
    begin
      if (iSocketType = 0) or (iSocketType = SOCK_DGRAM) then begin
        ptService := getservbyname(
          {$IFDEF USE_MARSHALLED_PTRS}
          M.AsAnsi(pszServiceName).ToPointer
          {$ELSE}
            {$IFDEF UNICODE}
          PIdAnsiChar(AnsiString(pszServiceName)) // explicit convert to Ansi
            {$ELSE}
          pszServiceName
            {$ENDIF}
          {$ENDIF}
          , 'udp'); {do not localize}
        if ptService <> nil then begin
          wPort := ptService^.s_port;
          wUdpPort := wPort;
        end;
      end;

      if (iSocketType = 0) or (iSocketType = SOCK_STREAM) then begin
        ptService := getservbyname(
          {$IFDEF USE_MARSHALLED_PTRS}
          M.AsAnsi(pszServiceName).ToPointer
          {$ELSE}
            {$IFDEF UNICODE}
          PIdAnsiChar(AnsiString(pszServiceName)) // explicit convert to Ansi
            {$ELSE}
          pszServiceName
            {$ENDIF}
          {$ENDIF}
          , 'tcp'); {do not localize}
        if ptService <> nil then begin
          wPort := ptService^.s_port;
          wTcpPort := wPort;
        end;
      end;

      // assumes 0 is an invalid service port...
      if wPort = 0 then begin
        Result := iif(iSocketType <> 0, EAI_SERVICE, EAI_NONAME);
        Exit;
      end;

      if iSocketType = 0 then begin
        // if both tcp and udp, process tcp now & clone udp later.
        iSocketType := iif(wTcpPort <> 0, SOCK_STREAM, SOCK_DGRAM);
        bClone := (wTcpPort <> 0) and (wUdpPort <> 0);
      end;
    end;
  end;

  ////////////////////////////////////////
  // do node name lookup...

  // if we weren't given a node name,
  // return the wildcard or loopback address (depending on AI_PASSIVE).
  //
  // if we have a numeric host address string,
  // return the binary address.
  //
  if ((pszNodeName = nil) or WspiapiParseV4Address(pszNodeName, dwAddress)) then begin
    if pszNodeName = nil then begin
      dwAddress := htonl(iif((iFlags and AI_PASSIVE) <> 0, INADDR_ANY, INADDR_LOOPBACK));
    end;

    // create an addrinfo structure...
    pptResult := WspiapiNewAddrInfo(iSocketType, iProtocol, wPort, dwAddress);
    if pptResult = nil then begin
      iError := EAI_MEMORY;
    end;

    if (iError = 0) and (pszNodeName <> nil) then begin
      // implementation specific behavior: set AI_NUMERICHOST
      // to indicate that we got a numeric host address string.
      pptResult^.ai_flags := pptResult^.ai_flags or AI_NUMERICHOST;
      // return the numeric address string as the canonical name
      if (iFlags and AI_CANONNAME) <> 0 then begin
        pptResult^.ai_canonname := WspiapiStrdup(
          {$IFNDEF UNICODE}
          inet_ntoa(PInAddr(@dwAddress)^)
          {$ELSE}
          PWideChar(TIdUnicodeString(inet_ntoa(PInAddr(@dwAddress)^)))
          {$ENDIF}
          );
        if pptResult^.ai_canonname = nil then begin
          iError := EAI_MEMORY;
        end;
      end;
    end;
  end

  // if we do not have a numeric host address string and
  // AI_NUMERICHOST flag is set, return an error!
  else if ((iFlags and AI_NUMERICHOST) <> 0) then begin
    iError := EAI_NONAME;
  end

  // since we have a non-numeric node name,
  // we have to do a regular node name lookup.
  else begin
    iError := WspiapiLookupNode(pszNodeName, iSocketType, iProtocol, wPort, (iFlags and AI_CANONNAME) <> 0, pptResult);
  end;

  if (iError = 0) and bClone then begin
    iError := WspiapiClone(wUdpPort, pptResult);
  end;

  if iError <> 0 then begin
    WspiapiLegacyFreeAddrInfo(pptResult);
    pptResult := nil;
  end;

  Result := iError;
end;

function iif(ATest: Boolean; const ATrue, AFalse: PIdAnsiChar): PIdAnsiChar;
  {$IFDEF USE_INLINE}inline;{$ENDIF}
begin
  if ATest then begin
    Result := ATrue;
  end else begin
    Result := AFalse;
  end;
end;

function WspiapiLegacyGetNameInfo(ptSocketAddress: Psockaddr;
  tSocketLength: u_int; pszNodeName: PIdPlatformChar; tNodeLength: size_t;
  pszServiceName: PIdPlatformChar; tServiceLength: size_t; iFlags: Integer): Integer; stdcall;
var
  ptService: Pservent;
  wPort: WORD;
  szBuffer: array[0..5] of TIdPlatformChar;
  pszService: PIdPlatformChar;
  ptHost: Phostent;
  tAddress: in_addr;
  pszNode: PIdPlatformChar;
  pc: PIdPlatformChar;
  {$IFDEF UNICODE}
  tmpService: TIdUnicodeString;
  tmpNode: TIdUnicodeString;
  {$ENDIF}
begin
  StrCopy(szBuffer, '65535');
  pszService := szBuffer;

  // sanity check ptSocketAddress and tSocketLength.
  if (ptSocketAddress = nil) or (tSocketLength < SizeOf(sockaddr)) then begin
    Result := EAI_FAIL;
    Exit;
  end;

  if ptSocketAddress^.sa_family <> AF_INET then begin
    Result := EAI_FAMILY;
    Exit;
  end;

  if tSocketLength < SizeOf(sockaddr_in) then begin
    Result := EAI_FAIL;
    Exit;
  end;

  if (not ((pszNodeName <> nil) and (tNodeLength > 0))) and (not ((pszServiceName <> nil) and (tServiceLength > 0))) then begin
    Result := EAI_NONAME;
    Exit;
  end;

  // the draft has the "bad flags" error code, so presumably we
  // should check something here.  insisting that there aren't
  // any unspecified flags set would break forward compatibility,
  // however.  so we just check for non-sensical combinations.
  if ((iFlags and NI_NUMERICHOST) <> 0) and ((iFlags and NI_NAMEREQD) <> 0) then begin
    Result := EAI_BADFLAGS;
    Exit;
  end;

  // translate the port to a service name (if requested).
  if (pszServiceName <> nil) and (tServiceLength > 0) then begin
    wPort := PSockAddrIn(ptSocketAddress)^.sin_port;

    if (iFlags and NI_NUMERICSERV) <> 0 then begin
      // return numeric form of the address.
      StrPLCopy(szBuffer, IntToStr(ntohs(wPort)), Length(szBuffer));
    end else
    begin
      // return service name corresponding to port.
      ptService := getservbyport(wPort, iif((iFlags and NI_DGRAM) <> 0, 'udp', nil));
      if (ptService <> nil) and (ptService^.s_name <> nil) then begin
        // lookup successful.
        {$IFNDEF UNICODE}
        pszService := ptService^.s_name;
        {$ELSE}
        tmpService := TIdUnicodeString(ptService^.s_name);
        pszService := PWideChar(tmpService);
        {$ENDIF}
      end else begin
        // DRAFT: return numeric form of the port!
        StrPLCopy(szBuffer, IntToStr(ntohs(wPort)), Length(szBuffer));
      end;
    end;

    if tServiceLength > size_t(StrLen(pszService)) then begin
      StrLCopy(pszServiceName, pszService, tServiceLength);
    end else begin
      Result := EAI_FAIL;
      Exit;
    end;
  end;

  // translate the address to a node name (if requested).
  if (pszNodeName <> nil) and (tNodeLength > 0) then begin
    // this is the IPv4-only version, so we have an IPv4 address.
    tAddress := PSockAddrIn(ptSocketAddress)^.sin_addr;

    if (iFlags and NI_NUMERICHOST) <> 0 then begin
      // return numeric form of the address.
      {$IFNDEF UNICODE}
      pszNode := inet_ntoa(tAddress);
      {$ELSE}
      tmpNode := TIdUnicodeString(inet_ntoa(tAddress));
      pszNode := PWideChar(tmpNode);
      {$ENDIF}
    end else
    begin
      // return node name corresponding to address.
      ptHost := gethostbyaddr(PIdAnsiChar(@tAddress), SizeOf(in_addr), AF_INET);
      if (ptHost <> nil) and (ptHost^.h_name <> nil) then begin
        // DNS lookup successful.
        // stop copying at a "." if NI_NOFQDN is specified.
        {$IFNDEF UNICODE}
        pszNode := ptHost^.h_name;
        {$ELSE}
        tmpNode := TIdUnicodeString(ptHost^.h_name);
        pszNode := PWideChar(tmpNode);
        {$ENDIF}
        if (iFlags and NI_NOFQDN) <> 0 then begin
          pc := StrScan(pszNode, '.');
          if pc <> nil then begin
            pc^ := TIdPlatformChar(0);
          end;
        end;
      end else
      begin
        // DNS lookup failed.  return numeric form of the address.
        if (iFlags and NI_NAMEREQD) <> 0 then begin
          case WSAGetLastError() of
            WSAHOST_NOT_FOUND: Result := EAI_NONAME;
            WSATRY_AGAIN:      Result := EAI_AGAIN;
            WSANO_RECOVERY:    Result := EAI_FAIL;
          else
            Result := EAI_NONAME;
          end;
          Exit;
        end else begin
          {$IFNDEF UNICODE}
          pszNode := inet_ntoa(tAddress);
          {$ELSE}
          tmpNode := TIdUnicodeString(inet_ntoa(tAddress));
          pszNode := PWideChar(tmpNode);
          {$ENDIF}
        end;
      end;
    end;

    if tNodeLength > size_t(StrLen(pszNode)) then begin
      StrLCopy(pszNodeName, pszNode, tNodeLength);
    end else begin
      Result := EAI_FAIL;
      Exit;
    end;
  end;

  Result := 0;
end;

{$IFDEF WINCE_UNICODE}

function IndyStrdupAToW(const pszString: PIdAnsiChar): PWideChar;
var
  szStr: TIdUnicodeString;
  pszMemory: PWideChar;
  cchMemory: size_t;
begin
  if pszString = nil then begin
    Result := nil;
    Exit;
  end;

  szStr := TIdUnicodeString(pszString);
  cchMemory := Length(szStr) + 1;

  pszMemory := PWideChar(WspiapiMalloc(cchMemory * SizeOf(WideChar)));
  if pszMemory = nil then begin
    Result := nil;
    Exit;
  end;

  StrLCopy(pszMemory, PWideChar(szStr), cchMemory);
  Result := pszMemory;
end;

procedure IndyFreeAddrInfoW(ptHead: PaddrinfoW); stdcall;
var
 ptNext: PaddrinfoW;
begin
  ptNext := ptHead;
  while ptNext <> nil do
  begin
    if ptNext^.ai_canonname <> nil then begin
      WspiapiFree(ptNext^.ai_canonname);
    end;
    if ptNext^.ai_addr <> nil then begin
      WspiapiFree(ptNext^.ai_addr);
    end;
    ptHead := ptNext^.ai_next;
    WspiapiFree(ptNext);
    ptNext := ptHead;
  end;
end;

function IndyAddrInfoConvert(AddrInfo: Paddrinfo): PaddrinfoW;
var
  ptNew: PaddrinfoW;
  ptAddress: Pointer;
begin
  Result := nil;

  if AddrInfo = nil then begin
    Exit;
  end;

  // allocate a new addrinfo structure.
  ptNew := PaddrinfoW(WspiapiMalloc(SizeOf(addrinfoW)));
  if ptNew = nil then begin
    WspiapiFree(ptNew);
    Exit;
  end;

  ptAddress := WspiapiMalloc(AddrInfo^.ai_addrlen);
  if ptAddress = nil then begin
    WspiapiFree(ptNew);
    Exit;
  end;
  Move(AddrInfo^.ai_addr^, ptAddress^, AddrInfo^.ai_addrlen);

  // fill in the fields...
  ptNew^.ai_flags             := AddrInfo^.ai_flags;
  ptNew^.ai_family            := AddrInfo^.ai_family;
  ptNew^.ai_socktype          := AddrInfo^.ai_socktype;
  ptNew^.ai_protocol          := AddrInfo^.ai_protocol;
  ptNew^.ai_addrlen           := AddrInfo^.ai_addrlen;
  ptNew^.ai_canonname         := nil;
  ptNew^.ai_addr              := Psockaddr(ptAddress);
  ptNew^.ai_next              := nil;

  if AddrInfo^.ai_canonname <> nil then begin
    ptNew^.ai_canonname := IndyStrdupAToW(AddrInfo^.ai_canonname);
    if ptNew^.ai_canonname = nil then begin
      IndyFreeAddrInfoW(ptNew);
      Exit;
    end;
  end;

  if AddrInfo^.ai_next <> nil then begin
    ptNew^.ai_next := IndyAddrInfoConvert(AddrInfo^.ai_next);
    if ptNew^.ai_next = nil then begin
      IndyFreeAddrInfoW(ptNew);
      Exit;
    end;
  end;

  Result := ptNew;
end;

function IndyGetAddrInfoW(const pszNodeName: PWideChar; const pszServiceName: PWideChar;
  const ptHints: PaddrinfoW; var pptResult: PaddrinfoW): Integer; stdcall;
var
  LNodeName: AnsiString;
  LPNodeName: PIdAnsiChar;
  LServiceName: AnsiString;
  LPServiceName: PIdAnsiChar;
  LHints: addrinfo;
  LPHints: Paddrinfo;
  LResult: Paddrinfo;
begin
  // initialize pptResult with default return value.
  pptResult := nil;

  if pszNodeName <> nil then begin
    LNodeName := AnsiString(pszNodeName);
    LPNodeName := PIdAnsiChar(LNodeName);
  end else begin
    LPNodeName := nil;
  end;

  if pszServiceName <> nil then begin
    LServiceName := AnsiString(pszServiceName);
    LPServiceName := PIdAnsiChar(LServiceName);
  end else begin
    LPServiceName := nil;
  end;

  if ptHints <> nil then begin
    ZeroMemory(@LHints, SizeOf(LHints));
    LHints.ai_flags     := ptHints^.ai_flags;
    LHints.ai_family    := ptHints^.ai_family;
    LHints.ai_socktype  := ptHints^.ai_socktype;
    LHints.ai_protocol  := ptHints^.ai_protocol;
    LPHints := @LHints;
  end else begin
    LPHints := nil;
  end;

  Result := getaddrinfoCE(LPNodeName, LPServiceName, LPHints, @LResult);
  if Result = 0 then begin
    try
      pptResult := IndyAddrInfoConvert(LResult);
    finally
      freeaddrinfoCE(LResult);
    end;
    if pptResult = nil then begin
      Result := EAI_MEMORY;
    end;
  end;
end;

function IndyGetNameInfoW(ptSocketAddress: Psockaddr; tSocketLength: u_int;
  pszNodeName: PWideChar; tNodeLength: size_t; pszServiceName: PWideChar;
  tServiceLength: size_t; iFlags: Integer): Integer; stdcall;
var
  LHost: array[0..NI_MAXHOST-1] of TIdAnsiChar;
  LPHost: PIdAnsiChar;
  LHostLen: u_int;
  LServ: array[0..NI_MAXSERV-1] of TIdAnsiChar;
  LPServ: PIdAnsiChar;
  LServLen: u_int;
begin
  if pszNodeName <> nil then
  begin
    LPHost := @LHost[0];
    LHostLen := Length(LHost);
  end else begin
    LPHost := nil;
    LHostLen := 0;
  end;

  if pszServiceName <> nil then
  begin
    LPServ := @LServ[0];
    LServLen := Length(LServ);
  end else begin
    LPServ := nil;
    LServLen := 0;
  end;

  Result := getnameinfoCE(ptSocketAddress, tSocketLength, LPHost, LHostLen, LPServ, LServLen, iFlags);
  if Result = 0 then begin
    if pszNodeName <> nil then begin
      StrPLCopy(pszNodeName, TIdUnicodeString(LPHost), tNodeLength);
    end;
    if pszServiceName <> nil then begin
      StrPLCopy(pszServiceName, TIdUnicodeString(LPServ), tServiceLength);
    end;
  end;
end;

{$ENDIF}

procedure InitLibrary;
var
  {$IFDEF WINCE_UNICODE}
  gai: LPFN_GETADDRINFO;
  gni: LPFN_GETNAMEINFO;
  fai: LPFN_FREEADDRINFO;
  {$ELSE}
  gai: {$IFDEF UNICODE}LPFN_GETADDRINFOW{$ELSE}LPFN_GETADDRINFO{$ENDIF};
  gni: {$IFDEF UNICODE}LPFN_GETNAMEINFOW{$ELSE}LPFN_GETNAMEINFO{$ENDIF};
  fai: {$IFDEF UNICODE}LPFN_FREEADDRINFOW{$ELSE}LPFN_FREEADDRINFO{$ENDIF};
  {$ENDIF}
begin
{
IMPORTANT!!!

I am doing things this way because the functions we want are probably in
the Winsock2 dll.  If they are not there, only then do you actually want
to try the Wship6.dll.   I know it's a mess but I found that the functions
may not load if they aren't in Wship6.dll (and they aren't there in some
versions of Windows).

hProcHandle provides a transparant way of managing the two possible library
locations.  hWship6Dll is kept so we can unload the Wship6.dll if necessary.
}
  //Winsock2 has to be loaded by IdWinsock first.
  if not IdWinsock2.Winsock2Loaded then
  begin
    IdWinsock2.InitializeWinSock;
  end;
  hProcHandle := IdWinsock2.WinsockHandle;

  gai := LoadLibFunction(hProcHandle, fn_getaddrinfo);
  if not Assigned(gai) then
  begin
    hWship6Dll := SafeLoadLibrary(Wship6_dll);
    hProcHandle := hWship6Dll;
    gai := LoadLibFunction(hProcHandle, fn_getaddrinfo);
  end;

  if Assigned(gai) then
  begin
    gni := LoadLibFunction(hProcHandle, fn_getnameinfo);
    if Assigned(gni) then
    begin
      fai := LoadLibFunction(hProcHandle, fn_freeaddrinfo);
      if Assigned(fai) then
      begin
        {$IFDEF WINCE_UNICODE}
        getaddrinfoCE := gai;
        getnameinfoCE := gni;
        freeaddrinfoCE := fai;
        getaddrinfo := @IndyGetAddrInfoW;
        getnameinfo := @IndyGetNameInfoW;
        freeaddrinfo := @IndyFreeAddrInfoW;
        {$ELSE}
        getaddrinfo := gai;
        getnameinfo := gni;
        freeaddrinfo := fai;
        {$ENDIF}

        //Additional functions should be initialized here.
        {$IFNDEF WINCE}
        inet_pton := LoadLibFunction(hProcHandle, fn_inet_pton);
        inet_ntop := LoadLibFunction(hProcHandle, fn_inet_ntop);
        GetAddrInfoEx := LoadLibFunction(hProcHandle, fn_GetAddrInfoEx);
        SetAddrInfoEx := LoadLibFunction(hProcHandle, fn_SetAddrInfoEx);
        FreeAddrInfoEx := LoadLibFunction(hProcHandle, fn_FreeAddrInfoEx);
        hfwpuclntDll := SafeLoadLibrary(fwpuclnt_dll);
        if hfwpuclntDll <> IdNilHandle then
        begin
          WSASetSocketSecurity := LoadLibFunction(hfwpuclntDll, 'WSASetSocketSecurity'); {Do not localize}
          WSAQuerySocketSecurity := LoadLibFunction(hfwpuclntDll, 'WSAQuerySocketSecurity'); {Do not localize}
          WSASetSocketPeerTargetName := LoadLibFunction(hfwpuclntDll, 'WSASetSocketPeerTargetName'); {Do not localize}
          WSADeleteSocketPeerTargetName := LoadLibFunction(hfwpuclntDll, 'WSADeleteSocketPeerTargetName');  {Do not localize}
          WSAImpersonateSocketPeer := LoadLibFunction(hfwpuclntDll, 'WSAImpersonateSocketPeer'); {Do not localize}
          WSARevertImpersonation := LoadLibFunction(hfwpuclntDll, 'WSARevertImpersonation'); {Do not localize}
        end;
        {$ENDIF}

        Exit;
      end;
    end;
  end;

  CloseLibrary;

  getaddrinfo := Addr(WspiapiLegacyGetAddrInfo);
  getnameinfo := Addr(WspiapiLegacyGetNameInfo);
  freeaddrinfo := Addr(WspiapiLegacyFreeAddrInfo);

  {$I IdSymbolDeprecatedOff.inc}
  GIdIPv6FuncsAvailable := True;
  {$I IdSymbolDeprecatedOn.inc}
end;

initialization
finalization
  CloseLibrary;

end.