2407 lines
72 KiB
Plaintext
2407 lines
72 KiB
Plaintext
{
|
|
$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.8 10/26/2004 8:20:04 PM JPMugaas
|
|
Fixed some oversights with conversion. OOPS!!!
|
|
|
|
|
|
Rev 1.7 07/06/2004 21:31:24 CCostelloe
|
|
Kylix 3 changes
|
|
|
|
|
|
Rev 1.6 4/18/04 10:43:24 PM RLebeau
|
|
Fixed syntax error
|
|
|
|
|
|
Rev 1.5 4/18/04 10:29:58 PM RLebeau
|
|
Renamed Int64Parts structure to TIdInt64Parts
|
|
|
|
|
|
Rev 1.4 4/18/04 2:47:46 PM RLebeau
|
|
Conversion support for Int64 values
|
|
|
|
|
|
Rev 1.3 2004.03.07 11:45:28 AM czhower
|
|
Flushbuffer fix + other minor ones found
|
|
|
|
|
|
Rev 1.2 3/6/2004 5:16:34 PM JPMugaas
|
|
Bug 67 fixes. Do not write to const values.
|
|
|
|
|
|
Rev 1.1 3/6/2004 4:23:52 PM JPMugaas
|
|
Error #62 fix. This seems to work in my tests.
|
|
|
|
|
|
Rev 1.0 2004.02.03 3:14:48 PM czhower
|
|
Move and updates
|
|
|
|
|
|
Rev 1.33 2/1/2004 6:10:56 PM JPMugaas
|
|
GetSockOpt.
|
|
|
|
|
|
Rev 1.32 2/1/2004 3:28:36 AM JPMugaas
|
|
Changed WSGetLocalAddress to GetLocalAddress and moved into IdStack since
|
|
that will work the same in the DotNET as elsewhere. This is required to
|
|
reenable IPWatch.
|
|
|
|
|
|
Rev 1.31 1/31/2004 1:12:48 PM JPMugaas
|
|
Minor stack changes required as DotNET does support getting all IP addresses
|
|
just like the other stacks.
|
|
|
|
|
|
Rev 1.30 12/4/2003 3:14:52 PM BGooijen
|
|
Added HostByAddress
|
|
|
|
|
|
Rev 1.29 1/3/2004 12:38:56 AM BGooijen
|
|
Added function SupportsIPv6
|
|
|
|
|
|
Rev 1.28 12/31/2003 9:52:02 PM BGooijen
|
|
Added IPv6 support
|
|
|
|
|
|
Rev 1.27 10/26/2003 05:33:14 PM JPMugaas
|
|
LocalAddresses should work.
|
|
|
|
|
|
Rev 1.26 10/26/2003 5:04:28 PM BGooijen
|
|
UDP Server and Client
|
|
|
|
|
|
Rev 1.25 10/26/2003 09:10:26 AM JPMugaas
|
|
Calls necessary for IPMulticasting.
|
|
|
|
|
|
Rev 1.24 10/22/2003 04:40:52 PM JPMugaas
|
|
Should compile with some restored functionality. Still not finished.
|
|
|
|
|
|
Rev 1.23 10/21/2003 11:04:20 PM BGooijen
|
|
Fixed name collision
|
|
|
|
|
|
Rev 1.22 10/21/2003 01:20:02 PM JPMugaas
|
|
Restore GWindowsStack because it was needed by SuperCore.
|
|
|
|
|
|
Rev 1.21 10/21/2003 06:24:28 AM JPMugaas
|
|
BSD Stack now have a global variable for refercing by platform specific
|
|
things. Removed corresponding var from Windows stack.
|
|
|
|
|
|
Rev 1.20 10/19/2003 5:21:32 PM BGooijen
|
|
SetSocketOption
|
|
|
|
|
|
Rev 1.19 2003.10.11 5:51:16 PM czhower
|
|
-VCL fixes for servers
|
|
-Chain suport for servers (Super core)
|
|
-Scheduler upgrades
|
|
-Full yarn support
|
|
|
|
|
|
Rev 1.18 2003.10.02 8:01:08 PM czhower
|
|
.Net
|
|
|
|
|
|
Rev 1.17 2003.10.02 12:44:44 PM czhower
|
|
Fix for Bind, Connect
|
|
|
|
|
|
Rev 1.16 2003.10.02 10:16:32 AM czhower
|
|
.Net
|
|
|
|
|
|
Rev 1.15 2003.10.01 9:11:26 PM czhower
|
|
.Net
|
|
|
|
|
|
Rev 1.14 2003.10.01 12:30:08 PM czhower
|
|
.Net
|
|
|
|
|
|
Rev 1.12 10/1/2003 12:14:12 AM BGooijen
|
|
DotNet: removing CheckForSocketError
|
|
|
|
|
|
Rev 1.11 2003.10.01 1:12:40 AM czhower
|
|
.Net
|
|
|
|
|
|
Rev 1.10 2003.09.30 1:23:04 PM czhower
|
|
Stack split for DotNet
|
|
|
|
|
|
Rev 1.9 9/8/2003 02:13:10 PM JPMugaas
|
|
SupportsIP6 function added for determining if IPv6 is installed on a system.
|
|
|
|
|
|
Rev 1.8 2003.07.14 1:57:24 PM czhower
|
|
-First set of IOCP fixes.
|
|
-Fixed a threadsafe problem with the stack class.
|
|
|
|
|
|
Rev 1.7 7/1/2003 05:20:44 PM JPMugaas
|
|
Minor optimizations. Illiminated some unnecessary string operations.
|
|
|
|
|
|
Rev 1.5 7/1/2003 03:39:58 PM JPMugaas
|
|
Started numeric IP function API calls for more efficiency.
|
|
|
|
|
|
Rev 1.4 7/1/2003 12:46:06 AM JPMugaas
|
|
Preliminary stack functions taking an IP address numerical structure instead
|
|
of a string.
|
|
|
|
|
|
Rev 1.3 5/19/2003 6:00:28 PM BGooijen
|
|
TIdStackWindows.WSGetHostByAddr raised an ERangeError when the last number in
|
|
the ip>127
|
|
|
|
|
|
Rev 1.2 5/10/2003 4:01:28 PM BGooijen
|
|
|
|
|
|
Rev 1.1 2003.05.09 10:59:28 PM czhower
|
|
|
|
|
|
Rev 1.0 11/13/2002 08:59:38 AM JPMugaas
|
|
}
|
|
unit IdStackWindows;
|
|
|
|
interface
|
|
|
|
{$I IdCompilerDefines.inc}
|
|
|
|
uses
|
|
Classes,
|
|
IdGlobal, IdException, IdStackBSDBase, IdStackConsts, IdWinsock2, IdStack,
|
|
SysUtils,
|
|
Windows;
|
|
|
|
type
|
|
EIdIPv6Unavailable = class(EIdException);
|
|
|
|
TIdSocketListWindows = class(TIdSocketList)
|
|
protected
|
|
FFDSet: TFDSet;
|
|
//
|
|
class function FDSelect(AReadSet: PFDSet; AWriteSet: PFDSet; AExceptSet: PFDSet;
|
|
const ATimeout: Integer = IdTimeoutInfinite): Boolean;
|
|
function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
|
|
public
|
|
procedure Add(AHandle: TIdStackSocketHandle); override;
|
|
procedure Remove(AHandle: TIdStackSocketHandle); override;
|
|
function Count: Integer; override;
|
|
procedure Clear; override;
|
|
function Clone: TIdSocketList; override;
|
|
function ContainsSocket(AHandle: TIdStackSocketHandle): boolean; override;
|
|
procedure GetFDSet(var VSet: TFDSet);
|
|
procedure SetFDSet(var VSet: TFDSet);
|
|
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;
|
|
|
|
TIdStackWindows = class(TIdStackBSDBase)
|
|
protected
|
|
procedure WSQuerryIPv6Route(ASocket: TIdStackSocketHandle;
|
|
const AIP: String; const APort : UInt16; var VSource; var VDest);
|
|
procedure WriteChecksumIPv6(s : TIdStackSocketHandle; var VBuffer : TIdBytes;
|
|
const AOffset : Integer; const AIP : String; const APort : TIdPort);
|
|
function HostByName(const AHostName: string;
|
|
const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
|
|
function ReadHostName: string; override;
|
|
function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override;
|
|
function WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
|
|
const ABufferLength, AFlags: Integer): Integer; override;
|
|
function WSSend(ASocket: TIdStackSocketHandle; const ABuffer;
|
|
const ABufferLength, AFlags: Integer): Integer; override;
|
|
function WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; override;
|
|
{$IFNDEF VCL_XE3_OR_ABOVE}
|
|
procedure WSGetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
|
|
AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
|
|
procedure WSSetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
|
|
AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
|
|
{$ENDIF}
|
|
public
|
|
function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort;
|
|
var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
|
|
function HostToNetwork(AValue: UInt16): UInt16; override;
|
|
function HostToNetwork(AValue: UInt32): UInt32; override;
|
|
function HostToNetwork(AValue: TIdUInt64): TIdUInt64; override;
|
|
procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); override;
|
|
function NetworkToHost(AValue: UInt16): UInt16; override;
|
|
function NetworkToHost(AValue: UInt32): UInt32; override;
|
|
function NetworkToHost(AValue: TIdUInt64): TIdUInt64; override;
|
|
procedure SetBlocking(ASocket: TIdStackSocketHandle; const ABlocking: Boolean); override;
|
|
function WouldBlock(const AResult: Integer): Boolean; override;
|
|
//
|
|
function HostByAddress(const AAddress: string;
|
|
const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
|
|
|
|
function WSGetServByName(const AServiceName: string): TIdPort; override;
|
|
procedure AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings); override;
|
|
|
|
function RecvFrom(const ASocket: TIdStackSocketHandle; var VBuffer;
|
|
const ALength, AFlags: Integer; var VIP: string; var VPort: TIdPort;
|
|
var VIPVersion: TIdIPVersion): Integer; override;
|
|
function ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
|
|
APkt : TIdPacketInfo): UInt32; override;
|
|
|
|
procedure WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer;
|
|
const ABufferLength, AFlags: Integer; const AIP: string; const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
|
|
|
|
function WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
|
|
const AOverlapped: Boolean = False): TIdStackSocketHandle; override;
|
|
function WSTranslateSocketErrorMsg(const AErr: integer): string; override;
|
|
function WSGetLastError: Integer; override;
|
|
procedure WSSetLastError(const AErr : Integer); override;
|
|
//
|
|
procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string;
|
|
const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
|
|
procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
|
|
const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
procedure Disconnect(ASocket: TIdStackSocketHandle); override;
|
|
procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
|
|
var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
|
|
procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
|
|
var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
|
|
{$IFDEF VCL_XE3_OR_ABOVE}
|
|
procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
|
|
AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
|
|
procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
|
|
AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
|
|
{$ENDIF}
|
|
function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32; var arg: UInt32): Integer; override;
|
|
function SupportsIPv6: Boolean; override;
|
|
function CheckIPVersionSupport(const AIPVersion: TIdIPVersion): boolean; override;
|
|
procedure WriteChecksum(s : TIdStackSocketHandle;
|
|
var VBuffer : TIdBytes;
|
|
const AOffset : Integer;
|
|
const AIP : String;
|
|
const APort : TIdPort;
|
|
const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
|
|
procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override;
|
|
procedure SetKeepAliveValues(ASocket: TIdStackSocketHandle;
|
|
const AEnabled: Boolean; const ATimeMS, AInterval: Integer); override;
|
|
end;
|
|
|
|
var
|
|
//This is for the Win32-only package (SuperCore)
|
|
GWindowsStack : TIdStackWindows = nil;
|
|
|
|
implementation
|
|
|
|
{$DEFINE USE_IPHLPAPI}
|
|
|
|
{$IFDEF USE_IPHLPAPI}
|
|
{$IFDEF VCL_XE2_OR_ABOVE}
|
|
{$DEFINE HAS_UNIT_IpTypes}
|
|
{$DEFINE HAS_UNIT_IpHlpApi}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
IdIDN, IdResourceStrings, IdWship6
|
|
{$IFDEF USE_IPHLPAPI}
|
|
{$IFDEF HAS_UNIT_IpTypes}
|
|
, IpTypes
|
|
{$ENDIF}
|
|
{$IFDEF HAS_UNIT_IpHlpApi}
|
|
, IpHlpApi
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
;
|
|
|
|
{$IFNDEF WINCE}
|
|
type
|
|
TGetFileSizeEx = function(hFile : THandle; var lpFileSize : LARGE_INTEGER) : BOOL; stdcall;
|
|
{$ENDIF}
|
|
|
|
const
|
|
SIZE_HOSTNAME = 250;
|
|
|
|
var
|
|
GStarted: Boolean = False;
|
|
{$IFNDEF WINCE}
|
|
GetFileSizeEx : TGetFileSizeEx = nil;
|
|
{$ENDIF}
|
|
|
|
{ IPHLPAPI support }
|
|
|
|
{$IFDEF USE_IPHLPAPI}
|
|
|
|
const
|
|
IPHLPAPI_DLL = 'iphlpapi.dll';
|
|
{$IFNDEF HAS_UNIT_IpTypes}
|
|
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
|
|
MAX_ADAPTER_NAME_LENGTH = 256;
|
|
MAX_ADAPTER_ADDRESS_LENGTH = 8;
|
|
MAX_DHCPV6_DUID_LENGTH = 130;
|
|
MAX_DNS_SUFFIX_STRING_LENGTH = 256;
|
|
GAA_FLAG_SKIP_UNICAST = $0001;
|
|
GAA_FLAG_SKIP_ANYCAST = $0002;
|
|
GAA_FLAG_SKIP_MULTICAST = $0004;
|
|
GAA_FLAG_SKIP_DNS_SERVER = $0008;
|
|
GAA_FLAG_INCLUDE_PREFIX = $0010;
|
|
GAA_FLAG_SKIP_FRIENDLY_NAME = $0020;
|
|
IP_ADAPTER_RECEIVE_ONLY = $08;
|
|
{$ENDIF}
|
|
IF_TYPE_SOFTWARE_LOOPBACK = 24;
|
|
|
|
type
|
|
PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS = ^IP_UNIDIRECTIONAL_ADAPTER_ADDRESS;
|
|
IP_UNIDIRECTIONAL_ADAPTER_ADDRESS = record
|
|
NumAdapters: ULONG;
|
|
Address: array[0..0] of TInAddr;
|
|
end;
|
|
|
|
{$IFNDEF HAS_UNIT_IpTypes}
|
|
{$MINENUMSIZE 4}
|
|
|
|
time_t = TIdNativeInt;
|
|
IFTYPE = ULONG;
|
|
IF_INDEX = ULONG;
|
|
NET_IF_COMPARTMENT_ID = UINT32;
|
|
NET_IF_NETWORK_GUID = TGUID;
|
|
|
|
IP_PREFIX_ORIGIN = (
|
|
IpPrefixOriginOther,
|
|
IpPrefixOriginManual,
|
|
IpPrefixOriginWellKnown,
|
|
IpPrefixOriginDhcp,
|
|
IpPrefixOriginRouterAdvertisement,
|
|
{$IFNDEF HAS_ENUM_ELEMENT_VALUES}
|
|
ippoUnused5,
|
|
ippoUnused6,
|
|
ippoUnused7,
|
|
ippoUnused8,
|
|
ippoUnused9,
|
|
ippoUnused10,
|
|
ippoUnused11,
|
|
ippoUnused12,
|
|
ippoUnused13,
|
|
ippoUnused14,
|
|
ippoUnused15,
|
|
{$ENDIF}
|
|
IpPrefixOriginUnchanged);
|
|
|
|
IP_SUFFIX_ORIGIN = (
|
|
IpSuffixOriginOther,
|
|
IpSuffixOriginManual,
|
|
IpSuffixOriginWellKnown,
|
|
IpSuffixOriginDhcp,
|
|
IpSuffixOriginLinkLayerAddress,
|
|
IpSuffixOriginRandom,
|
|
{$IFNDEF HAS_ENUM_ELEMENT_VALUES}
|
|
ipsoUnued6,
|
|
ipsoUnued7,
|
|
ipsoUnued8,
|
|
ipsoUnued9,
|
|
ipsoUnued10,
|
|
ipsoUnued11,
|
|
ipsoUnued12,
|
|
ipsoUnued13,
|
|
ipsoUnued14,
|
|
ipsoUnued15,
|
|
{$ENDIF}
|
|
IpSuffixOriginUnchanged);
|
|
|
|
IP_DAD_STATE = (
|
|
IpDadStateInvalid,
|
|
IpDadStateTentative,
|
|
IpDadStateDuplicate,
|
|
IpDadStateDeprecated,
|
|
IpDadStatePreferred);
|
|
|
|
IF_OPER_STATUS = (
|
|
{$IFNDEF HAS_ENUM_ELEMENT_VALUES}
|
|
ifosUnused,
|
|
IfOperStatusUp,
|
|
{$ELSE}
|
|
IfOperStatusUp = 1,
|
|
{$ENDIF}
|
|
IfOperStatusDown,
|
|
IfOperStatusTesting,
|
|
IfOperStatusUnknown,
|
|
IfOperStatusDormant,
|
|
IfOperStatusNotPresent,
|
|
IfOperStatusLowerLayerDown);
|
|
|
|
NET_IF_CONNECTION_TYPE = (
|
|
{$IFNDEF HAS_ENUM_ELEMENT_VALUES}
|
|
nictUnused,
|
|
NetIfConnectionDedicated,
|
|
{$ELSE}
|
|
NetIfConnectionDedicated = 1,
|
|
{$ENDIF}
|
|
NetIfConnectionPassive,
|
|
NetIfConnectionDemand,
|
|
NetIfConnectionMaximum);
|
|
|
|
TUNNEL_TYPE = (
|
|
TunnelTypeNone,
|
|
TunnelTypeOther,
|
|
TunnelTypeDirect,
|
|
TunnelType6To4,
|
|
TunnelTypeIsatap,
|
|
TunnelTypeTeredo,
|
|
TunnelTypeIPHTTPS);
|
|
|
|
IP_ADDRESS_STRING = record
|
|
S: array [0..15] of AnsiChar;
|
|
end;
|
|
IP_MASK_STRING = IP_ADDRESS_STRING;
|
|
|
|
PIP_ADDR_STRING = ^IP_ADDR_STRING;
|
|
IP_ADDR_STRING = record
|
|
Next: PIP_ADDR_STRING;
|
|
IpAddress: IP_ADDRESS_STRING;
|
|
IpMask: IP_MASK_STRING;
|
|
Context: DWORD;
|
|
end;
|
|
|
|
PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
|
|
IP_ADAPTER_INFO = record
|
|
Next: PIP_ADAPTER_INFO;
|
|
ComboIndex: DWORD;
|
|
AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of AnsiChar;
|
|
Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of AnsiChar;
|
|
AddressLength: UINT;
|
|
Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
|
|
Index: DWORD;
|
|
Type_: UINT;
|
|
DhcpEnabled: UINT;
|
|
CurrentIpAddress: PIP_ADDR_STRING;
|
|
IpAddressList: IP_ADDR_STRING;
|
|
GatewayList: IP_ADDR_STRING;
|
|
DhcpServer: IP_ADDR_STRING;
|
|
HaveWins: BOOL;
|
|
PrimaryWinsServer: IP_ADDR_STRING;
|
|
SecondaryWinsServer: IP_ADDR_STRING;
|
|
LeaseObtained: time_t;
|
|
LeaseExpires: time_t;
|
|
end;
|
|
|
|
SOCKET_ADDRESS = record
|
|
lpSockaddr: IdWinsock2.LPSOCKADDR;
|
|
iSockaddrLength: Integer;
|
|
end;
|
|
|
|
PIP_ADAPTER_UNICAST_ADDRESS = ^IP_ADAPTER_UNICAST_ADDRESS;
|
|
IP_ADAPTER_UNICAST_ADDRESS = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
Flags: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_UNICAST_ADDRESS;
|
|
Address: SOCKET_ADDRESS;
|
|
PrefixOrigin: IP_PREFIX_ORIGIN;
|
|
SuffixOrigin: IP_SUFFIX_ORIGIN;
|
|
DadState: IP_DAD_STATE;
|
|
ValidLifetime: ULONG;
|
|
PreferredLifetime: ULONG;
|
|
LeaseLifetime: ULONG;
|
|
|
|
// This structure member is only available on Windows Vista and later
|
|
OnLinkPrefixLength: UCHAR;
|
|
end;
|
|
|
|
PIP_ADAPTER_ANYCAST_ADDRESS = ^IP_ADAPTER_ANYCAST_ADDRESS;
|
|
IP_ADAPTER_ANYCAST_ADDRESS = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
Flags: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_ANYCAST_ADDRESS;
|
|
Address: SOCKET_ADDRESS;
|
|
end;
|
|
|
|
PIP_ADAPTER_MULTICAST_ADDRESS = ^IP_ADAPTER_MULTICAST_ADDRESS;
|
|
IP_ADAPTER_MULTICAST_ADDRESS = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
Flags: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_MULTICAST_ADDRESS;
|
|
Address: SOCKET_ADDRESS;
|
|
end;
|
|
|
|
PIP_ADAPTER_DNS_SERVER_ADDRESS = ^IP_ADAPTER_DNS_SERVER_ADDRESS;
|
|
IP_ADAPTER_DNS_SERVER_ADDRESS = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
Reserved: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_DNS_SERVER_ADDRESS;
|
|
Address: SOCKET_ADDRESS;
|
|
end;
|
|
|
|
PIP_ADAPTER_PREFIX = ^IP_ADAPTER_PREFIX;
|
|
IP_ADAPTER_PREFIX = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
Flags: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_PREFIX;
|
|
Address: SOCKET_ADDRESS;
|
|
PrefixLength: ULONG;
|
|
end;
|
|
|
|
PIP_ADAPTER_WINS_SERVER_ADDRESS_LH = ^IP_ADAPTER_WINS_SERVER_ADDRESS_LH;
|
|
IP_ADAPTER_WINS_SERVER_ADDRESS_LH = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
Reserved: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_WINS_SERVER_ADDRESS_LH;
|
|
Address: SOCKET_ADDRESS;
|
|
end;
|
|
|
|
PIP_ADAPTER_GATEWAY_ADDRESS_LH = ^IP_ADAPTER_GATEWAY_ADDRESS_LH;
|
|
IP_ADAPTER_GATEWAY_ADDRESS_LH = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
Reserved: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_GATEWAY_ADDRESS_LH;
|
|
Address: SOCKET_ADDRESS;
|
|
end;
|
|
|
|
IF_LUID = record
|
|
case Integer of
|
|
0: (
|
|
Value: ULONG64);
|
|
1: (
|
|
Info: ULONG64);
|
|
end;
|
|
|
|
PIP_ADAPTER_DNS_SUFFIX = ^IP_ADAPTER_DNS_SUFFIX;
|
|
IP_ADAPTER_DNS_SUFFIX = record
|
|
Next: PIP_ADAPTER_DNS_SUFFIX;
|
|
AString: array[0..MAX_DNS_SUFFIX_STRING_LENGTH - 1] of WCHAR;
|
|
end;
|
|
|
|
PIP_ADAPTER_ADDRESSES = ^IP_ADAPTER_ADDRESSES;
|
|
IP_ADAPTER_ADDRESSES = record
|
|
Union: record
|
|
case Integer of
|
|
0: (
|
|
Alignment: ULONGLONG);
|
|
1: (
|
|
Length: ULONG;
|
|
IfIndex: DWORD);
|
|
end;
|
|
Next: PIP_ADAPTER_ADDRESSES;
|
|
AdapterName: PAnsiChar;
|
|
FirstUnicastAddress: PIP_ADAPTER_UNICAST_ADDRESS;
|
|
FirstAnycastAddress: PIP_ADAPTER_ANYCAST_ADDRESS;
|
|
FirstMulticastAddress: PIP_ADAPTER_MULTICAST_ADDRESS;
|
|
FirstDnsServerAddress: PIP_ADAPTER_DNS_SERVER_ADDRESS;
|
|
DnsSuffix: PWCHAR;
|
|
Description: PWCHAR;
|
|
FriendlyName: PWCHAR;
|
|
PhysicalAddress: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
|
|
PhysicalAddressLength: DWORD;
|
|
Flags: DWORD;
|
|
Mtu: DWORD;
|
|
IfType: IFTYPE;
|
|
OperStatus: IF_OPER_STATUS;
|
|
Ipv6IfIndex: IF_INDEX;
|
|
ZoneIndices: array [0..15] of DWORD;
|
|
FirstPrefix: PIP_ADAPTER_PREFIX;
|
|
TransmitLinkSpeed: ULONG64;
|
|
ReceiveLinkSpeed: ULONG64;
|
|
FirstWinsServerAddress: PIP_ADAPTER_WINS_SERVER_ADDRESS_LH;
|
|
FirstGatewayAddress: PIP_ADAPTER_GATEWAY_ADDRESS_LH;
|
|
Ipv4Metric: ULONG;
|
|
Ipv6Metric: ULONG;
|
|
Luid: IF_LUID;
|
|
Dhcpv4Server: SOCKET_ADDRESS;
|
|
CompartmentId: NET_IF_COMPARTMENT_ID;
|
|
NetworkGuid: NET_IF_NETWORK_GUID;
|
|
ConnectionType: NET_IF_CONNECTION_TYPE;
|
|
TunnelType: TUNNEL_TYPE;
|
|
//
|
|
// DHCP v6 Info.
|
|
//
|
|
Dhcpv6Server: SOCKET_ADDRESS;
|
|
Dhcpv6ClientDuid: array [0..MAX_DHCPV6_DUID_LENGTH - 1] of Byte;
|
|
Dhcpv6ClientDuidLength: ULONG;
|
|
Dhcpv6Iaid: ULONG;
|
|
FirstDnsSuffix: PIP_ADAPTER_DNS_SUFFIX;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
PMIB_IPADDRROW = ^MIB_IPADDRROW;
|
|
MIB_IPADDRROW = record
|
|
dwAddr: DWORD;
|
|
dwIndex: DWORD;
|
|
dwMask: DWORD;
|
|
dwBCastAddr: DWORD;
|
|
dwReasmSize: DWORD;
|
|
unused1: Word;
|
|
wType: Word;
|
|
end;
|
|
|
|
PMIB_IPADDRTABLE = ^MIB_IPADDRTABLE;
|
|
MIB_IPADDRTABLE = record
|
|
dwNumEntries: DWORD;
|
|
table: array[0..0] of MIB_IPADDRROW;
|
|
end;
|
|
|
|
NETIO_STATUS = DWORD;
|
|
|
|
TGetIpAddrTable = function(pIpAddrTable: PMIB_IPADDRTABLE; var pdwSize: ULONG; bOrder: BOOL): DWORD; stdcall;
|
|
TGetUniDirectionalAdapterInfo = function(pIPIfInfo: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS; var dwOutBufLen: ULONG): DWORD; stdcall;
|
|
TGetAdaptersInfo = function(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
|
|
TGetAdaptersAddresses = function(Family: ULONG; Flags: DWORD; Reserved: PVOID; pAdapterAddresses: PIP_ADAPTER_ADDRESSES; var OutBufLen: ULONG): DWORD; stdcall;
|
|
TConvertLengthToIpv4Mask = function(MaskLength: ULONG; var Mask: ULONG): NETIO_STATUS; stdcall;
|
|
|
|
var
|
|
hIpHlpApi: THandle = 0;
|
|
GetIpAddrTable: TGetIpAddrTable = nil;
|
|
GetUniDirectionalAdapterInfo: TGetUniDirectionalAdapterInfo = nil;
|
|
GetAdaptersInfo: TGetAdaptersInfo = nil;
|
|
GetAdaptersAddresses: TGetAdaptersAddresses = nil;
|
|
ConvertLengthToIpv4Mask: TConvertLengthToIpv4Mask = nil;
|
|
|
|
function FixupIPHelperStub(const AName:{$IFDEF WINCE}TIdUnicodeString{$ELSE}string{$ENDIF}; DefImpl: Pointer): Pointer;
|
|
{$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Result := nil;
|
|
if hIpHlpApi <> 0 then begin
|
|
Result := Windows.GetProcAddress(hIpHlpApi, {$IFDEF WINCE}PWideChar{$ELSE}PChar{$ENDIF}(AName));
|
|
end;
|
|
if Result = nil then begin
|
|
Result := DefImpl;
|
|
end;
|
|
end;
|
|
|
|
function Impl_GetIpAddrTable(pIpAddrTable: PMIB_IPADDRTABLE; var pdwSize: ULONG; bOrder: BOOL): DWORD; stdcall;
|
|
begin
|
|
pdwSize := 0;
|
|
Result := ERROR_NOT_SUPPORTED;
|
|
end;
|
|
|
|
function Stub_GetIpAddrTable(pIpAddrTable: PMIB_IPADDRTABLE; var pdwSize: ULONG; bOrder: BOOL): DWORD; stdcall;
|
|
begin
|
|
@GetIpAddrTable := FixupIPHelperStub('GetIpAddrTable', @Impl_GetIpAddrTable); {Do not localize}
|
|
Result := GetIpAddrTable(pIpAddrTable, pdwSize, bOrder);
|
|
end;
|
|
|
|
function Impl_GetUniDirectionalAdapterInfo(pIPIfInfo: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS; var dwOutBufLen: ULONG): DWORD; stdcall;
|
|
begin
|
|
dwOutBufLen := 0;
|
|
Result := ERROR_NOT_SUPPORTED;
|
|
end;
|
|
|
|
function Stub_GetUniDirectionalAdapterInfo(pIPIfInfo: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS; var dwOutBufLen: ULONG): DWORD; stdcall;
|
|
begin
|
|
@GetUniDirectionalAdapterInfo := FixupIPHelperStub('GetUniDirectionalAdapterInfo', @Impl_GetUniDirectionalAdapterInfo); {Do not localize}
|
|
Result := GetUniDirectionalAdapterInfo(pIPIfInfo, dwOutBufLen);
|
|
end;
|
|
|
|
function Impl_GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
|
|
begin
|
|
pOutBufLen := 0;
|
|
Result := ERROR_NOT_SUPPORTED;
|
|
end;
|
|
|
|
function Stub_GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
|
|
begin
|
|
@GetAdaptersInfo := FixupIPHelperStub('GetAdaptersInfo', @Impl_GetAdaptersInfo); {Do not localize}
|
|
Result := GetAdaptersInfo(pAdapterInfo, pOutBufLen);
|
|
end;
|
|
|
|
function Impl_GetAdaptersAddresses(Family: ULONG; Flags: DWORD; Reserved: PVOID; pAdapterAddresses: PIP_ADAPTER_ADDRESSES; var OutBufLen: ULONG): DWORD; stdcall;
|
|
begin
|
|
OutBufLen := 0;
|
|
Result := ERROR_NOT_SUPPORTED;
|
|
end;
|
|
|
|
function Stub_GetAdaptersAddresses(Family: ULONG; Flags: DWORD; Reserved: PVOID; pAdapterAddresses: PIP_ADAPTER_ADDRESSES; var OutBufLen: ULONG): DWORD; stdcall;
|
|
begin
|
|
@GetAdaptersAddresses := FixupIPHelperStub('GetAdaptersAddresses', @Impl_GetAdaptersAddresses); {Do not localize}
|
|
Result := GetAdaptersAddresses(Family, Flags, Reserved, pAdapterAddresses, OutBufLen);
|
|
end;
|
|
|
|
function Impl_ConvertLengthToIpv4Mask(MaskLength: ULONG; var Mask: ULONG): NETIO_STATUS; stdcall;
|
|
begin
|
|
// TODO: implement manually
|
|
Mask := INADDR_NONE;
|
|
if MaskLength > 32 then begin
|
|
Result := ERROR_INVALID_PARAMETER;
|
|
end else begin
|
|
Result := ERROR_NOT_SUPPORTED;
|
|
end;
|
|
end;
|
|
|
|
function Stub_ConvertLengthToIpv4Mask(MaskLength: ULONG; var Mask: ULONG): NETIO_STATUS; stdcall;
|
|
begin
|
|
@ConvertLengthToIpv4Mask := FixupIPHelperStub('ConvertLengthToIpv4Mask', @Impl_ConvertLengthToIpv4Mask); {Do not localize}
|
|
Result := ConvertLengthToIpv4Mask(MaskLength, Mask);
|
|
end;
|
|
|
|
procedure InitializeIPHelperStubs;
|
|
begin
|
|
GetIpAddrTable := Stub_GetIpAddrTable;
|
|
GetUniDirectionalAdapterInfo := Stub_GetUniDirectionalAdapterInfo;
|
|
GetAdaptersInfo := Stub_GetAdaptersInfo;
|
|
GetAdaptersAddresses := Stub_GetAdaptersAddresses;
|
|
ConvertLengthToIpv4Mask := Stub_ConvertLengthToIpv4Mask;
|
|
end;
|
|
|
|
procedure InitializeIPHelperAPI;
|
|
begin
|
|
if hIpHlpApi = 0 then begin
|
|
hIpHlpApi := SafeLoadLibrary(IPHLPAPI_DLL);
|
|
end;
|
|
end;
|
|
|
|
procedure UninitializeIPHelperAPI;
|
|
begin
|
|
if hIpHlpApi <> 0 then
|
|
begin
|
|
FreeLibrary(hIpHlpApi);
|
|
hIpHlpApi := 0;
|
|
end;
|
|
InitializeIPHelperStubs;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{ TIdStackWindows }
|
|
|
|
constructor TIdStackWindows.Create;
|
|
begin
|
|
inherited Create;
|
|
if not GStarted then begin
|
|
try
|
|
InitializeWinSock;
|
|
IdWship6.InitLibrary;
|
|
IdIDN.InitIDNLibrary;
|
|
{$IFDEF USE_IPHLPAPI}
|
|
InitializeIPHelperAPI;
|
|
{$ENDIF}
|
|
except
|
|
on E: Exception do begin
|
|
IndyRaiseOuterException(EIdStackInitializationFailed.Create(E.Message));
|
|
end;
|
|
end;
|
|
GStarted := True;
|
|
end;
|
|
GWindowsStack := Self;
|
|
end;
|
|
|
|
destructor TIdStackWindows.Destroy;
|
|
begin
|
|
//DLL Unloading and Cleanup is done at finalization
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TIdStackWindows.Accept(ASocket: TIdStackSocketHandle;
|
|
var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
|
|
var
|
|
LSize: Integer;
|
|
LAddr: SOCKADDR_STORAGE;
|
|
begin
|
|
LSize := SizeOf(LAddr);
|
|
Result := IdWinsock2.accept(ASocket, IdWinsock2.PSOCKADDR(@LAddr), @LSize);
|
|
if Result <> INVALID_SOCKET then begin
|
|
case LAddr.ss_family of
|
|
Id_PF_INET4: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
|
|
VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
|
|
VIPVersion := Id_IPv4;
|
|
end;
|
|
Id_PF_INET6: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
|
|
VPort := ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
|
|
VIPVersion := Id_IPv6;
|
|
end;
|
|
else begin
|
|
CloseSocket(Result);
|
|
Result := INVALID_SOCKET;
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdStackWindows.Bind(ASocket: TIdStackSocketHandle;
|
|
const AIP: string; const APort: TIdPort;
|
|
const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
|
|
var
|
|
LAddr: SOCKADDR_STORAGE;
|
|
LSize: Integer;
|
|
begin
|
|
FillChar(LAddr, SizeOf(LAddr), 0);
|
|
case AIPVersion of
|
|
Id_IPv4: begin
|
|
PSockAddrIn(@LAddr)^.sin_family := Id_PF_INET4;
|
|
if AIP <> '' then begin
|
|
TranslateStringToTInAddr(AIP, PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
|
|
end;
|
|
PSockAddrIn(@LAddr)^.sin_port := htons(APort);
|
|
LSize := SIZE_TSOCKADDRIN;
|
|
end;
|
|
Id_IPv6: begin
|
|
PSockAddrIn6(@LAddr)^.sin6_family := Id_PF_INET6;
|
|
if AIP <> '' then begin
|
|
TranslateStringToTInAddr(AIP, PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
|
|
end;
|
|
PSockAddrIn6(@LAddr)^.sin6_port := htons(APort);
|
|
LSize := SIZE_TSOCKADDRIN6;
|
|
end;
|
|
else begin
|
|
LSize := 0; // avoid warning
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
CheckForSocketError(IdWinsock2.bind(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
|
|
end;
|
|
|
|
function TIdStackWindows.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
|
|
begin
|
|
Result := CloseSocket(ASocket);
|
|
end;
|
|
|
|
function TIdStackWindows.HostByAddress(const AAddress: string;
|
|
const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
|
|
var
|
|
{$IFDEF UNICODE}
|
|
Hints: TAddrInfoW;
|
|
LAddrInfo: pAddrInfoW;
|
|
{$ELSE}
|
|
Hints: TAddrInfo;
|
|
LAddrInfo: pAddrInfo;
|
|
{$ENDIF}
|
|
RetVal: Integer;
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp: TIdPlatformString;
|
|
{$ENDIF}
|
|
begin
|
|
if not (AIPVersion in [Id_IPv4, Id_IPv6]) then begin
|
|
IPVersionUnsupported;
|
|
end;
|
|
|
|
// TODO: should this be calling getnameinfo() first and then getaddrinfo()
|
|
// to check for a malicious PTR record, like the other TIdStack classes do?
|
|
|
|
// TODO: use TranslateStringToTInAddr() instead of getaddrinfo() to convert
|
|
// the IP address to a sockaddr struct for getnameinfo(), like other TIdStack
|
|
// classes do.
|
|
|
|
FillChar(Hints, SizeOf(Hints), 0);
|
|
Hints.ai_family := IdIPFamily[AIPVersion];
|
|
Hints.ai_socktype := Integer(SOCK_STREAM);
|
|
Hints.ai_flags := AI_NUMERICHOST;
|
|
LAddrInfo := nil;
|
|
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp := TIdPlatformString(AAddress); // explicit convert to Ansi/Unicode
|
|
{$ENDIF}
|
|
|
|
RetVal := getaddrinfo(
|
|
{$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(AAddress){$ENDIF},
|
|
nil, @Hints, @LAddrInfo);
|
|
if RetVal <> 0 then begin
|
|
RaiseSocketError(gaiErrorToWsaError(RetVal));
|
|
end;
|
|
try
|
|
SetLength(
|
|
{$IFDEF STRING_UNICODE_MISMATCH}LTemp{$ELSE}Result{$ENDIF},
|
|
NI_MAXHOST);
|
|
RetVal := getnameinfo(
|
|
LAddrInfo.ai_addr, LAddrInfo.ai_addrlen,
|
|
{$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(Result){$ENDIF},
|
|
NI_MAXHOST, nil, 0, NI_NAMEREQD);
|
|
if RetVal <> 0 then begin
|
|
RaiseSocketError(gaiErrorToWsaError(RetVal));
|
|
end;
|
|
Result := {$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(Result){$ENDIF};
|
|
finally
|
|
freeaddrinfo(LAddrInfo);
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.ReadHostName: string;
|
|
var
|
|
// Note that there is no Unicode version of gethostname.
|
|
// Maybe use getnameinfo() instead?
|
|
LStr: AnsiString;
|
|
begin
|
|
SetLength(LStr, SIZE_HOSTNAME);
|
|
gethostname(PAnsiChar(LStr), SIZE_HOSTNAME);
|
|
//we have to specifically type cast a PAnsiChar to a string for D2009+.
|
|
//otherwise, we will get a warning about implicit typecast from AnsiString
|
|
//to string
|
|
Result := String(PAnsiChar(LStr));
|
|
end;
|
|
|
|
procedure TIdStackWindows.Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);
|
|
begin
|
|
CheckForSocketError(IdWinsock2.listen(ASocket, ABacklog));
|
|
end;
|
|
|
|
// RLebeau 12/16/09: MS Hotfix #971383 supposedly fixes a bug in Windows
|
|
// Server 2003 when client and server are running on the same machine.
|
|
// The bug can cause recv() to return 0 bytes prematurely even though data
|
|
// is actually pending. Uncomment the below define if you do not want to
|
|
// rely on the Hotfix always being installed. The workaround described by
|
|
// MS is to simply call recv() again to make sure data is really not pending.
|
|
//
|
|
{.$DEFINE IGNORE_KB971383_FIX}
|
|
|
|
function TIdStackWindows.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
|
|
const ABufferLength, AFlags: Integer) : Integer;
|
|
begin
|
|
Result := recv(ASocket, ABuffer, ABufferLength, AFlags);
|
|
{$IFDEF IGNORE_KB971383_FIX}
|
|
if Result = 0 then begin
|
|
Result := recv(ASocket, ABuffer, ABufferLength, AFlags);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdStackWindows.RecvFrom(const ASocket: TIdStackSocketHandle;
|
|
var VBuffer; const ALength, AFlags: Integer; var VIP: string;
|
|
var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer;
|
|
var
|
|
LSize: Integer;
|
|
LAddr: SOCKADDR_STORAGE;
|
|
begin
|
|
LSize := SizeOf(LAddr);
|
|
Result := IdWinsock2.recvfrom(ASocket, VBuffer, ALength, AFlags, IdWinsock2.PSOCKADDR(@LAddr), @LSize);
|
|
if Result >= 0 then
|
|
begin
|
|
case LAddr.ss_family of
|
|
Id_PF_INET4: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
|
|
VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
|
|
VIPVersion := Id_IPv4;
|
|
end;
|
|
Id_PF_INET6: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
|
|
VPort := ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
|
|
VIPVersion := Id_IPv6;
|
|
end;
|
|
else begin
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.WSSend(ASocket: TIdStackSocketHandle;
|
|
const ABuffer; const ABufferLength, AFlags: Integer): Integer;
|
|
begin
|
|
Result := CheckForSocketError(IdWinsock2.send(ASocket, ABuffer, ABufferLength, AFlags));
|
|
end;
|
|
|
|
procedure TIdStackWindows.WSSendTo(ASocket: TIdStackSocketHandle;
|
|
const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
|
|
const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
|
|
var
|
|
LAddr: SOCKADDR_STORAGE;
|
|
LSize: Integer;
|
|
begin
|
|
FillChar(LAddr, SizeOf(LAddr), 0);
|
|
case AIPVersion of
|
|
Id_IPv4: begin
|
|
PSockAddrIn(@LAddr)^.sin_family := Id_PF_INET4;
|
|
TranslateStringToTInAddr(AIP, PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
|
|
PSockAddrIn(@LAddr)^.sin_port := htons(APort);
|
|
LSize := SIZE_TSOCKADDRIN;
|
|
end;
|
|
Id_IPv6: begin
|
|
PSockAddrIn6(@LAddr)^.sin6_family := Id_PF_INET6;
|
|
TranslateStringToTInAddr(AIP, PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
|
|
PSockAddrIn6(@LAddr)^.sin6_port := htons(APort);
|
|
LSize := SIZE_TSOCKADDRIN6;
|
|
end;
|
|
else begin
|
|
LSize := 0; // avoid warning
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
LSize := IdWinsock2.sendto(ASocket, ABuffer, ABufferLength, AFlags, IdWinsock2.PSOCKADDR(@LAddr), LSize);
|
|
// TODO: call CheckForSocketError() here
|
|
if LSize = Id_SOCKET_ERROR then begin
|
|
// TODO: move this into RaiseLastSocketError() directly
|
|
if WSGetLastError() = Id_WSAEMSGSIZE then begin
|
|
raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig);
|
|
end else begin
|
|
RaiseLastSocketError;
|
|
end;
|
|
end
|
|
else if LSize <> ABufferLength then begin
|
|
raise EIdNotAllBytesSent.Create(RSNotAllBytesSent);
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.WSGetLastError: Integer;
|
|
begin
|
|
Result := WSAGetLastError;
|
|
if Result = -1073741251{STATUS_HOST_UNREACHABLE} then begin
|
|
Result := WSAEHOSTUNREACH;
|
|
end
|
|
end;
|
|
|
|
procedure TIdStackWindows.WSSetLastError(const AErr : Integer);
|
|
begin
|
|
WSASetLastError(AErr);
|
|
end;
|
|
|
|
function TIdStackWindows.WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
|
|
const AOverlapped: Boolean = False): TIdStackSocketHandle;
|
|
begin
|
|
if AOverlapped then begin
|
|
Result := WSASocket(AFamily, AStruct, AProtocol, nil, 0, WSA_FLAG_OVERLAPPED);
|
|
end else begin
|
|
Result := IdWinsock2.socket(AFamily, AStruct, AProtocol);
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.WSGetServByName(const AServiceName: string): TIdPort;
|
|
var
|
|
ps: PServEnt;
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
LTemp: AnsiString;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
LTemp := AnsiString(AServiceName); // explicit convert to Ansi
|
|
{$ENDIF}
|
|
ps := getservbyname(
|
|
PAnsiChar({$IFDEF STRING_IS_UNICODE}LTemp{$ELSE}AServiceName{$ENDIF}),
|
|
nil);
|
|
if ps <> nil then begin
|
|
Result := ntohs(ps^.s_port);
|
|
end else begin
|
|
try
|
|
Result := IndyStrToInt(AServiceName);
|
|
except
|
|
on EConvertError do begin
|
|
Result := 0;
|
|
IndyRaiseOuterException(EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdStackWindows.AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings);
|
|
type
|
|
// Note that there is no Unicode version of getservbyport.
|
|
PPAnsiCharArray = ^TPAnsiCharArray;
|
|
TPAnsiCharArray = packed array[0..(MaxInt div SizeOf(PAnsiChar))-1] of PAnsiChar;
|
|
var
|
|
ps: PServEnt;
|
|
i: integer;
|
|
p: PPAnsiCharArray;
|
|
begin
|
|
ps := getservbyport(htons(APortNumber), nil);
|
|
if ps = nil then begin
|
|
RaiseLastSocketError;
|
|
end;
|
|
AAddresses.BeginUpdate;
|
|
try
|
|
//we have to specifically type cast a PAnsiChar to a string for D2009+.
|
|
//otherwise, we will get a warning about implicit typecast from AnsiString
|
|
//to string
|
|
AAddresses.Add(String(ps^.s_name));
|
|
i := 0;
|
|
p := Pointer(ps^.s_aliases);
|
|
while p[i] <> nil do
|
|
begin
|
|
AAddresses.Add(String(p[i]));
|
|
Inc(i);
|
|
end;
|
|
finally
|
|
AAddresses.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.HostToNetwork(AValue: UInt16): UInt16;
|
|
begin
|
|
Result := htons(AValue);
|
|
end;
|
|
|
|
function TIdStackWindows.NetworkToHost(AValue: UInt16): UInt16;
|
|
begin
|
|
Result := ntohs(AValue);
|
|
end;
|
|
|
|
function TIdStackWindows.HostToNetwork(AValue: UInt32): UInt32;
|
|
begin
|
|
Result := htonl(AValue);
|
|
end;
|
|
|
|
function TIdStackWindows.NetworkToHost(AValue: UInt32): UInt32;
|
|
begin
|
|
Result := ntohl(AValue);
|
|
end;
|
|
|
|
function TIdStackWindows.HostToNetwork(AValue: TIdUInt64): TIdUInt64;
|
|
var
|
|
LParts: TIdUInt64Parts;
|
|
L: UInt32;
|
|
begin
|
|
LParts.QuadPart := AValue{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF};
|
|
L := htonl(LParts.HighPart);
|
|
LParts.HighPart := htonl(LParts.LowPart);
|
|
LParts.LowPart := L;
|
|
Result{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF} := LParts.QuadPart;
|
|
end;
|
|
|
|
function TIdStackWindows.NetworkToHost(AValue: TIdUInt64): TIdUInt64;
|
|
var
|
|
LParts: TIdUInt64Parts;
|
|
L: UInt32;
|
|
begin
|
|
LParts.QuadPart := AValue{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF};
|
|
L := ntohl(LParts.HighPart);
|
|
LParts.HighPart := ntohl(LParts.LowPart);
|
|
LParts.LowPart := L;
|
|
Result{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF} := LParts.QuadPart;
|
|
end;
|
|
|
|
procedure TIdStackWindows.GetLocalAddressList(AAddresses: TIdStackLocalAddressList);
|
|
{$IFNDEF USE_IPHLPAPI}
|
|
{$IFNDEF WINCE}
|
|
type
|
|
TaPInAddr = array[0..250] of PInAddr;
|
|
PaPInAddr = ^TaPInAddr;
|
|
TaPIn6Addr = array[0..250] of PIn6Addr;
|
|
PaPIn6Addr = ^TaPIn6Addr;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF USE_IPHLPAPI}
|
|
|
|
function IPv4MaskLengthToString(MaskLength: ULONG): String;
|
|
var
|
|
Mask: ULONG;
|
|
begin
|
|
if ConvertLengthToIpv4Mask(MaskLength, Mask) = ERROR_SUCCESS then begin
|
|
Result := TranslateTInAddrToString(Mask, Id_IPv4);
|
|
end else begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
procedure GetIPv4SubNetMasks(ASubNetMasks: TStrings);
|
|
var
|
|
Ret: DWORD;
|
|
BufLen: ULONG;
|
|
Table: PMIB_IPADDRTABLE;
|
|
pRow: PMIB_IPADDRROW;
|
|
I: ULONG;
|
|
begin
|
|
BufLen := 0;
|
|
Table := nil;
|
|
try
|
|
repeat
|
|
Ret := GetIpAddrTable(Table, BufLen, FALSE);
|
|
case Ret of
|
|
ERROR_SUCCESS:
|
|
begin
|
|
if BufLen = 0 then begin
|
|
Exit;
|
|
end;
|
|
Break;
|
|
end;
|
|
ERROR_NOT_SUPPORTED:
|
|
Exit;
|
|
ERROR_INSUFFICIENT_BUFFER:
|
|
ReallocMem(Table, BufLen);
|
|
else
|
|
SetLastError(Ret);
|
|
IndyRaiseLastError;
|
|
end;
|
|
until False;
|
|
|
|
if Ret = ERROR_SUCCESS then
|
|
begin
|
|
if Table^.dwNumEntries > 0 then
|
|
begin
|
|
pRow := @(Table^.table[0]);
|
|
for I := 0 to Table^.dwNumEntries-1 do begin
|
|
ASubNetMasks.Add(TranslateTInAddrToString(pRow^.dwAddr, Id_IPv4) + '=' + TranslateTInAddrToString(pRow^.dwMask, Id_IPv4));
|
|
Inc(pRow);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(Table);
|
|
end;
|
|
end;
|
|
|
|
function GetLocalAddressesByAdaptersAddresses: Boolean;
|
|
var
|
|
Ret: DWORD;
|
|
BufLen: ULONG;
|
|
Adapter, Adapters: PIP_ADAPTER_ADDRESSES;
|
|
UnicastAddr: PIP_ADAPTER_UNICAST_ADDRESS;
|
|
IPAddr: string;
|
|
SubNetStr: String;
|
|
SubNetMasks: TStringList;
|
|
begin
|
|
// assume True unless ERROR_NOT_SUPPORTED is reported...
|
|
Result := True;
|
|
|
|
// MSDN says:
|
|
// The recommended method of calling the GetAdaptersAddresses function is
|
|
// to pre-allocate a 15KB working buffer pointed to by the AdapterAddresses
|
|
// parameter. On typical computers, this dramatically reduces the chances
|
|
// that the GetAdaptersAddresses function returns ERROR_BUFFER_OVERFLOW,
|
|
// which would require calling GetAdaptersAddresses function multiple times.
|
|
|
|
BufLen := 1024*15;
|
|
GetMem(Adapters, BufLen);
|
|
try
|
|
repeat
|
|
// TODO: include GAA_FLAG_INCLUDE_PREFIX on XPSP1+?
|
|
// TODO: include GAA_FLAG_INCLUDE_ALL_INTERFACES on Vista+?
|
|
Ret := GetAdaptersAddresses(PF_UNSPEC, GAA_FLAG_SKIP_ANYCAST or GAA_FLAG_SKIP_MULTICAST or GAA_FLAG_SKIP_DNS_SERVER or GAA_FLAG_SKIP_FRIENDLY_NAME, nil, Adapters, BufLen);
|
|
case Ret of
|
|
ERROR_SUCCESS:
|
|
begin
|
|
// Windows CE versions earlier than 4.1 may return ERROR_SUCCESS and
|
|
// BufLen=0 if no adapter info is available, instead of returning
|
|
// ERROR_NO_DATA as documented...
|
|
if BufLen = 0 then begin
|
|
Exit;
|
|
end;
|
|
Break;
|
|
end;
|
|
ERROR_NOT_SUPPORTED:
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
ERROR_NO_DATA,
|
|
ERROR_ADDRESS_NOT_ASSOCIATED:
|
|
Exit;
|
|
ERROR_BUFFER_OVERFLOW:
|
|
ReallocMem(Adapters, BufLen);
|
|
else
|
|
SetLastError(Ret);
|
|
IndyRaiseLastError;
|
|
end;
|
|
until False;
|
|
|
|
if Ret = ERROR_SUCCESS then
|
|
begin
|
|
SubNetMasks := nil;
|
|
try
|
|
AAddresses.BeginUpdate;
|
|
try
|
|
Adapter := Adapters;
|
|
repeat
|
|
if (Adapter.IfType <> IF_TYPE_SOFTWARE_LOOPBACK) and
|
|
((Adapter.Flags and IP_ADAPTER_RECEIVE_ONLY) = 0) then
|
|
begin
|
|
UnicastAddr := Adapter^.FirstUnicastAddress;
|
|
while UnicastAddr <> nil do
|
|
begin
|
|
if UnicastAddr^.DadState = IpDadStatePreferred then
|
|
begin
|
|
case UnicastAddr^.Address.lpSockaddr.sin_family of
|
|
AF_INET: begin
|
|
IPAddr := TranslateTInAddrToString(PSockAddrIn(UnicastAddr^.Address.lpSockaddr)^.sin_addr, Id_IPv4);
|
|
// The OnLinkPrefixLength member is only available on Windows Vista and later
|
|
if IndyCheckWindowsVersion(6) then begin
|
|
SubNetStr := IPv4MaskLengthToString(UnicastAddr^.OnLinkPrefixLength);
|
|
end else
|
|
begin
|
|
// TODO: on XP SP1+, can the subnet mask be determined
|
|
// by analyzing the Adapter's Prefix list without resorting
|
|
// to reading the Registry?
|
|
if SubNetMasks = nil then
|
|
begin
|
|
SubNetMasks := TStringList.Create;
|
|
GetIPv4SubNetMasks(SubNetMasks);
|
|
end;
|
|
SubNetStr := SubNetMasks.Values[IPAddr];
|
|
end;
|
|
TIdStackLocalAddressIPv4.Create(AAddresses, IPAddr, SubNetStr);
|
|
end;
|
|
AF_INET6: begin
|
|
TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString(PSockAddrIn6(UnicastAddr^.Address.lpSockaddr)^.sin6_addr, Id_IPv6));
|
|
end;
|
|
end;
|
|
end;
|
|
UnicastAddr := UnicastAddr^.Next;
|
|
end;
|
|
end;
|
|
Adapter := Adapter^.Next;
|
|
until Adapter = nil;
|
|
finally
|
|
AAddresses.EndUpdate;
|
|
end;
|
|
finally
|
|
SubNetMasks.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(Adapters);
|
|
end;
|
|
end;
|
|
|
|
procedure GetUniDirAddresseses(AUniDirAddresses: TStrings);
|
|
var
|
|
Ret: DWORD;
|
|
BufLen: ULONG;
|
|
Adapters: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS;
|
|
pUniDirAddr: PInAddr;
|
|
I: ULONG;
|
|
begin
|
|
BufLen := 1024*15;
|
|
GetMem(Adapters, BufLen);
|
|
try
|
|
repeat
|
|
Ret := GetUniDirectionalAdapterInfo(Adapters, BufLen);
|
|
case Ret of
|
|
ERROR_SUCCESS:
|
|
begin
|
|
if BufLen = 0 then begin
|
|
Exit;
|
|
end;
|
|
Break;
|
|
end;
|
|
ERROR_NOT_SUPPORTED,
|
|
ERROR_NO_DATA:
|
|
Exit;
|
|
ERROR_MORE_DATA:
|
|
ReallocMem(Adapters, BufLen);
|
|
else
|
|
SetLastError(Ret);
|
|
IndyRaiseLastError;
|
|
end;
|
|
until False;
|
|
|
|
if Ret = ERROR_SUCCESS then
|
|
begin
|
|
if Adapters^.NumAdapters > 0 then
|
|
begin
|
|
pUniDirAddr := @(Adapters^.Address[0]);
|
|
for I := 0 to Adapters^.NumAdapters-1 do begin
|
|
AUniDirAddresses.Add(TranslateTInAddrToString(pUniDirAddr^, Id_IPv4));
|
|
Inc(pUniDirAddr);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(Adapters);
|
|
end;
|
|
end;
|
|
|
|
procedure GetLocalAddressesByAdaptersInfo;
|
|
var
|
|
Ret: DWORD;
|
|
BufLen: ULONG;
|
|
UniDirAddresses: TStringList;
|
|
Adapter, Adapters: PIP_ADAPTER_INFO;
|
|
IPAddr: PIP_ADDR_STRING;
|
|
IPStr: String;
|
|
begin
|
|
BufLen := 1024*15;
|
|
GetMem(Adapters, BufLen);
|
|
try
|
|
repeat
|
|
Ret := GetAdaptersInfo(Adapters, BufLen);
|
|
case Ret of
|
|
ERROR_SUCCESS:
|
|
begin
|
|
// Windows CE versions earlier than 4.1 may return ERROR_SUCCESS and
|
|
// BufLen=0 if no adapter info is available, instead of returning
|
|
// ERROR_NO_DATA as documented...
|
|
if BufLen = 0 then begin
|
|
Exit;
|
|
end;
|
|
Break;
|
|
end;
|
|
ERROR_NOT_SUPPORTED,
|
|
ERROR_NO_DATA:
|
|
Exit;
|
|
ERROR_BUFFER_OVERFLOW:
|
|
ReallocMem(Adapters, BufLen);
|
|
else
|
|
SetLastError(Ret);
|
|
IndyRaiseLastError;
|
|
end;
|
|
until False;
|
|
|
|
if Ret = ERROR_SUCCESS then
|
|
begin
|
|
// on XP and later, GetAdaptersInfo() includes uni-directional adapters.
|
|
// Need to use GetUniDirectionalAdapterInfo() to filter them out of the
|
|
// list ...
|
|
|
|
if IndyCheckWindowsVersion(5, 1) then begin
|
|
UniDirAddresses := TStringList.Create;
|
|
end else begin
|
|
UniDirAddresses := nil;
|
|
end;
|
|
try
|
|
if UniDirAddresses <> nil then begin
|
|
GetUniDirAddresseses(UniDirAddresses);
|
|
end;
|
|
AAddresses.BeginUpdate;
|
|
try
|
|
Adapter := Adapters;
|
|
repeat
|
|
IPAddr := @(Adapter^.IpAddressList);
|
|
repeat
|
|
IPStr := String(IPAddr^.IpAddress.S);
|
|
if (IPStr <> '') and (IPStr <> '0.0.0.0') then
|
|
begin
|
|
if UniDirAddresses <> nil then begin
|
|
if UniDirAddresses.IndexOf(IPStr) <> -1 then begin
|
|
IPAddr := IPAddr^.Next;
|
|
Continue;
|
|
end;
|
|
end;
|
|
TIdStackLocalAddressIPv4.Create(AAddresses, IPStr, String(IPAddr^.IpMask.S));
|
|
end;
|
|
IPAddr := IPAddr^.Next;
|
|
until IPAddr = nil;
|
|
Adapter := Adapter^.Next;
|
|
until Adapter = nil;
|
|
finally
|
|
AAddresses.EndUpdate;
|
|
end;
|
|
finally
|
|
UniDirAddresses.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(Adapters);
|
|
end;
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
var
|
|
{$IFDEF UNICODE}
|
|
Hints: TAddrInfoW;
|
|
LAddrList, LAddrInfo: pAddrInfoW;
|
|
{$ELSE}
|
|
Hints: TAddrInfo;
|
|
LAddrList, LAddrInfo: pAddrInfo;
|
|
{$ENDIF}
|
|
RetVal: Integer;
|
|
LHostName: String;
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp: TIdPlatformString;
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
begin
|
|
// Using gethostname() and gethostbyname/getaddrinfo() may not always return
|
|
// just the machine's IP addresses. Technically speaking, they will return
|
|
// the local hostname, and then return the address(es) to which that hostname
|
|
// resolves. It is possible for a machine to (a) be configured such that its
|
|
// name does not resolve to an IP, or (b) be configured such that its name
|
|
// resolves to multiple IPs, only one of which belongs to the local machine.
|
|
// For better results, we should use the Win32 API GetAdaptersInfo() and/or
|
|
// GetAdaptersAddresses() functions instead. GetAdaptersInfo() only supports
|
|
// IPv4, but GetAdaptersAddresses() supports both IPv4 and IPv6...
|
|
|
|
{$IFDEF USE_IPHLPAPI}
|
|
|
|
// try GetAdaptersAddresses() first, then fall back to GetAdaptersInfo()...
|
|
if not GetLocalAddressesByAdaptersAddresses then begin
|
|
GetLocalAddressesByAdaptersInfo;
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
LHostName := HostName;
|
|
|
|
ZeroMemory(@Hints, SIZE_TADDRINFO);
|
|
Hints.ai_family := PF_UNSPEC; // returns both IPv4 and IPv6 addresses
|
|
Hints.ai_socktype := SOCK_STREAM;
|
|
LAddrList := nil;
|
|
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp := TIdPlatformString(LHostName); // explicit convert to Ansi/Unicode
|
|
{$ENDIF}
|
|
|
|
RetVal := getaddrinfo(
|
|
{$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(LHostName){$ENDIF},
|
|
nil, @Hints, @LAddrList);
|
|
if RetVal <> 0 then begin
|
|
RaiseSocketError(gaiErrorToWsaError(RetVal));
|
|
end;
|
|
try
|
|
AAddresses.BeginUpdate;
|
|
try
|
|
LAddrInfo := LAddrList;
|
|
repeat
|
|
case LAddrInfo^.ai_addr^.sa_family of
|
|
Id_AF_INET: begin
|
|
TIdStackLocalAddressIPv4.Create(AAddresses, TranslateTInAddrToString(PSockAddrIn(LAddrInfo^.ai_addr)^.sin_addr, Id_IPv4), ''); // TODO: SubNet
|
|
end;
|
|
Id_AF_INET6: begin
|
|
TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString(PSockAddrIn6(LAddrInfo^.ai_addr)^.sin6_addr, Id_IPv6));
|
|
end;
|
|
end;
|
|
LAddrInfo := LAddrInfo^.ai_next;
|
|
until LAddrInfo = nil;
|
|
finally
|
|
AAddresses.EndUpdate;
|
|
end;
|
|
finally
|
|
freeaddrinfo(LAddrList);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TIdStackVersionWinsock }
|
|
|
|
function TIdStackWindows.WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer;
|
|
begin
|
|
Result := Shutdown(ASocket, AHow);
|
|
end;
|
|
|
|
procedure TIdStackWindows.GetSocketName(ASocket: TIdStackSocketHandle;
|
|
var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
|
|
var
|
|
LSize: Integer;
|
|
LAddr: SOCKADDR_STORAGE;
|
|
begin
|
|
LSize := SizeOf(LAddr);
|
|
CheckForSocketError(getsockname(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
|
|
case LAddr.ss_family of
|
|
Id_PF_INET4: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
|
|
VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
|
|
VIPVersion := Id_IPv4;
|
|
end;
|
|
Id_PF_INET6: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
|
|
VPort := Ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
|
|
VIPVersion := Id_IPv6;
|
|
end;
|
|
else begin
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TIdSocketListWindows }
|
|
|
|
procedure TIdSocketListWindows.Add(AHandle: TIdStackSocketHandle);
|
|
begin
|
|
Lock;
|
|
try
|
|
if FFDSet.fd_count >= FD_SETSIZE then begin
|
|
raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
|
|
end;
|
|
FFDSet.fd_array[FFDSet.fd_count] := AHandle;
|
|
Inc(FFDSet.fd_count);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdSocketListWindows.Clear;
|
|
begin
|
|
Lock;
|
|
try
|
|
fd_zero(FFDSet);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TIdSocketListWindows.ContainsSocket(AHandle: TIdStackSocketHandle): Boolean;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := fd_isset(AHandle, FFDSet);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TIdSocketListWindows.Count: Integer;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FFDSet.fd_count;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TIdSocketListWindows.GetItem(AIndex: Integer): TIdStackSocketHandle;
|
|
begin
|
|
Result := 0;
|
|
Lock;
|
|
try
|
|
//We can't redefine AIndex to be a UInt32 because the libc Interface
|
|
//and DotNET define it as a LongInt. OS/2 defines it as a UInt16.
|
|
if (AIndex >= 0) and (u_int(AIndex) < FFDSet.fd_count) then begin
|
|
Result := FFDSet.fd_array[AIndex];
|
|
end else begin
|
|
raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
|
|
end;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdSocketListWindows.Remove(AHandle: TIdStackSocketHandle);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Lock;
|
|
try
|
|
{
|
|
IMPORTANT!!!
|
|
|
|
Sometimes, there may not be a member of the FDSET. If you attempt to "remove"
|
|
an item, the loop would execute once.
|
|
}
|
|
if FFDSet.fd_count > 0 then
|
|
begin
|
|
for i:= 0 to FFDSet.fd_count - 1 do
|
|
begin
|
|
if FFDSet.fd_array[i] = AHandle then
|
|
begin
|
|
Dec(FFDSet.fd_count);
|
|
FFDSet.fd_array[i] := FFDSet.fd_array[FFDSet.fd_count];
|
|
FFDSet.fd_array[FFDSet.fd_count] := 0; //extra purity
|
|
Break;
|
|
end;//if found
|
|
end;
|
|
end;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.WSTranslateSocketErrorMsg(const AErr: Integer): string;
|
|
begin
|
|
if AErr = WSAHOST_NOT_FOUND then begin
|
|
Result := IndyFormat(RSStackError, [AErr, RSStackHOST_NOT_FOUND]);
|
|
end else begin
|
|
Result := inherited WSTranslateSocketErrorMsg(AErr);
|
|
end;
|
|
end;
|
|
|
|
function TIdSocketListWindows.SelectRead(const ATimeout: Integer): Boolean;
|
|
var
|
|
LSet: TFDSet;
|
|
begin
|
|
// Windows updates this structure on return, so we need to copy it each time we need it
|
|
GetFDSet(LSet);
|
|
FDSelect(@LSet, nil, nil, ATimeout);
|
|
Result := LSet.fd_count > 0;
|
|
end;
|
|
|
|
class function TIdSocketListWindows.FDSelect(AReadSet, AWriteSet,
|
|
AExceptSet: PFDSet; const ATimeout: Integer): Boolean;
|
|
var
|
|
LResult: Integer;
|
|
LTime: TTimeVal;
|
|
LTimePtr: PTimeVal;
|
|
begin
|
|
if ATimeout = IdTimeoutInfinite then begin
|
|
LTimePtr := nil;
|
|
end else begin
|
|
LTime.tv_sec := ATimeout div 1000;
|
|
LTime.tv_usec := (ATimeout mod 1000) * 1000;
|
|
LTimePtr := @LTime;
|
|
end;
|
|
LResult := IdWinsock2.select(0, AReadSet, AWriteSet, AExceptSet, LTimePtr);
|
|
//TODO: Remove this cast
|
|
Result := GStack.CheckForSocketError(LResult) > 0;
|
|
end;
|
|
|
|
function TIdSocketListWindows.SelectReadList(var VSocketList: TIdSocketList;
|
|
const ATimeout: Integer): Boolean;
|
|
var
|
|
LSet: TFDSet;
|
|
begin
|
|
// Windows updates this structure on return, so we need to copy it each time we need it
|
|
GetFDSet(LSet);
|
|
FDSelect(@LSet, nil, nil, ATimeout);
|
|
Result := LSet.fd_count > 0;
|
|
if Result then
|
|
begin
|
|
if VSocketList = nil then begin
|
|
VSocketList := TIdSocketList.CreateSocketList;
|
|
end;
|
|
TIdSocketListWindows(VSocketList).SetFDSet(LSet);
|
|
end;
|
|
end;
|
|
|
|
class function TIdSocketListWindows.Select(AReadList, AWriteList,
|
|
AExceptList: TIdSocketList; const ATimeout: Integer): Boolean;
|
|
var
|
|
LReadSet: TFDSet;
|
|
LWriteSet: TFDSet;
|
|
LExceptSet: TFDSet;
|
|
LPReadSet: PFDSet;
|
|
LPWriteSet: PFDSet;
|
|
LPExceptSet: PFDSet;
|
|
|
|
procedure ReadSet(AList: TIdSocketList; var ASet: TFDSet; var APSet: PFDSet);
|
|
begin
|
|
if AList <> nil then begin
|
|
TIdSocketListWindows(AList).GetFDSet(ASet);
|
|
APSet := @ASet;
|
|
end else begin
|
|
APSet := nil;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ReadSet(AReadList, LReadSet, LPReadSet);
|
|
ReadSet(AWriteList, LWriteSet, LPWriteSet);
|
|
ReadSet(AExceptList, LExceptSet, LPExceptSet);
|
|
|
|
Result := FDSelect(LPReadSet, LPWriteSet, LPExceptSet, ATimeout);
|
|
|
|
if AReadList <> nil then begin
|
|
TIdSocketListWindows(AReadList).SetFDSet(LReadSet);
|
|
end;
|
|
if AWriteList <> nil then begin
|
|
TIdSocketListWindows(AWriteList).SetFDSet(LWriteSet);
|
|
end;
|
|
if AExceptList <> nil then begin
|
|
TIdSocketListWindows(AExceptList).SetFDSet(LExceptSet);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdSocketListWindows.SetFDSet(var VSet: TFDSet);
|
|
begin
|
|
Lock;
|
|
try
|
|
FFDSet := VSet;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdSocketListWindows.GetFDSet(var VSet: TFDSet);
|
|
begin
|
|
Lock;
|
|
try
|
|
VSet := FFDSet;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdStackWindows.SetBlocking(ASocket: TIdStackSocketHandle;
|
|
const ABlocking: Boolean);
|
|
var
|
|
LValue: UInt32;
|
|
begin
|
|
LValue := UInt32(not ABlocking);
|
|
CheckForSocketError(ioctlsocket(ASocket, FIONBIO, LValue));
|
|
end;
|
|
|
|
function TIdSocketListWindows.Clone: TIdSocketList;
|
|
begin
|
|
Result := TIdSocketListWindows.Create;
|
|
try
|
|
Lock;
|
|
try
|
|
TIdSocketListWindows(Result).SetFDSet(FFDSet);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
except
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.WouldBlock(const AResult: Integer): Boolean;
|
|
begin
|
|
Result := CheckForSocketError(AResult, [WSAEWOULDBLOCK]) <> 0;
|
|
end;
|
|
|
|
function TIdStackWindows.HostByName(const AHostName: string;
|
|
const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
|
|
{$IFNDEF WINCE}
|
|
type
|
|
TaPInAddr = array[0..250] of PInAddr;
|
|
PaPInAddr = ^TaPInAddr;
|
|
{$ENDIF}
|
|
var
|
|
{$IFDEF UNICODE}
|
|
LAddrInfo: pAddrInfoW;
|
|
Hints: TAddrInfoW;
|
|
{$ELSE}
|
|
LAddrInfo: pAddrInfo;
|
|
Hints: TAddrInfo;
|
|
{$ENDIF}
|
|
RetVal: Integer;
|
|
LHostName: String;
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp: TIdPlatformString;
|
|
{$ENDIF}
|
|
begin
|
|
if not (AIPVersion in [Id_IPv4, Id_IPv6]) then begin
|
|
IPVersionUnsupported;
|
|
end;
|
|
|
|
ZeroMemory(@Hints, SIZE_TADDRINFO);
|
|
Hints.ai_family := IdIPFamily[AIPVersion];
|
|
Hints.ai_socktype := SOCK_STREAM;
|
|
LAddrInfo := nil;
|
|
|
|
if UseIDNAPI then begin
|
|
LHostName := IDNToPunnyCode(
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
AHostName
|
|
{$ELSE}
|
|
TIdUnicodeString(AHostName) // explicit convert to Unicode
|
|
{$ENDIF}
|
|
);
|
|
end else begin
|
|
LHostName := AHostName;
|
|
end;
|
|
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp := TIdPlatformString(LHostName); // explicit convert to Ansi/Unicode
|
|
{$ENDIF}
|
|
|
|
RetVal := getaddrinfo(
|
|
{$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(LHostName){$ENDIF},
|
|
nil, @Hints, @LAddrInfo);
|
|
if RetVal <> 0 then begin
|
|
RaiseSocketError(gaiErrorToWsaError(RetVal));
|
|
end;
|
|
try
|
|
if AIPVersion = Id_IPv4 then begin
|
|
Result := TranslateTInAddrToString(PSockAddrIn(LAddrInfo^.ai_addr)^.sin_addr, Id_IPv4)
|
|
end else begin
|
|
Result := TranslateTInAddrToString(PSockAddrIn6(LAddrInfo^.ai_addr)^.sin6_addr, Id_IPv6);
|
|
end;
|
|
finally
|
|
freeaddrinfo(LAddrInfo);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdStackWindows.Connect(const ASocket: TIdStackSocketHandle;
|
|
const AIP: string; const APort: TIdPort;
|
|
const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
|
|
var
|
|
LAddr: SOCKADDR_STORAGE;
|
|
LSize: Integer;
|
|
begin
|
|
FillChar(LAddr, SizeOf(LAddr), 0);
|
|
case AIPVersion of
|
|
Id_IPv4: begin
|
|
PSockAddrIn(@LAddr)^.sin_family := Id_PF_INET4;
|
|
TranslateStringToTInAddr(AIP, PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
|
|
PSockAddrIn(@LAddr)^.sin_port := htons(APort);
|
|
LSize := SIZE_TSOCKADDRIN;
|
|
end;
|
|
Id_IPv6: begin
|
|
PSockAddrIn6(@LAddr)^.sin6_family := Id_PF_INET6;
|
|
TranslateStringToTInAddr(AIP, PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
|
|
PSockAddrIn6(@LAddr)^.sin6_port := htons(APort);
|
|
LSize := SIZE_TSOCKADDRIN6;
|
|
end;
|
|
else begin
|
|
LSize := 0; // avoid warning
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
CheckForSocketError(IdWinsock2.connect(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
|
|
end;
|
|
|
|
procedure TIdStackWindows.GetPeerName(ASocket: TIdStackSocketHandle;
|
|
var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
|
|
var
|
|
LSize: Integer;
|
|
LAddr: SOCKADDR_STORAGE;
|
|
begin
|
|
LSize := SizeOf(LAddr);
|
|
CheckForSocketError(IdWinsock2.getpeername(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
|
|
case LAddr.ss_family of
|
|
Id_PF_INET4: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
|
|
VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
|
|
VIPVersion := Id_IPv4;
|
|
end;
|
|
Id_PF_INET6: begin
|
|
VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
|
|
VPort := ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
|
|
VIPVersion := Id_IPv6;
|
|
end;
|
|
else begin
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdStackWindows.Disconnect(ASocket: TIdStackSocketHandle);
|
|
begin
|
|
// Windows uses Id_SD_Send, Linux should use Id_SD_Both
|
|
WSShutdown(ASocket, Id_SD_Send);
|
|
// SO_LINGER is false - socket may take a little while to actually close after this
|
|
WSCloseSocket(ASocket);
|
|
end;
|
|
|
|
procedure TIdStackWindows.{$IFDEF VCL_XE3_OR_ABOVE}GetSocketOption{$ELSE}WSGetSocketOption{$ENDIF}
|
|
(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
|
|
var AOptVal; var AOptLen: Integer);
|
|
begin
|
|
CheckForSocketError(
|
|
getsockopt(ASocket, ALevel, AOptName,
|
|
{$IFNDEF HAS_PAnsiChar}
|
|
// TODO: use TPtrWrapper here?
|
|
{PAnsiChar}@AOptVal
|
|
{$ELSE}
|
|
PAnsiChar(@AOptVal)
|
|
{$ENDIF},
|
|
AOptLen
|
|
)
|
|
);
|
|
end;
|
|
|
|
procedure TIdStackWindows.{$IFDEF VCL_XE3_OR_ABOVE}SetSocketOption{$ELSE}WSSetSocketOption{$ENDIF}
|
|
(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
|
|
const AOptVal; const AOptLen: Integer);
|
|
begin
|
|
CheckForSocketError(
|
|
setsockopt(ASocket, ALevel, Aoptname,
|
|
{$IFNDEF HAS_PAnsiChar}
|
|
// TODO: use TPtrWrapper here?
|
|
{PAnsiChar}@AOptVal
|
|
{$ELSE}
|
|
PAnsiChar(@AOptVal)
|
|
{$ENDIF},
|
|
AOptLen
|
|
)
|
|
);
|
|
end;
|
|
|
|
{
|
|
based on
|
|
http://groups.google.com/groups?q=Winsock2+Delphi+protocol&hl=en&lr=&ie=UTF-8&oe=utf-8&selm=3cebe697_2%40dnews&rnum=9
|
|
}
|
|
function TIdStackWindows.SupportsIPv6: Boolean;
|
|
var
|
|
LLen : DWORD;
|
|
LPInfo, LPCurPtr: LPWSAPROTOCOL_INFO;
|
|
LCount : Integer;
|
|
i : Integer;
|
|
begin
|
|
Result := False;
|
|
LPInfo := nil;
|
|
try
|
|
LLen := 0;
|
|
// Note: WSAEnumProtocols returns -1 when it is just called to get the needed Buffer Size!
|
|
repeat
|
|
LCount := IdWinsock2.WSAEnumProtocols(nil, LPInfo, LLen);
|
|
if LCount = SOCKET_ERROR then
|
|
begin
|
|
if WSAGetLastError() <> WSAENOBUFS then begin
|
|
Exit;
|
|
end;
|
|
ReallocMem(LPInfo, LLen);
|
|
end else begin
|
|
Break;
|
|
end;
|
|
until False;
|
|
|
|
if LCount > 0 then
|
|
begin
|
|
LPCurPtr := LPInfo;
|
|
for i := 0 to LCount-1 do
|
|
begin
|
|
if LPCurPtr^.iAddressFamily = AF_INET6 then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
Inc(LPCurPtr);
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(LPInfo);
|
|
end;
|
|
end;
|
|
|
|
function TIdStackWindows.IOControl(const s: TIdStackSocketHandle;
|
|
const cmd: UInt32; var arg: UInt32): Integer;
|
|
begin
|
|
Result := IdWinsock2.ioctlsocket(s, cmd, arg);
|
|
end;
|
|
|
|
procedure TIdStackWindows.WSQuerryIPv6Route(ASocket: TIdStackSocketHandle;
|
|
const AIP: String; const APort: TIdPort; var VSource; var VDest);
|
|
var
|
|
Llocalif : TSockAddrIn6;
|
|
LAddr : TSockAddrIn6;
|
|
Bytes : DWORD;
|
|
begin
|
|
//make our LAddrInfo structure
|
|
FillChar(LAddr, SizeOf(LAddr), 0);
|
|
LAddr.sin6_family := AF_INET6;
|
|
TranslateStringToTInAddr(AIP, LAddr.sin6_addr, Id_IPv6);
|
|
Move(LAddr.sin6_addr, VDest, SizeOf(in6_addr));
|
|
LAddr.sin6_port := htons(APort);
|
|
// Find out which local interface for the destination
|
|
// RLebeau: in XE4+, PDWORD is NOT defined as ^DWORD, so we have to use a type-cast!
|
|
CheckForSocketError(WSAIoctl(ASocket, SIO_ROUTING_INTERFACE_QUERY,
|
|
@LAddr, SizeOf(LAddr), @Llocalif, SizeOf(Llocalif), PDWORD(@Bytes), nil, nil));
|
|
Move(Llocalif.sin6_addr, VSource, SizeOf(in6_addr));
|
|
end;
|
|
|
|
procedure TIdStackWindows.WriteChecksum(s: TIdStackSocketHandle;
|
|
var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
|
|
const APort: TIdPort; const AIPVersion: TIdIPVersion);
|
|
begin
|
|
case AIPVersion of
|
|
Id_IPv4 : CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(VBuffer)), VBuffer, AOffset);
|
|
Id_IPv6 : WriteChecksumIPv6(s, VBuffer, AOffset, AIP, APort);
|
|
else
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdStackWindows.WriteChecksumIPv6(s: TIdStackSocketHandle;
|
|
var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
|
|
const APort: TIdPort);
|
|
var
|
|
LSource : TIdIn6Addr;
|
|
LDest : TIdIn6Addr;
|
|
LTmp : TIdBytes;
|
|
LIdx : Integer;
|
|
LC : UInt32;
|
|
{
|
|
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
| |
|
|
+ +
|
|
| |
|
|
+ Source Address +
|
|
| |
|
|
+ +
|
|
| |
|
|
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
| |
|
|
+ +
|
|
| |
|
|
+ Destination Address +
|
|
| |
|
|
+ +
|
|
| |
|
|
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
| Upper-Layer Packet Length |
|
|
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
| zero | Next Header |
|
|
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
}
|
|
begin
|
|
WSQuerryIPv6Route(s, AIP, APort, LSource, LDest);
|
|
SetLength(LTmp, 40+Length(VBuffer));
|
|
|
|
//16
|
|
Move(LSource, LTmp[0], SIZE_TSOCKADDRIN6);
|
|
LIdx := SIZE_TSOCKADDRIN6;
|
|
//32
|
|
Move(LDest, LTmp[LIdx], SIZE_TSOCKADDRIN6);
|
|
Inc(LIdx, SIZE_TSOCKADDRIN6);
|
|
//use a word so you don't wind up using the wrong network byte order function
|
|
LC := UInt32(Length(VBuffer));
|
|
CopyTIdUInt32(HostToNetwork(LC), LTmp, LIdx);
|
|
Inc(LIdx, 4);
|
|
//36
|
|
//zero the next three bytes
|
|
FillChar(LTmp[LIdx], 3, 0);
|
|
Inc(LIdx, 3);
|
|
//next header (protocol type determines it
|
|
LTmp[LIdx] := Id_IPPROTO_ICMPV6; // Id_IPPROTO_ICMP6;
|
|
Inc(LIdx);
|
|
//combine the two
|
|
CopyTIdBytes(VBuffer, 0, LTmp, LIdx, Length(VBuffer));
|
|
//zero out the checksum field
|
|
CopyTIdUInt16(0, LTmp, LIdx+AOffset);
|
|
|
|
CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(LTmp)), VBuffer, AOffset);
|
|
end;
|
|
|
|
function TIdStackWindows.ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer : TIdBytes;
|
|
APkt: TIdPacketInfo): UInt32;
|
|
var
|
|
LIP : String;
|
|
LPort : TIdPort;
|
|
LIPVersion : TIdIPVersion;
|
|
{Windows CE does not have WSARecvMsg}
|
|
{$IFNDEF WINCE}
|
|
LSize: PtrUInt;
|
|
LAddr: TIdBytes;
|
|
PAddr: PSOCKADDR_STORAGE;
|
|
LMsg : TWSAMSG;
|
|
LMsgBuf : TWSABUF;
|
|
LControl : TIdBytes;
|
|
LCurCmsg : LPWSACMSGHDR; //for iterating through the control buffer
|
|
PPktInfo: PInPktInfo;
|
|
PPktInfo6: PIn6PktInfo;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFNDEF WINCE}
|
|
//This runs only on WIndows XP or later
|
|
// XP 5.1 at least, Vista 6.0
|
|
if IndyCheckWindowsVersion(5, 1) then
|
|
begin
|
|
//we call the macro twice because we specified two possible structures.
|
|
//Id_IPV6_HOPLIMIT and Id_IPV6_PKTINFO
|
|
LSize := WSA_CMSG_LEN(WSA_CMSG_LEN(Length(VBuffer)));
|
|
SetLength(LControl, LSize);
|
|
|
|
LMsgBuf.len := Length(VBuffer); // Length(VMsgData);
|
|
LMsgBuf.buf := PAnsiChar(Pointer(VBuffer)); // @VMsgData[0];
|
|
|
|
FillChar(LMsg, SIZE_TWSAMSG, 0);
|
|
|
|
LMsg.lpBuffers := @LMsgBuf;
|
|
LMsg.dwBufferCount := 1;
|
|
|
|
LMsg.Control.Len := LSize;
|
|
LMsg.Control.buf := PAnsiChar(Pointer(LControl));
|
|
|
|
// RLebeau: despite that we are not performing an overlapped I/O operation,
|
|
// WSARecvMsg() does not like the SOCKADDR variable being allocated on the
|
|
// stack, at least on my tests with Windows 7. So we will allocate it on
|
|
// the heap instead to keep WinSock happy...
|
|
SetLength(LAddr, SizeOf(SOCKADDR_STORAGE));
|
|
PAddr := PSOCKADDR_STORAGE(@LAddr[0]);
|
|
|
|
LMsg.name := IdWinsock2.PSOCKADDR(PAddr);
|
|
LMsg.namelen := Length(LAddr);
|
|
|
|
CheckForSocketError(WSARecvMsg(ASocket, @LMsg, Result, nil, nil));
|
|
APkt.Reset;
|
|
|
|
case PAddr^.ss_family of
|
|
Id_PF_INET4: begin
|
|
APkt.SourceIP := TranslateTInAddrToString(PSockAddrIn(PAddr)^.sin_addr, Id_IPv4);
|
|
APkt.SourcePort := ntohs(PSockAddrIn(PAddr)^.sin_port);
|
|
APkt.SourceIPVersion := Id_IPv4;
|
|
end;
|
|
Id_PF_INET6: begin
|
|
APkt.SourceIP := TranslateTInAddrToString(PSockAddrIn6(PAddr)^.sin6_addr, Id_IPv6);
|
|
APkt.SourcePort := ntohs(PSockAddrIn6(PAddr)^.sin6_port);
|
|
APkt.SourceIPVersion := Id_IPv6;
|
|
end;
|
|
else begin
|
|
Result := 0; // avoid warning
|
|
IPVersionUnsupported;
|
|
end;
|
|
end;
|
|
|
|
LCurCmsg := nil;
|
|
repeat
|
|
LCurCmsg := WSA_CMSG_NXTHDR(@LMsg, LCurCmsg);
|
|
if LCurCmsg = nil then begin
|
|
Break;
|
|
end;
|
|
case LCurCmsg^.cmsg_type of
|
|
IP_PKTINFO : //done this way because IPV6_PKTINF and IP_PKTINFO are both 19
|
|
begin
|
|
case PAddr^.ss_family of
|
|
Id_PF_INET4: begin
|
|
PPktInfo := PInPktInfo(WSA_CMSG_DATA(LCurCmsg));
|
|
APkt.DestIP := TranslateTInAddrToString(PPktInfo^.ipi_addr, Id_IPv4);
|
|
APkt.DestIF := PPktInfo^.ipi_ifindex;
|
|
APkt.DestIPVersion := Id_IPv4;
|
|
end;
|
|
Id_PF_INET6: begin
|
|
PPktInfo6 := PIn6PktInfo(WSA_CMSG_DATA(LCurCmsg));
|
|
APkt.DestIP := TranslateTInAddrToString(PPktInfo6^.ipi6_addr, Id_IPv6);
|
|
APkt.DestIF := PPktInfo6^.ipi6_ifindex;
|
|
APkt.DestIPVersion := Id_IPv6;
|
|
end;
|
|
end;
|
|
end;
|
|
Id_IPV6_HOPLIMIT :
|
|
begin
|
|
APkt.TTL := WSA_CMSG_DATA(LCurCmsg)^;
|
|
end;
|
|
end;
|
|
until False;
|
|
end else
|
|
begin
|
|
{$ENDIF}
|
|
Result := RecvFrom(ASocket, VBuffer, Length(VBuffer), 0, LIP, LPort, LIPVersion);
|
|
APkt.Reset;
|
|
APkt.SourceIP := LIP;
|
|
APkt.SourcePort := LPort;
|
|
APkt.SourceIPVersion := LIPVersion;
|
|
APkt.DestIPVersion := LIPVersion;
|
|
{$IFNDEF WINCE}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdStackWindows.CheckIPVersionSupport(const AIPVersion: TIdIPVersion): Boolean;
|
|
var
|
|
LTmpSocket: TIdStackSocketHandle;
|
|
begin
|
|
LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Id_SOCK_STREAM, Id_IPPROTO_IP);
|
|
Result := LTmpSocket <> Id_INVALID_SOCKET;
|
|
if Result then begin
|
|
WSCloseSocket(LTmpSocket);
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF WINCE}
|
|
{
|
|
This is somewhat messy but I wanted to do things this way to support Int64
|
|
file sizes.
|
|
}
|
|
function ServeFile(ASocket: TIdStackSocketHandle; const AFileName: string): Int64;
|
|
var
|
|
LFileHandle: THandle;
|
|
LSize: LARGE_INTEGER;
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp: TIdPlatformString;
|
|
{$ENDIF}
|
|
begin
|
|
Result := 0;
|
|
|
|
{$IFDEF STRING_UNICODE_MISMATCH}
|
|
LTemp := TIdPlatformString(AFileName); // explicit convert to Ansi/Unicode
|
|
{$ENDIF}
|
|
|
|
LFileHandle := CreateFile(
|
|
{$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(AFileName){$ENDIF},
|
|
GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING,
|
|
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
|
|
|
|
if LFileHandle <> INVALID_HANDLE_VALUE then
|
|
begin
|
|
try
|
|
if TransmitFile(ASocket, LFileHandle, 0, 0, nil, nil, 0) then
|
|
begin
|
|
if Assigned(GetFileSizeEx) then
|
|
begin
|
|
if not GetFileSizeEx(LFileHandle, LSize) then begin
|
|
Exit;
|
|
end;
|
|
end else
|
|
begin
|
|
LSize.LowPart := GetFileSize(LFileHandle, @LSize.HighPart);
|
|
if (LSize.LowPart = $FFFFFFFF) and (GetLastError() <> 0) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := LSize.QuadPart;
|
|
end;
|
|
finally
|
|
CloseHandle(LFileHandle);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TIdStackWindows.SetKeepAliveValues(ASocket: TIdStackSocketHandle;
|
|
const AEnabled: Boolean; const ATimeMS, AInterval: Integer);
|
|
var
|
|
ka: _tcp_keepalive;
|
|
Bytes: DWORD;
|
|
begin
|
|
// SIO_KEEPALIVE_VALS is supported on Win2K+ and WinCE 4.x only
|
|
if AEnabled and IndyCheckWindowsVersion({$IFDEF WINCE}4{$ELSE}5{$ENDIF}) then
|
|
begin
|
|
ka.onoff := 1;
|
|
ka.keepalivetime := ATimeMS;
|
|
ka.keepaliveinterval := AInterval;
|
|
// RLebeau: in XE4+, PDWORD is NOT defined as ^DWORD, so we have to use a type-cast!
|
|
WSAIoctl(ASocket, SIO_KEEPALIVE_VALS, @ka, SizeOf(ka), nil, 0, PDWORD(@Bytes), nil, nil);
|
|
end else begin
|
|
SetSocketOption(ASocket, Id_SOL_SOCKET, Id_SO_KEEPALIVE, iif(AEnabled, 1, 0));
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
GStarted := False;
|
|
GSocketListClass := TIdSocketListWindows;
|
|
// Check if we are running under windows NT
|
|
{$IFNDEF WINCE}
|
|
if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
|
|
GetFileSizeEx := Windows.GetProcAddress(GetModuleHandle('Kernel32.dll'), 'GetFileSizeEx');
|
|
GServeFileProc := ServeFile;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF USE_IPHLPAPI}
|
|
InitializeIPHelperStubs;
|
|
{$ENDIF}
|
|
finalization
|
|
IdWship6.CloseLibrary;
|
|
UninitializeWinSock;
|
|
{$IFDEF USE_IPHLPAPI}
|
|
UninitializeIPHelperAPI;
|
|
{$ENDIF}
|
|
GStarted := False;
|
|
|
|
end.
|