IdStackWindows.pas 81 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. $Log$
  13. Rev 1.8 10/26/2004 8:20:04 PM JPMugaas
  14. Fixed some oversights with conversion. OOPS!!!
  15. Rev 1.7 07/06/2004 21:31:24 CCostelloe
  16. Kylix 3 changes
  17. Rev 1.6 4/18/04 10:43:24 PM RLebeau
  18. Fixed syntax error
  19. Rev 1.5 4/18/04 10:29:58 PM RLebeau
  20. Renamed Int64Parts structure to TIdInt64Parts
  21. Rev 1.4 4/18/04 2:47:46 PM RLebeau
  22. Conversion support for Int64 values
  23. Rev 1.3 2004.03.07 11:45:28 AM czhower
  24. Flushbuffer fix + other minor ones found
  25. Rev 1.2 3/6/2004 5:16:34 PM JPMugaas
  26. Bug 67 fixes. Do not write to const values.
  27. Rev 1.1 3/6/2004 4:23:52 PM JPMugaas
  28. Error #62 fix. This seems to work in my tests.
  29. Rev 1.0 2004.02.03 3:14:48 PM czhower
  30. Move and updates
  31. Rev 1.33 2/1/2004 6:10:56 PM JPMugaas
  32. GetSockOpt.
  33. Rev 1.32 2/1/2004 3:28:36 AM JPMugaas
  34. Changed WSGetLocalAddress to GetLocalAddress and moved into IdStack since
  35. that will work the same in the DotNET as elsewhere. This is required to
  36. reenable IPWatch.
  37. Rev 1.31 1/31/2004 1:12:48 PM JPMugaas
  38. Minor stack changes required as DotNET does support getting all IP addresses
  39. just like the other stacks.
  40. Rev 1.30 12/4/2003 3:14:52 PM BGooijen
  41. Added HostByAddress
  42. Rev 1.29 1/3/2004 12:38:56 AM BGooijen
  43. Added function SupportsIPv6
  44. Rev 1.28 12/31/2003 9:52:02 PM BGooijen
  45. Added IPv6 support
  46. Rev 1.27 10/26/2003 05:33:14 PM JPMugaas
  47. LocalAddresses should work.
  48. Rev 1.26 10/26/2003 5:04:28 PM BGooijen
  49. UDP Server and Client
  50. Rev 1.25 10/26/2003 09:10:26 AM JPMugaas
  51. Calls necessary for IPMulticasting.
  52. Rev 1.24 10/22/2003 04:40:52 PM JPMugaas
  53. Should compile with some restored functionality. Still not finished.
  54. Rev 1.23 10/21/2003 11:04:20 PM BGooijen
  55. Fixed name collision
  56. Rev 1.22 10/21/2003 01:20:02 PM JPMugaas
  57. Restore GWindowsStack because it was needed by SuperCore.
  58. Rev 1.21 10/21/2003 06:24:28 AM JPMugaas
  59. BSD Stack now have a global variable for refercing by platform specific
  60. things. Removed corresponding var from Windows stack.
  61. Rev 1.20 10/19/2003 5:21:32 PM BGooijen
  62. SetSocketOption
  63. Rev 1.19 2003.10.11 5:51:16 PM czhower
  64. -VCL fixes for servers
  65. -Chain suport for servers (Super core)
  66. -Scheduler upgrades
  67. -Full yarn support
  68. Rev 1.18 2003.10.02 8:01:08 PM czhower
  69. .Net
  70. Rev 1.17 2003.10.02 12:44:44 PM czhower
  71. Fix for Bind, Connect
  72. Rev 1.16 2003.10.02 10:16:32 AM czhower
  73. .Net
  74. Rev 1.15 2003.10.01 9:11:26 PM czhower
  75. .Net
  76. Rev 1.14 2003.10.01 12:30:08 PM czhower
  77. .Net
  78. Rev 1.12 10/1/2003 12:14:12 AM BGooijen
  79. DotNet: removing CheckForSocketError
  80. Rev 1.11 2003.10.01 1:12:40 AM czhower
  81. .Net
  82. Rev 1.10 2003.09.30 1:23:04 PM czhower
  83. Stack split for DotNet
  84. Rev 1.9 9/8/2003 02:13:10 PM JPMugaas
  85. SupportsIP6 function added for determining if IPv6 is installed on a system.
  86. Rev 1.8 2003.07.14 1:57:24 PM czhower
  87. -First set of IOCP fixes.
  88. -Fixed a threadsafe problem with the stack class.
  89. Rev 1.7 7/1/2003 05:20:44 PM JPMugaas
  90. Minor optimizations. Illiminated some unnecessary string operations.
  91. Rev 1.5 7/1/2003 03:39:58 PM JPMugaas
  92. Started numeric IP function API calls for more efficiency.
  93. Rev 1.4 7/1/2003 12:46:06 AM JPMugaas
  94. Preliminary stack functions taking an IP address numerical structure instead
  95. of a string.
  96. Rev 1.3 5/19/2003 6:00:28 PM BGooijen
  97. TIdStackWindows.WSGetHostByAddr raised an ERangeError when the last number in
  98. the ip>127
  99. Rev 1.2 5/10/2003 4:01:28 PM BGooijen
  100. Rev 1.1 2003.05.09 10:59:28 PM czhower
  101. Rev 1.0 11/13/2002 08:59:38 AM JPMugaas
  102. }
  103. unit IdStackWindows;
  104. interface
  105. {$I IdCompilerDefines.inc}
  106. uses
  107. Classes,
  108. IdGlobal, IdException, IdStackBSDBase, IdStackConsts, IdWinsock2, IdStack,
  109. SysUtils,
  110. Windows;
  111. type
  112. EIdIPv6Unavailable = class(EIdException);
  113. TIdStackWindows = class(TIdStackBSDBase)
  114. protected
  115. procedure WSQuerryIPv6Route(ASocket: TIdStackSocketHandle;
  116. const AIP: String; const APort : UInt16; var VSource; var VDest);
  117. procedure WriteChecksumIPv6(s : TIdStackSocketHandle; var VBuffer : TIdBytes;
  118. const AOffset : Integer; const AIP : String; const APort : TIdPort);
  119. function HostByName(const AHostName: string;
  120. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  121. function ReadHostName: string; override;
  122. function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override;
  123. function WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  124. const ABufferLength, AFlags: Integer): Integer; override;
  125. function WSSend(ASocket: TIdStackSocketHandle; const ABuffer;
  126. const ABufferLength, AFlags: Integer): Integer; override;
  127. function WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; override;
  128. {$IFNDEF VCL_XE3_OR_ABOVE}
  129. procedure WSGetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  130. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  131. procedure WSSetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  132. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  133. {$ENDIF}
  134. public
  135. function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort;
  136. var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
  137. function HostToNetwork(AValue: UInt16): UInt16; override;
  138. function HostToNetwork(AValue: UInt32): UInt32; override;
  139. function HostToNetwork(AValue: TIdUInt64): TIdUInt64; override;
  140. procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); override;
  141. function NetworkToHost(AValue: UInt16): UInt16; override;
  142. function NetworkToHost(AValue: UInt32): UInt32; override;
  143. function NetworkToHost(AValue: TIdUInt64): TIdUInt64; override;
  144. procedure SetBlocking(ASocket: TIdStackSocketHandle; const ABlocking: Boolean); override;
  145. function WouldBlock(const AResult: Integer): Boolean; override;
  146. //
  147. function HostByAddress(const AAddress: string;
  148. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  149. function WSGetServByName(const AServiceName: string): TIdPort; override;
  150. procedure AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings); override;
  151. function RecvFrom(const ASocket: TIdStackSocketHandle; var VBuffer;
  152. const ALength, AFlags: Integer; var VIP: string; var VPort: TIdPort;
  153. var VIPVersion: TIdIPVersion): Integer; override;
  154. function ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  155. APkt : TIdPacketInfo): UInt32; override;
  156. procedure WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer;
  157. const ABufferLength, AFlags: Integer; const AIP: string; const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  158. function WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  159. const ANonBlocking: Boolean = False): TIdStackSocketHandle; override;
  160. function WSTranslateSocketErrorMsg(const AErr: integer): string; override;
  161. function WSGetLastError: Integer; override;
  162. procedure WSSetLastError(const AErr : Integer); override;
  163. //
  164. procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string;
  165. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  166. procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  167. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  168. constructor Create; override;
  169. destructor Destroy; override;
  170. procedure Disconnect(ASocket: TIdStackSocketHandle); override;
  171. procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  172. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  173. procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  174. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  175. {$IFDEF VCL_XE3_OR_ABOVE}
  176. procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  177. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  178. procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  179. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  180. {$ENDIF}
  181. function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32; var arg: UInt32): Integer; override;
  182. function SupportsIPv4: Boolean; override;
  183. function SupportsIPv6: Boolean; override;
  184. function CheckIPVersionSupport(const AIPVersion: TIdIPVersion): boolean; override;
  185. procedure WriteChecksum(s : TIdStackSocketHandle;
  186. var VBuffer : TIdBytes;
  187. const AOffset : Integer;
  188. const AIP : String;
  189. const APort : TIdPort;
  190. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  191. procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override;
  192. procedure SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  193. const AEnabled: Boolean; const ATimeMS, AInterval: Integer); override;
  194. end;
  195. var
  196. //This is for the Win32-only package (SuperCore)
  197. GWindowsStack : TIdStackWindows = nil{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use GStack or GBSDStack instead'{$ENDIF}{$ENDIF};
  198. implementation
  199. {$DEFINE USE_IPHLPAPI}
  200. {$IFDEF USE_IPHLPAPI}
  201. // TODO: Move this to IdCompilerDefines.inc
  202. {$IFDEF VCL_XE2_OR_ABOVE}
  203. {$DEFINE HAS_UNIT_IpTypes}
  204. {$DEFINE HAS_UNIT_IpHlpApi}
  205. {$ENDIF}
  206. {$ENDIF}
  207. uses
  208. IdIDN, IdResourceStrings, IdWship6
  209. {$IFDEF USE_IPHLPAPI}
  210. {$IFDEF HAS_UNIT_IpTypes}
  211. , Winapi.IpTypes
  212. {$ENDIF}
  213. {$IFDEF HAS_UNIT_IpHlpApi}
  214. , Winapi.IpHlpApi
  215. {$ENDIF}
  216. {$ENDIF}
  217. ;
  218. {$IFNDEF WINCE}
  219. type
  220. TGetFileSizeEx = function(hFile : THandle; var lpFileSize : LARGE_INTEGER) : BOOL; stdcall;
  221. {$ENDIF}
  222. const
  223. SIZE_HOSTNAME = 250;
  224. var
  225. GStarted: Boolean = False;
  226. {$IFNDEF WINCE}
  227. GetFileSizeEx : TGetFileSizeEx = nil;
  228. {$ENDIF}
  229. { IPHLPAPI support }
  230. {$IFDEF USE_IPHLPAPI}
  231. const
  232. IPHLPAPI_DLL = 'iphlpapi.dll';
  233. {$IFNDEF HAS_UNIT_IpTypes}
  234. MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
  235. MAX_ADAPTER_NAME_LENGTH = 256;
  236. MAX_ADAPTER_ADDRESS_LENGTH = 8;
  237. MAX_DHCPV6_DUID_LENGTH = 130;
  238. MAX_DNS_SUFFIX_STRING_LENGTH = 256;
  239. GAA_FLAG_SKIP_UNICAST = $0001;
  240. GAA_FLAG_SKIP_ANYCAST = $0002;
  241. GAA_FLAG_SKIP_MULTICAST = $0004;
  242. GAA_FLAG_SKIP_DNS_SERVER = $0008;
  243. GAA_FLAG_INCLUDE_PREFIX = $0010;
  244. GAA_FLAG_SKIP_FRIENDLY_NAME = $0020;
  245. IP_ADAPTER_RECEIVE_ONLY = $08;
  246. {$ENDIF}
  247. IF_TYPE_SOFTWARE_LOOPBACK = 24;
  248. type
  249. PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS = ^IP_UNIDIRECTIONAL_ADAPTER_ADDRESS;
  250. IP_UNIDIRECTIONAL_ADAPTER_ADDRESS = record
  251. NumAdapters: ULONG;
  252. Address: array[0..0] of TInAddr;
  253. end;
  254. {$IFNDEF HAS_UNIT_IpTypes}
  255. {$MINENUMSIZE 4}
  256. time_t = TIdNativeInt;
  257. IFTYPE = ULONG;
  258. IF_INDEX = ULONG;
  259. NET_IF_COMPARTMENT_ID = UINT32;
  260. NET_IF_NETWORK_GUID = TGUID;
  261. IP_PREFIX_ORIGIN = (
  262. IpPrefixOriginOther,
  263. IpPrefixOriginManual,
  264. IpPrefixOriginWellKnown,
  265. IpPrefixOriginDhcp,
  266. IpPrefixOriginRouterAdvertisement,
  267. {$IFNDEF HAS_ENUM_ELEMENT_VALUES}
  268. ippoUnused5,
  269. ippoUnused6,
  270. ippoUnused7,
  271. ippoUnused8,
  272. ippoUnused9,
  273. ippoUnused10,
  274. ippoUnused11,
  275. ippoUnused12,
  276. ippoUnused13,
  277. ippoUnused14,
  278. ippoUnused15,
  279. {$ENDIF}
  280. IpPrefixOriginUnchanged);
  281. IP_SUFFIX_ORIGIN = (
  282. IpSuffixOriginOther,
  283. IpSuffixOriginManual,
  284. IpSuffixOriginWellKnown,
  285. IpSuffixOriginDhcp,
  286. IpSuffixOriginLinkLayerAddress,
  287. IpSuffixOriginRandom,
  288. {$IFNDEF HAS_ENUM_ELEMENT_VALUES}
  289. ipsoUnued6,
  290. ipsoUnued7,
  291. ipsoUnued8,
  292. ipsoUnued9,
  293. ipsoUnued10,
  294. ipsoUnued11,
  295. ipsoUnued12,
  296. ipsoUnued13,
  297. ipsoUnued14,
  298. ipsoUnued15,
  299. {$ENDIF}
  300. IpSuffixOriginUnchanged);
  301. IP_DAD_STATE = (
  302. IpDadStateInvalid,
  303. IpDadStateTentative,
  304. IpDadStateDuplicate,
  305. IpDadStateDeprecated,
  306. IpDadStatePreferred);
  307. IF_OPER_STATUS = (
  308. {$IFNDEF HAS_ENUM_ELEMENT_VALUES}
  309. ifosUnused,
  310. IfOperStatusUp,
  311. {$ELSE}
  312. IfOperStatusUp = 1,
  313. {$ENDIF}
  314. IfOperStatusDown,
  315. IfOperStatusTesting,
  316. IfOperStatusUnknown,
  317. IfOperStatusDormant,
  318. IfOperStatusNotPresent,
  319. IfOperStatusLowerLayerDown);
  320. NET_IF_CONNECTION_TYPE = (
  321. {$IFNDEF HAS_ENUM_ELEMENT_VALUES}
  322. nictUnused,
  323. NetIfConnectionDedicated,
  324. {$ELSE}
  325. NetIfConnectionDedicated = 1,
  326. {$ENDIF}
  327. NetIfConnectionPassive,
  328. NetIfConnectionDemand,
  329. NetIfConnectionMaximum);
  330. TUNNEL_TYPE = (
  331. TunnelTypeNone,
  332. TunnelTypeOther,
  333. TunnelTypeDirect,
  334. TunnelType6To4,
  335. TunnelTypeIsatap,
  336. TunnelTypeTeredo,
  337. TunnelTypeIPHTTPS);
  338. IP_ADDRESS_STRING = record
  339. S: array [0..15] of TIdAnsiChar;
  340. end;
  341. IP_MASK_STRING = IP_ADDRESS_STRING;
  342. PIP_ADDR_STRING = ^IP_ADDR_STRING;
  343. IP_ADDR_STRING = record
  344. Next: PIP_ADDR_STRING;
  345. IpAddress: IP_ADDRESS_STRING;
  346. IpMask: IP_MASK_STRING;
  347. Context: DWORD;
  348. end;
  349. PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
  350. IP_ADAPTER_INFO = record
  351. Next: PIP_ADAPTER_INFO;
  352. ComboIndex: DWORD;
  353. AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of TIdAnsiChar;
  354. Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of TIdAnsiChar;
  355. AddressLength: UINT;
  356. Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
  357. Index: DWORD;
  358. Type_: UINT;
  359. DhcpEnabled: UINT;
  360. CurrentIpAddress: PIP_ADDR_STRING;
  361. IpAddressList: IP_ADDR_STRING;
  362. GatewayList: IP_ADDR_STRING;
  363. DhcpServer: IP_ADDR_STRING;
  364. HaveWins: BOOL;
  365. PrimaryWinsServer: IP_ADDR_STRING;
  366. SecondaryWinsServer: IP_ADDR_STRING;
  367. LeaseObtained: time_t;
  368. LeaseExpires: time_t;
  369. end;
  370. SOCKET_ADDRESS = record
  371. lpSockaddr: IdWinsock2.LPSOCKADDR;
  372. iSockaddrLength: Integer;
  373. end;
  374. PIP_ADAPTER_UNICAST_ADDRESS = ^IP_ADAPTER_UNICAST_ADDRESS;
  375. IP_ADAPTER_UNICAST_ADDRESS = record
  376. Union: record
  377. case Integer of
  378. 0: (
  379. Alignment: ULONGLONG);
  380. 1: (
  381. Length: ULONG;
  382. Flags: DWORD);
  383. end;
  384. Next: PIP_ADAPTER_UNICAST_ADDRESS;
  385. Address: SOCKET_ADDRESS;
  386. PrefixOrigin: IP_PREFIX_ORIGIN;
  387. SuffixOrigin: IP_SUFFIX_ORIGIN;
  388. DadState: IP_DAD_STATE;
  389. ValidLifetime: ULONG;
  390. PreferredLifetime: ULONG;
  391. LeaseLifetime: ULONG;
  392. // This structure member is only available on Windows Vista and later
  393. OnLinkPrefixLength: UCHAR;
  394. end;
  395. PIP_ADAPTER_ANYCAST_ADDRESS = ^IP_ADAPTER_ANYCAST_ADDRESS;
  396. IP_ADAPTER_ANYCAST_ADDRESS = record
  397. Union: record
  398. case Integer of
  399. 0: (
  400. Alignment: ULONGLONG);
  401. 1: (
  402. Length: ULONG;
  403. Flags: DWORD);
  404. end;
  405. Next: PIP_ADAPTER_ANYCAST_ADDRESS;
  406. Address: SOCKET_ADDRESS;
  407. end;
  408. PIP_ADAPTER_MULTICAST_ADDRESS = ^IP_ADAPTER_MULTICAST_ADDRESS;
  409. IP_ADAPTER_MULTICAST_ADDRESS = record
  410. Union: record
  411. case Integer of
  412. 0: (
  413. Alignment: ULONGLONG);
  414. 1: (
  415. Length: ULONG;
  416. Flags: DWORD);
  417. end;
  418. Next: PIP_ADAPTER_MULTICAST_ADDRESS;
  419. Address: SOCKET_ADDRESS;
  420. end;
  421. PIP_ADAPTER_DNS_SERVER_ADDRESS = ^IP_ADAPTER_DNS_SERVER_ADDRESS;
  422. IP_ADAPTER_DNS_SERVER_ADDRESS = record
  423. Union: record
  424. case Integer of
  425. 0: (
  426. Alignment: ULONGLONG);
  427. 1: (
  428. Length: ULONG;
  429. Reserved: DWORD);
  430. end;
  431. Next: PIP_ADAPTER_DNS_SERVER_ADDRESS;
  432. Address: SOCKET_ADDRESS;
  433. end;
  434. PIP_ADAPTER_PREFIX = ^IP_ADAPTER_PREFIX;
  435. IP_ADAPTER_PREFIX = record
  436. Union: record
  437. case Integer of
  438. 0: (
  439. Alignment: ULONGLONG);
  440. 1: (
  441. Length: ULONG;
  442. Flags: DWORD);
  443. end;
  444. Next: PIP_ADAPTER_PREFIX;
  445. Address: SOCKET_ADDRESS;
  446. PrefixLength: ULONG;
  447. end;
  448. PIP_ADAPTER_WINS_SERVER_ADDRESS_LH = ^IP_ADAPTER_WINS_SERVER_ADDRESS_LH;
  449. IP_ADAPTER_WINS_SERVER_ADDRESS_LH = record
  450. Union: record
  451. case Integer of
  452. 0: (
  453. Alignment: ULONGLONG);
  454. 1: (
  455. Length: ULONG;
  456. Reserved: DWORD);
  457. end;
  458. Next: PIP_ADAPTER_WINS_SERVER_ADDRESS_LH;
  459. Address: SOCKET_ADDRESS;
  460. end;
  461. PIP_ADAPTER_GATEWAY_ADDRESS_LH = ^IP_ADAPTER_GATEWAY_ADDRESS_LH;
  462. IP_ADAPTER_GATEWAY_ADDRESS_LH = record
  463. Union: record
  464. case Integer of
  465. 0: (
  466. Alignment: ULONGLONG);
  467. 1: (
  468. Length: ULONG;
  469. Reserved: DWORD);
  470. end;
  471. Next: PIP_ADAPTER_GATEWAY_ADDRESS_LH;
  472. Address: SOCKET_ADDRESS;
  473. end;
  474. IF_LUID = record
  475. case Integer of
  476. 0: (
  477. Value: ULONG64);
  478. 1: (
  479. Info: ULONG64);
  480. end;
  481. PIP_ADAPTER_DNS_SUFFIX = ^IP_ADAPTER_DNS_SUFFIX;
  482. IP_ADAPTER_DNS_SUFFIX = record
  483. Next: PIP_ADAPTER_DNS_SUFFIX;
  484. AString: array[0..MAX_DNS_SUFFIX_STRING_LENGTH - 1] of WCHAR;
  485. end;
  486. PIP_ADAPTER_ADDRESSES = ^IP_ADAPTER_ADDRESSES;
  487. IP_ADAPTER_ADDRESSES = record
  488. Union: record
  489. case Integer of
  490. 0: (
  491. Alignment: ULONGLONG);
  492. 1: (
  493. Length: ULONG;
  494. IfIndex: DWORD);
  495. end;
  496. Next: PIP_ADAPTER_ADDRESSES;
  497. AdapterName: PIdAnsiChar;
  498. FirstUnicastAddress: PIP_ADAPTER_UNICAST_ADDRESS;
  499. FirstAnycastAddress: PIP_ADAPTER_ANYCAST_ADDRESS;
  500. FirstMulticastAddress: PIP_ADAPTER_MULTICAST_ADDRESS;
  501. FirstDnsServerAddress: PIP_ADAPTER_DNS_SERVER_ADDRESS;
  502. DnsSuffix: PWCHAR;
  503. Description: PWCHAR;
  504. FriendlyName: PWCHAR;
  505. PhysicalAddress: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
  506. PhysicalAddressLength: DWORD;
  507. Flags: DWORD;
  508. Mtu: DWORD;
  509. IfType: IFTYPE;
  510. OperStatus: IF_OPER_STATUS;
  511. Ipv6IfIndex: IF_INDEX;
  512. ZoneIndices: array [0..15] of DWORD;
  513. FirstPrefix: PIP_ADAPTER_PREFIX;
  514. TransmitLinkSpeed: ULONG64;
  515. ReceiveLinkSpeed: ULONG64;
  516. FirstWinsServerAddress: PIP_ADAPTER_WINS_SERVER_ADDRESS_LH;
  517. FirstGatewayAddress: PIP_ADAPTER_GATEWAY_ADDRESS_LH;
  518. Ipv4Metric: ULONG;
  519. Ipv6Metric: ULONG;
  520. Luid: IF_LUID;
  521. Dhcpv4Server: SOCKET_ADDRESS;
  522. CompartmentId: NET_IF_COMPARTMENT_ID;
  523. NetworkGuid: NET_IF_NETWORK_GUID;
  524. ConnectionType: NET_IF_CONNECTION_TYPE;
  525. TunnelType: TUNNEL_TYPE;
  526. //
  527. // DHCP v6 Info.
  528. //
  529. Dhcpv6Server: SOCKET_ADDRESS;
  530. Dhcpv6ClientDuid: array [0..MAX_DHCPV6_DUID_LENGTH - 1] of Byte;
  531. Dhcpv6ClientDuidLength: ULONG;
  532. Dhcpv6Iaid: ULONG;
  533. FirstDnsSuffix: PIP_ADAPTER_DNS_SUFFIX;
  534. end;
  535. {$ENDIF}
  536. PMIB_IPADDRROW = ^MIB_IPADDRROW;
  537. MIB_IPADDRROW = record
  538. dwAddr: DWORD;
  539. dwIndex: DWORD;
  540. dwMask: DWORD;
  541. dwBCastAddr: DWORD;
  542. dwReasmSize: DWORD;
  543. unused1: Word;
  544. wType: Word;
  545. end;
  546. PMIB_IPADDRTABLE = ^MIB_IPADDRTABLE;
  547. MIB_IPADDRTABLE = record
  548. dwNumEntries: DWORD;
  549. table: array[0..0] of MIB_IPADDRROW;
  550. end;
  551. NETIO_STATUS = DWORD;
  552. TGetIpAddrTable = function(pIpAddrTable: PMIB_IPADDRTABLE; var pdwSize: ULONG; bOrder: BOOL): DWORD; stdcall;
  553. TGetUniDirectionalAdapterInfo = function(pIPIfInfo: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS; var dwOutBufLen: ULONG): DWORD; stdcall;
  554. TGetAdaptersInfo = function(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
  555. TGetAdaptersAddresses = function(Family: ULONG; Flags: DWORD; Reserved: PVOID; pAdapterAddresses: PIP_ADAPTER_ADDRESSES; var OutBufLen: ULONG): DWORD; stdcall;
  556. TConvertLengthToIpv4Mask = function(MaskLength: ULONG; var Mask: ULONG): NETIO_STATUS; stdcall;
  557. var
  558. hIpHlpApi: TIdLibHandle = IdNilHandle;
  559. GetIpAddrTable: TGetIpAddrTable = nil;
  560. GetUniDirectionalAdapterInfo: TGetUniDirectionalAdapterInfo = nil;
  561. GetAdaptersInfo: TGetAdaptersInfo = nil;
  562. GetAdaptersAddresses: TGetAdaptersAddresses = nil;
  563. ConvertLengthToIpv4Mask: TConvertLengthToIpv4Mask = nil;
  564. function FixupIPHelperStub(const AName: TIdLibFuncName; DefImpl: Pointer): Pointer;
  565. {$IFDEF USE_INLINE}inline;{$ENDIF}
  566. begin
  567. Result := nil;
  568. if hIpHlpApi <> IdNilHandle then begin
  569. Result := LoadLibFunction(hIpHlpApi, AName);
  570. end;
  571. if Result = nil then begin
  572. Result := DefImpl;
  573. end;
  574. end;
  575. function Impl_GetIpAddrTable(pIpAddrTable: PMIB_IPADDRTABLE; var pdwSize: ULONG; bOrder: BOOL): DWORD; stdcall;
  576. begin
  577. pdwSize := 0;
  578. Result := ERROR_NOT_SUPPORTED;
  579. end;
  580. function Stub_GetIpAddrTable(pIpAddrTable: PMIB_IPADDRTABLE; var pdwSize: ULONG; bOrder: BOOL): DWORD; stdcall;
  581. begin
  582. @GetIpAddrTable := FixupIPHelperStub('GetIpAddrTable', @Impl_GetIpAddrTable); {Do not localize}
  583. Result := GetIpAddrTable(pIpAddrTable, pdwSize, bOrder);
  584. end;
  585. function Impl_GetUniDirectionalAdapterInfo(pIPIfInfo: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS; var dwOutBufLen: ULONG): DWORD; stdcall;
  586. begin
  587. dwOutBufLen := 0;
  588. Result := ERROR_NOT_SUPPORTED;
  589. end;
  590. function Stub_GetUniDirectionalAdapterInfo(pIPIfInfo: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS; var dwOutBufLen: ULONG): DWORD; stdcall;
  591. begin
  592. @GetUniDirectionalAdapterInfo := FixupIPHelperStub('GetUniDirectionalAdapterInfo', @Impl_GetUniDirectionalAdapterInfo); {Do not localize}
  593. Result := GetUniDirectionalAdapterInfo(pIPIfInfo, dwOutBufLen);
  594. end;
  595. function Impl_GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
  596. begin
  597. pOutBufLen := 0;
  598. Result := ERROR_NOT_SUPPORTED;
  599. end;
  600. function Stub_GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
  601. begin
  602. @GetAdaptersInfo := FixupIPHelperStub('GetAdaptersInfo', @Impl_GetAdaptersInfo); {Do not localize}
  603. Result := GetAdaptersInfo(pAdapterInfo, pOutBufLen);
  604. end;
  605. function Impl_GetAdaptersAddresses(Family: ULONG; Flags: DWORD; Reserved: PVOID; pAdapterAddresses: PIP_ADAPTER_ADDRESSES; var OutBufLen: ULONG): DWORD; stdcall;
  606. begin
  607. OutBufLen := 0;
  608. Result := ERROR_NOT_SUPPORTED;
  609. end;
  610. function Stub_GetAdaptersAddresses(Family: ULONG; Flags: DWORD; Reserved: PVOID; pAdapterAddresses: PIP_ADAPTER_ADDRESSES; var OutBufLen: ULONG): DWORD; stdcall;
  611. begin
  612. @GetAdaptersAddresses := FixupIPHelperStub('GetAdaptersAddresses', @Impl_GetAdaptersAddresses); {Do not localize}
  613. Result := GetAdaptersAddresses(Family, Flags, Reserved, pAdapterAddresses, OutBufLen);
  614. end;
  615. function Impl_ConvertLengthToIpv4Mask(MaskLength: ULONG; var Mask: ULONG): NETIO_STATUS; stdcall;
  616. begin
  617. // TODO: implement manually
  618. Mask := INADDR_NONE;
  619. if MaskLength > 32 then begin
  620. Result := ERROR_INVALID_PARAMETER;
  621. end else begin
  622. Result := ERROR_NOT_SUPPORTED;
  623. end;
  624. end;
  625. function Stub_ConvertLengthToIpv4Mask(MaskLength: ULONG; var Mask: ULONG): NETIO_STATUS; stdcall;
  626. begin
  627. @ConvertLengthToIpv4Mask := FixupIPHelperStub('ConvertLengthToIpv4Mask', @Impl_ConvertLengthToIpv4Mask); {Do not localize}
  628. Result := ConvertLengthToIpv4Mask(MaskLength, Mask);
  629. end;
  630. procedure InitializeIPHelperStubs;
  631. begin
  632. GetIpAddrTable := Stub_GetIpAddrTable;
  633. GetUniDirectionalAdapterInfo := Stub_GetUniDirectionalAdapterInfo;
  634. GetAdaptersInfo := Stub_GetAdaptersInfo;
  635. GetAdaptersAddresses := Stub_GetAdaptersAddresses;
  636. ConvertLengthToIpv4Mask := Stub_ConvertLengthToIpv4Mask;
  637. end;
  638. procedure InitializeIPHelperAPI;
  639. begin
  640. if hIpHlpApi = IdNilHandle then begin
  641. hIpHlpApi := SafeLoadLibrary(IPHLPAPI_DLL);
  642. end;
  643. end;
  644. procedure UninitializeIPHelperAPI;
  645. begin
  646. if hIpHlpApi <> IdNilHandle then
  647. begin
  648. FreeLibrary(hIpHlpApi);
  649. hIpHlpApi := IdNilHandle;
  650. end;
  651. InitializeIPHelperStubs;
  652. end;
  653. {$ENDIF}
  654. { TIdStackWindows }
  655. constructor TIdStackWindows.Create;
  656. begin
  657. inherited Create;
  658. if not GStarted then begin
  659. try
  660. InitializeWinSock;
  661. IdWship6.InitLibrary;
  662. IdIDN.InitIDNLibrary;
  663. {$IFDEF USE_IPHLPAPI}
  664. InitializeIPHelperAPI;
  665. {$ENDIF}
  666. except
  667. on E: Exception do begin
  668. IndyRaiseOuterException(EIdStackInitializationFailed.Create(E.Message));
  669. end;
  670. end;
  671. GStarted := True;
  672. end;
  673. {$I IdSymbolDeprecatedOff.inc}
  674. GWindowsStack := Self;
  675. {$I IdSymbolDeprecatedOn.inc}
  676. end;
  677. destructor TIdStackWindows.Destroy;
  678. begin
  679. //DLL Unloading and Cleanup is done at finalization
  680. inherited Destroy;
  681. end;
  682. function TIdStackWindows.Accept(ASocket: TIdStackSocketHandle;
  683. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
  684. var
  685. LSize: Integer;
  686. LAddr: SOCKADDR_STORAGE;
  687. begin
  688. LSize := SizeOf(LAddr);
  689. Result := IdWinsock2.accept(ASocket, IdWinsock2.PSOCKADDR(@LAddr), @LSize);
  690. if Result <> INVALID_SOCKET then begin
  691. case LAddr.ss_family of
  692. Id_PF_INET4: begin
  693. VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
  694. VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
  695. VIPVersion := Id_IPv4;
  696. end;
  697. Id_PF_INET6: begin
  698. VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
  699. VPort := ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
  700. VIPVersion := Id_IPv6;
  701. end;
  702. else begin
  703. CloseSocket(Result);
  704. Result := INVALID_SOCKET;
  705. IPVersionUnsupported;
  706. end;
  707. end;
  708. end;
  709. end;
  710. procedure TIdStackWindows.Bind(ASocket: TIdStackSocketHandle;
  711. const AIP: string; const APort: TIdPort;
  712. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  713. var
  714. LAddr: SOCKADDR_STORAGE;
  715. LSize: Integer;
  716. begin
  717. FillChar(LAddr, SizeOf(LAddr), 0);
  718. case AIPVersion of
  719. Id_IPv4: begin
  720. PSockAddrIn(@LAddr)^.sin_family := Id_PF_INET4;
  721. if AIP <> '' then begin
  722. TranslateStringToTInAddr(AIP, PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
  723. end;
  724. PSockAddrIn(@LAddr)^.sin_port := htons(APort);
  725. LSize := SIZE_TSOCKADDRIN;
  726. end;
  727. Id_IPv6: begin
  728. PSockAddrIn6(@LAddr)^.sin6_family := Id_PF_INET6;
  729. if AIP <> '' then begin
  730. TranslateStringToTInAddr(AIP, PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
  731. end;
  732. PSockAddrIn6(@LAddr)^.sin6_port := htons(APort);
  733. LSize := SIZE_TSOCKADDRIN6;
  734. end;
  735. else begin
  736. LSize := 0; // avoid warning
  737. IPVersionUnsupported;
  738. end;
  739. end;
  740. CheckForSocketError(IdWinsock2.bind(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
  741. end;
  742. function TIdStackWindows.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
  743. begin
  744. Result := CloseSocket(ASocket);
  745. end;
  746. function TIdStackWindows.HostByAddress(const AAddress: string;
  747. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  748. var
  749. {$IFDEF UNICODE}
  750. Hints: TAddrInfoW;
  751. LAddrInfo: pAddrInfoW;
  752. {$ELSE}
  753. Hints: TAddrInfo;
  754. LAddrInfo: pAddrInfo;
  755. {$ENDIF}
  756. RetVal: Integer;
  757. {$IFDEF STRING_UNICODE_MISMATCH}
  758. LTemp: TIdPlatformString;
  759. {$ENDIF}
  760. begin
  761. if not (AIPVersion in [Id_IPv4, Id_IPv6]) then begin
  762. IPVersionUnsupported;
  763. end;
  764. // TODO: should this be calling getnameinfo() first and then getaddrinfo()
  765. // to check for a malicious PTR record, like the other TIdStack classes do?
  766. // TODO: use TranslateStringToTInAddr() instead of getaddrinfo() to convert
  767. // the IP address to a sockaddr struct for getnameinfo(), like other TIdStack
  768. // classes do.
  769. FillChar(Hints, SizeOf(Hints), 0);
  770. Hints.ai_family := IdIPFamily[AIPVersion];
  771. Hints.ai_socktype := Integer(SOCK_STREAM);
  772. Hints.ai_flags := AI_NUMERICHOST;
  773. LAddrInfo := nil;
  774. {$IFDEF STRING_UNICODE_MISMATCH}
  775. LTemp := TIdPlatformString(AAddress); // explicit convert to Ansi/Unicode
  776. {$ENDIF}
  777. RetVal := getaddrinfo(
  778. {$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(AAddress){$ENDIF},
  779. nil, @Hints, @LAddrInfo);
  780. if RetVal <> 0 then begin
  781. RaiseSocketError(gaiErrorToWsaError(RetVal));
  782. end;
  783. try
  784. SetLength(
  785. {$IFDEF STRING_UNICODE_MISMATCH}LTemp{$ELSE}Result{$ENDIF},
  786. NI_MAXHOST);
  787. RetVal := getnameinfo(
  788. LAddrInfo.ai_addr, LAddrInfo.ai_addrlen,
  789. {$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(Result){$ENDIF},
  790. NI_MAXHOST, nil, 0, NI_NAMEREQD);
  791. if RetVal <> 0 then begin
  792. RaiseSocketError(gaiErrorToWsaError(RetVal));
  793. end;
  794. Result := {$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(Result){$ENDIF};
  795. finally
  796. freeaddrinfo(LAddrInfo);
  797. end;
  798. end;
  799. function TIdStackWindows.ReadHostName: string;
  800. var
  801. // Note that there is no Unicode version of gethostname.
  802. // Maybe use getnameinfo() instead?
  803. LStr: array[0..SIZE_HOSTNAME] of TIdAnsiChar;
  804. {$IFDEF USE_MARSHALLED_PTRS}
  805. LStrPtr: TPtrWrapper;
  806. {$ENDIF}
  807. begin
  808. {$IFDEF USE_MARSHALLED_PTRS}
  809. LStrPtr := TPtrWrapper.Create(@LStr[0]);
  810. {$ENDIF}
  811. if gethostname(
  812. {$IFDEF USE_MARSHALLED_PTRS}
  813. LStrPtr.ToPointer
  814. {$ELSE}
  815. LStr
  816. {$ENDIF}, SIZE_HOSTNAME) <> Id_SOCKET_ERROR then
  817. begin
  818. {$IFDEF USE_MARSHALLED_PTRS}
  819. Result := TMarshal.ReadStringAsAnsiUpTo(CP_ACP, LStrPtr, SIZE_HOSTNAME);
  820. {$ELSE}
  821. //we have to specifically type cast a PIdAnsiChar to a string for D2009+.
  822. //otherwise, we will get a warning about implicit typecast from AnsiString
  823. //to string
  824. LStr[SIZE_HOSTNAME] := TIdAnsiChar(0);
  825. Result := String(LStr);
  826. {$ENDIF}
  827. end else begin
  828. Result := '';
  829. end;
  830. end;
  831. procedure TIdStackWindows.Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);
  832. begin
  833. CheckForSocketError(IdWinsock2.listen(ASocket, ABacklog));
  834. end;
  835. // RLebeau 12/16/09: MS Hotfix #971383 supposedly fixes a bug in Windows
  836. // Server 2003 when client and server are running on the same machine.
  837. // The bug can cause recv() to return 0 bytes prematurely even though data
  838. // is actually pending. Uncomment the below define if you do not want to
  839. // rely on the Hotfix always being installed. The workaround described by
  840. // MS is to simply call recv() again to make sure data is really not pending.
  841. //
  842. {.$DEFINE IGNORE_KB971383_FIX}
  843. function TIdStackWindows.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  844. const ABufferLength, AFlags: Integer) : Integer;
  845. begin
  846. Result := recv(ASocket, ABuffer, ABufferLength, AFlags);
  847. {$IFDEF IGNORE_KB971383_FIX}
  848. if Result = 0 then begin
  849. Result := recv(ASocket, ABuffer, ABufferLength, AFlags);
  850. end;
  851. {$ENDIF}
  852. end;
  853. function TIdStackWindows.RecvFrom(const ASocket: TIdStackSocketHandle;
  854. var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  855. var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer;
  856. var
  857. LSize: Integer;
  858. LAddr: SOCKADDR_STORAGE;
  859. begin
  860. LSize := SizeOf(LAddr);
  861. Result := IdWinsock2.recvfrom(ASocket, VBuffer, ALength, AFlags, IdWinsock2.PSOCKADDR(@LAddr), @LSize);
  862. if Result >= 0 then
  863. begin
  864. case LAddr.ss_family of
  865. Id_PF_INET4: begin
  866. VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
  867. VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
  868. VIPVersion := Id_IPv4;
  869. end;
  870. Id_PF_INET6: begin
  871. VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
  872. VPort := ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
  873. VIPVersion := Id_IPv6;
  874. end;
  875. else begin
  876. IPVersionUnsupported;
  877. end;
  878. end;
  879. end;
  880. end;
  881. function TIdStackWindows.WSSend(ASocket: TIdStackSocketHandle;
  882. const ABuffer; const ABufferLength, AFlags: Integer): Integer;
  883. begin
  884. Result := CheckForSocketError(IdWinsock2.send(ASocket, ABuffer, ABufferLength, AFlags));
  885. end;
  886. procedure TIdStackWindows.WSSendTo(ASocket: TIdStackSocketHandle;
  887. const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
  888. const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  889. var
  890. LAddr: SOCKADDR_STORAGE;
  891. LSize: Integer;
  892. begin
  893. FillChar(LAddr, SizeOf(LAddr), 0);
  894. case AIPVersion of
  895. Id_IPv4: begin
  896. PSockAddrIn(@LAddr)^.sin_family := Id_PF_INET4;
  897. TranslateStringToTInAddr(AIP, PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
  898. PSockAddrIn(@LAddr)^.sin_port := htons(APort);
  899. LSize := SIZE_TSOCKADDRIN;
  900. end;
  901. Id_IPv6: begin
  902. PSockAddrIn6(@LAddr)^.sin6_family := Id_PF_INET6;
  903. TranslateStringToTInAddr(AIP, PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
  904. PSockAddrIn6(@LAddr)^.sin6_port := htons(APort);
  905. LSize := SIZE_TSOCKADDRIN6;
  906. end;
  907. else begin
  908. LSize := 0; // avoid warning
  909. IPVersionUnsupported;
  910. end;
  911. end;
  912. LSize := IdWinsock2.sendto(ASocket, ABuffer, ABufferLength, AFlags, IdWinsock2.PSOCKADDR(@LAddr), LSize);
  913. // TODO: call CheckForSocketError() here
  914. if LSize = Id_SOCKET_ERROR then begin
  915. // TODO: move this into RaiseLastSocketError() directly
  916. if WSGetLastError() = Id_WSAEMSGSIZE then begin
  917. raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig);
  918. end else begin
  919. RaiseLastSocketError;
  920. end;
  921. end
  922. else if LSize <> ABufferLength then begin
  923. raise EIdNotAllBytesSent.Create(RSNotAllBytesSent);
  924. end;
  925. end;
  926. function TIdStackWindows.WSGetLastError: Integer;
  927. begin
  928. Result := WSAGetLastError;
  929. if Result = -1073741251{STATUS_HOST_UNREACHABLE} then begin
  930. Result := WSAEHOSTUNREACH;
  931. end
  932. end;
  933. procedure TIdStackWindows.WSSetLastError(const AErr : Integer);
  934. begin
  935. WSASetLastError(AErr);
  936. end;
  937. function TIdStackWindows.WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  938. const ANonBlocking: Boolean = False): TIdStackSocketHandle;
  939. {
  940. var
  941. LValue: UInt32;
  942. }
  943. begin
  944. if ANonBlocking then begin
  945. Result := WSASocket(AFamily, AStruct, AProtocol, nil, 0, WSA_FLAG_OVERLAPPED);
  946. // TODO: do this instead?
  947. {
  948. Result := IdWinsock2.socket(AFamily, AStruct, AProtocol);
  949. if Result <> INVALID_SOCKET then begin
  950. //SetBlocking(Result, False);
  951. LValue := 1;
  952. ioctlsocket(Result, FIONBIO, LValue);
  953. end;
  954. }
  955. end else begin
  956. Result := IdWinsock2.socket(AFamily, AStruct, AProtocol);
  957. end;
  958. end;
  959. function TIdStackWindows.WSGetServByName(const AServiceName: string): TIdPort;
  960. var
  961. // Note that there is no Unicode version of getservbyname.
  962. // Maybe use getaddrinfo() instead?
  963. ps: PServEnt;
  964. LPort: Integer;
  965. {$IFDEF USE_MARSHALLED_PTRS}
  966. M: TMarshaller;
  967. {$ENDIF}
  968. begin
  969. ps := getservbyname(
  970. {$IFDEF USE_MARSHALLED_PTRS}
  971. M.AsAnsi(AServiceName).ToPointer
  972. {$ELSE}
  973. PIdAnsiChar(
  974. {$IFDEF STRING_IS_ANSI}
  975. AServiceName
  976. {$ELSE}
  977. AnsiString(AServiceName) // explicit convert to Ansi
  978. {$ENDIF}
  979. )
  980. {$ENDIF},
  981. nil);
  982. if ps <> nil then begin
  983. Result := ntohs(ps^.s_port);
  984. end else
  985. begin
  986. // TODO: use TryStrToInt() instead...
  987. try
  988. LPort := IndyStrToInt(AServiceName);
  989. except
  990. on EConvertError do begin
  991. LPort := -1;
  992. IndyRaiseOuterException(EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]));
  993. end;
  994. end;
  995. if (LPort < 0) or (LPort > High(TIdPort)) then begin
  996. raise EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]);
  997. end;
  998. Result := TIdPort(LPort);
  999. end;
  1000. end;
  1001. procedure TIdStackWindows.AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings);
  1002. type
  1003. // Note that there is no Unicode version of getservbyport.
  1004. PPAnsiCharArray = ^TPAnsiCharArray;
  1005. TPAnsiCharArray = packed array[0..(MaxInt div SizeOf(PIdAnsiChar))-1] of PIdAnsiChar;
  1006. var
  1007. ps: PServEnt;
  1008. i: integer;
  1009. p: PPAnsiCharArray;
  1010. begin
  1011. ps := getservbyport(htons(APortNumber), nil);
  1012. if ps = nil then begin
  1013. RaiseLastSocketError;
  1014. end;
  1015. AAddresses.BeginUpdate;
  1016. try
  1017. //we have to specifically type cast a PIdAnsiChar to a string for D2009+.
  1018. //otherwise, we will get a warning about implicit typecast from AnsiString
  1019. //to string
  1020. AAddresses.Add(String(ps^.s_name));
  1021. i := 0;
  1022. p := Pointer(ps^.s_aliases);
  1023. while p[i] <> nil do
  1024. begin
  1025. AAddresses.Add(String(p[i]));
  1026. Inc(i);
  1027. end;
  1028. finally
  1029. AAddresses.EndUpdate;
  1030. end;
  1031. end;
  1032. function TIdStackWindows.HostToNetwork(AValue: UInt16): UInt16;
  1033. begin
  1034. Result := htons(AValue);
  1035. end;
  1036. function TIdStackWindows.NetworkToHost(AValue: UInt16): UInt16;
  1037. begin
  1038. Result := ntohs(AValue);
  1039. end;
  1040. function TIdStackWindows.HostToNetwork(AValue: UInt32): UInt32;
  1041. begin
  1042. Result := htonl(AValue);
  1043. end;
  1044. function TIdStackWindows.NetworkToHost(AValue: UInt32): UInt32;
  1045. begin
  1046. Result := ntohl(AValue);
  1047. end;
  1048. function TIdStackWindows.HostToNetwork(AValue: TIdUInt64): TIdUInt64;
  1049. var
  1050. LParts: TIdUInt64Parts;
  1051. L: UInt32;
  1052. begin
  1053. // TODO: ARM is bi-endian, so if Windows is running on ARM instead of x86,
  1054. // can it ever be big endian? Or do ARM manufacturers put it in little endian
  1055. // for Windows installations?
  1056. //if (htonl(1) <> 1) then begin
  1057. LParts.QuadPart := AValue{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
  1058. L := htonl(LParts.HighPart);
  1059. LParts.HighPart := htonl(LParts.LowPart);
  1060. LParts.LowPart := L;
  1061. Result{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF} := LParts.QuadPart;
  1062. //end else begin
  1063. // Result{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF} := AValue{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
  1064. //end;
  1065. end;
  1066. function TIdStackWindows.NetworkToHost(AValue: TIdUInt64): TIdUInt64;
  1067. var
  1068. LParts: TIdUInt64Parts;
  1069. L: UInt32;
  1070. begin
  1071. // TODO: ARM is bi-endian, so if Windows is running on ARM instead of x86,
  1072. // can it ever be big endian? Or do ARM manufacturers put it in little endian
  1073. // for Windows installations?
  1074. //if (ntohl(1) <> 1) then begin
  1075. LParts.QuadPart := AValue{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
  1076. L := ntohl(LParts.HighPart);
  1077. LParts.HighPart := ntohl(LParts.LowPart);
  1078. LParts.LowPart := L;
  1079. Result{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF} := LParts.QuadPart;
  1080. //end else begin
  1081. // Result{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF} := AValue{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
  1082. //end;
  1083. end;
  1084. type
  1085. TIdStackLocalAddressAccess = class(TIdStackLocalAddress)
  1086. end;
  1087. procedure TIdStackWindows.GetLocalAddressList(AAddresses: TIdStackLocalAddressList);
  1088. {$IFDEF USE_IPHLPAPI}
  1089. function IPv4MaskLengthToString(MaskLength: ULONG): String;
  1090. var
  1091. Mask: ULONG;
  1092. begin
  1093. if ConvertLengthToIpv4Mask(MaskLength, Mask) = ERROR_SUCCESS then begin
  1094. Result := TranslateTInAddrToString(Mask, Id_IPv4);
  1095. end else begin
  1096. Result := '';
  1097. end;
  1098. end;
  1099. procedure GetIPv4SubNetMasks(ASubNetMasks: TStrings);
  1100. var
  1101. Ret: DWORD;
  1102. BufLen: ULONG;
  1103. Table: PMIB_IPADDRTABLE;
  1104. pRow: PMIB_IPADDRROW;
  1105. I: ULONG;
  1106. begin
  1107. BufLen := 0;
  1108. Table := nil;
  1109. try
  1110. repeat
  1111. // Alternatively, use WSAIoctl(SIO_GET_INTERFACE_LIST), but
  1112. // I have noticed it does not always return IPv4 subnets!
  1113. Ret := GetIpAddrTable(Table, BufLen, FALSE);
  1114. case Ret of
  1115. ERROR_SUCCESS:
  1116. begin
  1117. if BufLen = 0 then begin
  1118. Exit;
  1119. end;
  1120. Break;
  1121. end;
  1122. ERROR_NOT_SUPPORTED:
  1123. Exit;
  1124. ERROR_INSUFFICIENT_BUFFER:
  1125. ReallocMem(Table, BufLen);
  1126. else
  1127. SetLastError(Ret);
  1128. IndyRaiseLastError;
  1129. end;
  1130. until False;
  1131. if Ret = ERROR_SUCCESS then
  1132. begin
  1133. if Table^.dwNumEntries > 0 then
  1134. begin
  1135. pRow := @(Table^.table[0]);
  1136. for I := 0 to Table^.dwNumEntries-1 do begin
  1137. IndyAddPair(ASubNetMasks,
  1138. TranslateTInAddrToString(pRow^.dwAddr, Id_IPv4),
  1139. TranslateTInAddrToString(pRow^.dwMask, Id_IPv4));
  1140. Inc(pRow);
  1141. end;
  1142. end;
  1143. end;
  1144. finally
  1145. FreeMem(Table);
  1146. end;
  1147. end;
  1148. function GetLocalAddressesByAdaptersAddresses: Boolean;
  1149. var
  1150. Ret: DWORD;
  1151. BufLen: ULONG;
  1152. Adapter, Adapters: PIP_ADAPTER_ADDRESSES;
  1153. UnicastAddr: PIP_ADAPTER_UNICAST_ADDRESS;
  1154. IPAddr: string;
  1155. SubNetStr: String;
  1156. SubNetMasks: TStringList;
  1157. LAddress: TIdStackLocalAddress;
  1158. begin
  1159. // assume True unless ERROR_NOT_SUPPORTED is reported...
  1160. Result := True;
  1161. // MSDN says:
  1162. // The recommended method of calling the GetAdaptersAddresses function is
  1163. // to pre-allocate a 15KB working buffer pointed to by the AdapterAddresses
  1164. // parameter. On typical computers, this dramatically reduces the chances
  1165. // that the GetAdaptersAddresses function returns ERROR_BUFFER_OVERFLOW,
  1166. // which would require calling GetAdaptersAddresses function multiple times.
  1167. BufLen := 1024*15;
  1168. GetMem(Adapters, BufLen);
  1169. try
  1170. repeat
  1171. // TODO: include GAA_FLAG_INCLUDE_PREFIX on XPSP1+?
  1172. // TODO: include GAA_FLAG_INCLUDE_ALL_INTERFACES on Vista+?
  1173. Ret := GetAdaptersAddresses(PF_UNSPEC, GAA_FLAG_SKIP_ANYCAST or GAA_FLAG_SKIP_MULTICAST or GAA_FLAG_SKIP_DNS_SERVER, nil, Adapters, BufLen);
  1174. case Ret of
  1175. ERROR_SUCCESS:
  1176. begin
  1177. // Windows CE versions earlier than 4.1 may return ERROR_SUCCESS and
  1178. // BufLen=0 if no adapter info is available, instead of returning
  1179. // ERROR_NO_DATA as documented...
  1180. if BufLen = 0 then begin
  1181. Exit;
  1182. end;
  1183. Break;
  1184. end;
  1185. ERROR_NOT_SUPPORTED:
  1186. begin
  1187. Result := False;
  1188. Exit;
  1189. end;
  1190. ERROR_NO_DATA,
  1191. ERROR_ADDRESS_NOT_ASSOCIATED:
  1192. Exit;
  1193. ERROR_BUFFER_OVERFLOW:
  1194. ReallocMem(Adapters, BufLen);
  1195. else
  1196. SetLastError(Ret);
  1197. IndyRaiseLastError;
  1198. end;
  1199. until False;
  1200. if Ret = ERROR_SUCCESS then
  1201. begin
  1202. SubNetMasks := nil;
  1203. try
  1204. AAddresses.BeginUpdate;
  1205. try
  1206. Adapter := Adapters;
  1207. repeat
  1208. if (Adapter.IfType <> IF_TYPE_SOFTWARE_LOOPBACK) and
  1209. ((Adapter.Flags and IP_ADAPTER_RECEIVE_ONLY) = 0) then
  1210. begin
  1211. UnicastAddr := Adapter^.FirstUnicastAddress;
  1212. while UnicastAddr <> nil do
  1213. begin
  1214. if UnicastAddr^.DadState = IpDadStatePreferred then
  1215. begin
  1216. LAddress := nil;
  1217. case UnicastAddr^.Address.lpSockaddr.sin_family of
  1218. AF_INET: begin
  1219. IPAddr := TranslateTInAddrToString(PSockAddrIn(UnicastAddr^.Address.lpSockaddr)^.sin_addr, Id_IPv4);
  1220. // TODO: use the UnicastAddr^.Length field to determine which version of
  1221. // IP_ADAPTER_UNICAST_ADDRESS is being provided, rather than checking the
  1222. // OS version number...
  1223. if IndyCheckWindowsVersion(6) then begin
  1224. // The OnLinkPrefixLength member is only available on Windows Vista and later
  1225. SubNetStr := IPv4MaskLengthToString(UnicastAddr^.OnLinkPrefixLength);
  1226. end else
  1227. begin
  1228. // TODO: on XP SP1+, can the subnet mask be determined
  1229. // by analyzing the Adapter's Prefix list without resorting
  1230. // to reading the Registry?
  1231. if SubNetMasks = nil then
  1232. begin
  1233. SubNetMasks := TStringList.Create;
  1234. GetIPv4SubNetMasks(SubNetMasks);
  1235. end;
  1236. SubNetStr := SubNetMasks.Values[IPAddr];
  1237. end;
  1238. LAddress := TIdStackLocalAddressIPv4.Create(AAddresses, IPAddr, SubNetStr);
  1239. {$I IdObjectChecksOff.inc}
  1240. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := Adapter^.Union.IfIndex;
  1241. {$I IdObjectChecksOn.inc}
  1242. end;
  1243. AF_INET6: begin
  1244. LAddress := TIdStackLocalAddressIPv6.Create(AAddresses,
  1245. TranslateTInAddrToString(PSockAddrIn6(UnicastAddr^.Address.lpSockaddr)^.sin6_addr, Id_IPv6));
  1246. // The Ipv6IfIndex member is only available on Windows XP SP1 and later
  1247. if IndyCheckWindowsVersion(5, 2) or (IndyCheckWindowsVersion(5, 1) {TODO: and SP1+}) then begin
  1248. {$I IdObjectChecksOff.inc}
  1249. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := Adapter^.Ipv6IfIndex;
  1250. {$I IdObjectChecksOn.inc}
  1251. end;
  1252. end;
  1253. end;
  1254. if LAddress <> nil then begin
  1255. {$I IdObjectChecksOff.inc}
  1256. TIdStackLocalAddressAccess(LAddress).FDescription := String(Adapter^.Description);
  1257. TIdStackLocalAddressAccess(LAddress).FFriendlyName := String(Adapter^.FriendlyName);
  1258. TIdStackLocalAddressAccess(LAddress).FInterfaceName := String(Adapter^.AdapterName);
  1259. {$I IdObjectChecksOn.inc}
  1260. end;
  1261. end;
  1262. UnicastAddr := UnicastAddr^.Next;
  1263. end;
  1264. end;
  1265. Adapter := Adapter^.Next;
  1266. until Adapter = nil;
  1267. finally
  1268. AAddresses.EndUpdate;
  1269. end;
  1270. finally
  1271. SubNetMasks.Free;
  1272. end;
  1273. end;
  1274. finally
  1275. FreeMem(Adapters);
  1276. end;
  1277. end;
  1278. procedure GetUniDirAddresseses(AUniDirAddresses: TStrings);
  1279. var
  1280. Ret: DWORD;
  1281. BufLen: ULONG;
  1282. Adapters: PIP_UNIDIRECTIONAL_ADAPTER_ADDRESS;
  1283. pUniDirAddr: PInAddr;
  1284. I: ULONG;
  1285. begin
  1286. BufLen := 1024*15;
  1287. GetMem(Adapters, BufLen);
  1288. try
  1289. repeat
  1290. Ret := GetUniDirectionalAdapterInfo(Adapters, BufLen);
  1291. case Ret of
  1292. ERROR_SUCCESS:
  1293. begin
  1294. if BufLen = 0 then begin
  1295. Exit;
  1296. end;
  1297. Break;
  1298. end;
  1299. ERROR_NOT_SUPPORTED,
  1300. ERROR_NO_DATA:
  1301. Exit;
  1302. ERROR_MORE_DATA:
  1303. ReallocMem(Adapters, BufLen);
  1304. else
  1305. SetLastError(Ret);
  1306. IndyRaiseLastError;
  1307. end;
  1308. until False;
  1309. if Ret = ERROR_SUCCESS then
  1310. begin
  1311. if Adapters^.NumAdapters > 0 then
  1312. begin
  1313. pUniDirAddr := @(Adapters^.Address[0]);
  1314. for I := 0 to Adapters^.NumAdapters-1 do begin
  1315. AUniDirAddresses.Add(TranslateTInAddrToString(pUniDirAddr^, Id_IPv4));
  1316. Inc(pUniDirAddr);
  1317. end;
  1318. end;
  1319. end;
  1320. finally
  1321. FreeMem(Adapters);
  1322. end;
  1323. end;
  1324. procedure GetLocalAddressesByAdaptersInfo;
  1325. var
  1326. Ret: DWORD;
  1327. BufLen: ULONG;
  1328. UniDirAddresses: TStringList;
  1329. Adapter, Adapters: PIP_ADAPTER_INFO;
  1330. IPAddr: PIP_ADDR_STRING;
  1331. IPStr, MaskStr: String;
  1332. LAddress: TIdStackLocalAddress;
  1333. begin
  1334. BufLen := 1024*15;
  1335. GetMem(Adapters, BufLen);
  1336. try
  1337. repeat
  1338. Ret := GetAdaptersInfo(Adapters, BufLen);
  1339. case Ret of
  1340. ERROR_SUCCESS:
  1341. begin
  1342. // Windows CE versions earlier than 4.1 may return ERROR_SUCCESS and
  1343. // BufLen=0 if no adapter info is available, instead of returning
  1344. // ERROR_NO_DATA as documented...
  1345. if BufLen = 0 then begin
  1346. Exit;
  1347. end;
  1348. Break;
  1349. end;
  1350. ERROR_NOT_SUPPORTED,
  1351. ERROR_NO_DATA:
  1352. Exit;
  1353. ERROR_BUFFER_OVERFLOW:
  1354. ReallocMem(Adapters, BufLen);
  1355. else
  1356. SetLastError(Ret);
  1357. IndyRaiseLastError;
  1358. end;
  1359. until False;
  1360. if Ret = ERROR_SUCCESS then
  1361. begin
  1362. // on XP and later, GetAdaptersInfo() includes uni-directional adapters.
  1363. // Need to use GetUniDirectionalAdapterInfo() to filter them out of the
  1364. // list ...
  1365. if IndyCheckWindowsVersion(5, 1) then begin
  1366. UniDirAddresses := TStringList.Create;
  1367. end else begin
  1368. UniDirAddresses := nil;
  1369. end;
  1370. try
  1371. if UniDirAddresses <> nil then begin
  1372. GetUniDirAddresseses(UniDirAddresses);
  1373. end;
  1374. AAddresses.BeginUpdate;
  1375. try
  1376. Adapter := Adapters;
  1377. repeat
  1378. IPAddr := @(Adapter^.IpAddressList);
  1379. repeat
  1380. {$IFDEF USE_MARSHALLED_PTRS}
  1381. IPStr := TMarshal.ReadStringAsAnsiUpTo(CP_ACP, TPtrWrapper.Create(@(IPAddr^.IpAddress.S[0]), 15);
  1382. {$ELSE}
  1383. IPStr := String(IPAddr^.IpAddress.S);
  1384. {$ENDIF}
  1385. if (IPStr <> '') and (IPStr <> '0.0.0.0') then
  1386. begin
  1387. if UniDirAddresses <> nil then begin
  1388. if UniDirAddresses.IndexOf(IPStr) <> -1 then begin
  1389. IPAddr := IPAddr^.Next;
  1390. Continue;
  1391. end;
  1392. end;
  1393. {$IFDEF USE_MARSHALLED_PTRS}
  1394. MaskStr := TMarshal.ReadStringAsAnsiUpTo(CP_ACP, TPtrWrapper.Create(@(IPAddr^.IpMask.S[0]), 15);
  1395. {$ELSE}
  1396. MaskStr := String(IPAddr^.IpMask.S);
  1397. {$ENDIF}
  1398. LAddress := TIdStackLocalAddressIPv4.Create(AAddresses, IPStr, MaskStr);
  1399. {$I IdObjectChecksOff.inc}
  1400. TIdStackLocalAddressAccess(LAddress).FDescription := String(Adapter^.Description);
  1401. TIdStackLocalAddressAccess(LAddress).FFriendlyName := String(Adapter^.AdapterName);
  1402. TIdStackLocalAddressAccess(LAddress).FInterfaceName := String(Adapter^.AdapterName);
  1403. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := Adapter^.Index;
  1404. {$I IdObjectChecksOn.inc}
  1405. end;
  1406. IPAddr := IPAddr^.Next;
  1407. until IPAddr = nil;
  1408. Adapter := Adapter^.Next;
  1409. until Adapter = nil;
  1410. finally
  1411. AAddresses.EndUpdate;
  1412. end;
  1413. finally
  1414. UniDirAddresses.Free;
  1415. end;
  1416. end;
  1417. finally
  1418. FreeMem(Adapters);
  1419. end;
  1420. end;
  1421. {$ELSE}
  1422. procedure GetLocalAddressesByHostName;
  1423. var
  1424. {$IFDEF UNICODE}
  1425. Hints: TAddrInfoW;
  1426. LAddrList, LAddrInfo: pAddrInfoW;
  1427. {$ELSE}
  1428. Hints: TAddrInfo;
  1429. LAddrList, LAddrInfo: pAddrInfo;
  1430. {$ENDIF}
  1431. RetVal: Integer;
  1432. LHostName: String;
  1433. {$IFDEF STRING_UNICODE_MISMATCH}
  1434. LTemp: TIdPlatformString;
  1435. {$ENDIF}
  1436. //LAddress: TIdStackLocalAddress;
  1437. begin
  1438. LHostName := HostName;
  1439. ZeroMemory(@Hints, SIZE_TADDRINFO);
  1440. Hints.ai_family := PF_UNSPEC; // returns both IPv4 and IPv6 addresses
  1441. Hints.ai_socktype := SOCK_STREAM;
  1442. LAddrList := nil;
  1443. {$IFDEF STRING_UNICODE_MISMATCH}
  1444. LTemp := TIdPlatformString(LHostName); // explicit convert to Ansi/Unicode
  1445. {$ENDIF}
  1446. RetVal := getaddrinfo(
  1447. {$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(LHostName){$ENDIF},
  1448. nil, @Hints, @LAddrList);
  1449. if RetVal <> 0 then begin
  1450. RaiseSocketError(gaiErrorToWsaError(RetVal));
  1451. end;
  1452. try
  1453. AAddresses.BeginUpdate;
  1454. try
  1455. LAddrInfo := LAddrList;
  1456. repeat
  1457. //LAddress := nil;
  1458. case LAddrInfo^.ai_addr^.sa_family of
  1459. AF_INET: begin
  1460. {LAddress :=} TIdStackLocalAddressIPv4.Create(AAddresses,
  1461. TranslateTInAddrToString(PSockAddrIn(LAddrInfo^.ai_addr)^.sin_addr, Id_IPv4),
  1462. ''); // TODO: SubNet
  1463. end;
  1464. AF_INET6: begin
  1465. {LAddress :=} TIdStackLocalAddressIPv6.Create(AAddresses,
  1466. TranslateTInAddrToString(PSockAddrIn6(LAddrInfo^.ai_addr)^.sin6_addr, Id_IPv6));
  1467. end;
  1468. end;
  1469. // TODO: implement this...
  1470. {
  1471. if LAddress <> nil then begin
  1472. ($I IdObjectChecksOff.inc)
  1473. TIdStackLocalAddressAccess(LAddress).FDescription := ?;
  1474. TIdStackLocalAddressAccess(LAddress).FFriendlyName := ?;
  1475. TIdStackLocalAddressAccess(LAddress).FInterfaceName := ?;
  1476. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := ?;
  1477. ($I IdObjectChecksOn.inc)
  1478. end;
  1479. }
  1480. LAddrInfo := LAddrInfo^.ai_next;
  1481. until LAddrInfo = nil;
  1482. finally
  1483. AAddresses.EndUpdate;
  1484. end;
  1485. finally
  1486. freeaddrinfo(LAddrList);
  1487. end;
  1488. end;
  1489. {$ENDIF}
  1490. begin
  1491. // Using gethostname() and (gethostbyname|getaddrinfo)() may not always return
  1492. // just the machine's IP addresses. Technically speaking, they will return
  1493. // the local hostname, and then return the address(es) to which that hostname
  1494. // resolves. It is possible for a machine to (a) be configured such that its
  1495. // name does not resolve to an IP, or (b) be configured such that its name
  1496. // resolves to multiple IPs, only one of which belongs to the local machine.
  1497. // For better results, we should use the Win32 API GetAdaptersInfo() and/or
  1498. // GetAdaptersAddresses() functions instead. GetAdaptersInfo() only supports
  1499. // IPv4, but GetAdaptersAddresses() supports both IPv4 and IPv6...
  1500. {$IFDEF USE_IPHLPAPI}
  1501. // try GetAdaptersAddresses() first, then fall back to GetAdaptersInfo()...
  1502. if not GetLocalAddressesByAdaptersAddresses then begin
  1503. GetLocalAddressesByAdaptersInfo;
  1504. end;
  1505. {$ELSE}
  1506. GetLocalAddressesByHostName;
  1507. {$ENDIF}
  1508. end;
  1509. { TIdStackVersionWinsock }
  1510. function TIdStackWindows.WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer;
  1511. begin
  1512. Result := Shutdown(ASocket, AHow);
  1513. end;
  1514. procedure TIdStackWindows.GetSocketName(ASocket: TIdStackSocketHandle;
  1515. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  1516. var
  1517. LSize: Integer;
  1518. LAddr: SOCKADDR_STORAGE;
  1519. begin
  1520. LSize := SizeOf(LAddr);
  1521. CheckForSocketError(getsockname(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
  1522. case LAddr.ss_family of
  1523. Id_PF_INET4: begin
  1524. VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
  1525. VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
  1526. VIPVersion := Id_IPv4;
  1527. end;
  1528. Id_PF_INET6: begin
  1529. VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
  1530. VPort := Ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
  1531. VIPVersion := Id_IPv6;
  1532. end;
  1533. else begin
  1534. IPVersionUnsupported;
  1535. end;
  1536. end;
  1537. end;
  1538. { TIdSocketListWindows }
  1539. type
  1540. // WARNING: If you are thinking of rewriting this to use WSAPoll() instead of select(),
  1541. // similar to TIdSocketListVCLPosix, then note that WSAPoll() is broken prior to
  1542. // Windows 10 version 2004! See:
  1543. //
  1544. // https://daniel.haxx.se/blog/2012/10/10/wsapoll-is-broken/
  1545. // https://stackoverflow.com/questions/21653003/is-this-wsapoll-bug-for-non-blocking-sockets-fixed
  1546. //
  1547. TIdSocketListWindows = class(TIdSocketList)
  1548. protected
  1549. FFDSet: TFDSet;
  1550. //
  1551. class function FDSelect(AReadSet: PFDSet; AWriteSet: PFDSet; AExceptSet: PFDSet;
  1552. const ATimeout: Integer = IdTimeoutInfinite): Boolean;
  1553. function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  1554. public
  1555. procedure Add(AHandle: TIdStackSocketHandle); override;
  1556. procedure Remove(AHandle: TIdStackSocketHandle); override;
  1557. function Count: Integer; override;
  1558. procedure Clear; override;
  1559. function Clone: TIdSocketList; override;
  1560. function ContainsSocket(AHandle: TIdStackSocketHandle): boolean; override;
  1561. procedure GetFDSet(var VSet: TFDSet);
  1562. procedure SetFDSet(var VSet: TFDSet);
  1563. class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
  1564. AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  1565. function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  1566. function SelectReadList(var VSocketList: TIdSocketList;
  1567. const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  1568. end;
  1569. procedure TIdSocketListWindows.Add(AHandle: TIdStackSocketHandle);
  1570. begin
  1571. Lock;
  1572. try
  1573. // TODO: on Windows, the number of sockets that select() can query is limited only
  1574. // by available memory, unlike other platforms which are limited to querying sockets
  1575. // whose descriptors are less than FD_SETSIZE (1024). However, the Winsock SDK does
  1576. // define FD_SETSIZE for compatibilty with other platforms, but it is a meesely 64
  1577. // by default, and the IdWinSock2 unit does use FD_SETSIZE in its definition of
  1578. // TFDSet. C/C++ programs can freely override the value of FD_SETSIZE at compile-time,
  1579. // but that is not an option for Pascal programs. So, we need to find a way to make
  1580. // this more dynamic/configurable. For instance, by having this class hold a dynamic
  1581. // byte array that is casted to PFDSet when needed...
  1582. if not fd_isset(AHandle, FFDSet) then begin
  1583. if FFDSet.fd_count >= u_int(Length(FFDSet.fd_array)){FD_SETSIZE} then begin
  1584. raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
  1585. end;
  1586. FFDSet.fd_array[FFDSet.fd_count] := AHandle;
  1587. Inc(FFDSet.fd_count);
  1588. end;
  1589. finally
  1590. Unlock;
  1591. end;
  1592. end;
  1593. procedure TIdSocketListWindows.Clear;
  1594. begin
  1595. Lock;
  1596. try
  1597. fd_zero(FFDSet);
  1598. finally
  1599. Unlock;
  1600. end;
  1601. end;
  1602. function TIdSocketListWindows.ContainsSocket(AHandle: TIdStackSocketHandle): Boolean;
  1603. begin
  1604. Lock;
  1605. try
  1606. Result := fd_isset(AHandle, FFDSet);
  1607. finally
  1608. Unlock;
  1609. end;
  1610. end;
  1611. function TIdSocketListWindows.Count: Integer;
  1612. begin
  1613. Lock;
  1614. try
  1615. Result := FFDSet.fd_count;
  1616. finally
  1617. Unlock;
  1618. end;
  1619. end;
  1620. function TIdSocketListWindows.GetItem(AIndex: Integer): TIdStackSocketHandle;
  1621. begin
  1622. // keep the compiler happy (when was this fixed exactly?)
  1623. {$IFDEF DCC}{$IFNDEF VCL_8_OR_ABOVE}
  1624. Result := INVALID_SOCKET;
  1625. {$ENDIF}{$ENDIF}
  1626. Lock;
  1627. try
  1628. //We can't redefine AIndex to be a UInt32 because the libc Interface
  1629. //and DotNET define it as a LongInt. OS/2 defines it as a UInt16.
  1630. if (AIndex < 0) or (u_int(AIndex) >= FFDSet.fd_count) then begin
  1631. // TODO: just return 0/invalid, like most of the other Stack classes do?
  1632. raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
  1633. end;
  1634. Result := FFDSet.fd_array[AIndex];
  1635. finally
  1636. Unlock;
  1637. end;
  1638. end;
  1639. procedure TIdSocketListWindows.Remove(AHandle: TIdStackSocketHandle);
  1640. var
  1641. i: Integer;
  1642. begin
  1643. Lock;
  1644. try
  1645. {
  1646. IMPORTANT!!!
  1647. Sometimes, there may not be a member of the FDSET. If you attempt to "remove"
  1648. an item, the loop would execute once.
  1649. }
  1650. if FFDSet.fd_count > 0 then
  1651. begin
  1652. for i:= 0 to FFDSet.fd_count - 1 do
  1653. begin
  1654. if FFDSet.fd_array[i] = AHandle then
  1655. begin
  1656. Dec(FFDSet.fd_count);
  1657. FFDSet.fd_array[i] := FFDSet.fd_array[FFDSet.fd_count];
  1658. FFDSet.fd_array[FFDSet.fd_count] := 0; //extra purity
  1659. Break;
  1660. end;//if found
  1661. end;
  1662. end;
  1663. finally
  1664. Unlock;
  1665. end;
  1666. end;
  1667. function TIdStackWindows.WSTranslateSocketErrorMsg(const AErr: Integer): string;
  1668. begin
  1669. if AErr = WSAHOST_NOT_FOUND then begin
  1670. Result := IndyFormat(RSStackError, [AErr, RSStackHOST_NOT_FOUND]);
  1671. end else begin
  1672. Result := inherited WSTranslateSocketErrorMsg(AErr);
  1673. end;
  1674. end;
  1675. function TIdSocketListWindows.SelectRead(const ATimeout: Integer): Boolean;
  1676. var
  1677. LSet: TFDSet;
  1678. begin
  1679. // Windows updates this structure on return, so we need to copy it each time we need it
  1680. GetFDSet(LSet);
  1681. Result := FDSelect(@LSet, nil, nil, ATimeout);
  1682. end;
  1683. class function TIdSocketListWindows.FDSelect(AReadSet, AWriteSet,
  1684. AExceptSet: PFDSet; const ATimeout: Integer): Boolean;
  1685. var
  1686. LResult: Integer;
  1687. LTime: TTimeVal;
  1688. LTimePtr: PTimeVal;
  1689. begin
  1690. if ATimeout = IdTimeoutInfinite then begin
  1691. LTimePtr := nil;
  1692. end else begin
  1693. LTime.tv_sec := ATimeout div 1000;
  1694. LTime.tv_usec := (ATimeout mod 1000) * 1000;
  1695. LTimePtr := @LTime;
  1696. end;
  1697. LResult := IdWinsock2.select(0, AReadSet, AWriteSet, AExceptSet, LTimePtr);
  1698. //TODO: Remove this cast
  1699. Result := GStack.CheckForSocketError(LResult) > 0;
  1700. end;
  1701. function TIdSocketListWindows.SelectReadList(var VSocketList: TIdSocketList;
  1702. const ATimeout: Integer): Boolean;
  1703. var
  1704. LSet: TFDSet;
  1705. begin
  1706. // Windows updates this structure on return, so we need to copy it each time we need it
  1707. GetFDSet(LSet);
  1708. Result := FDSelect(@LSet, nil, nil, ATimeout);
  1709. if Result then
  1710. begin
  1711. if VSocketList = nil then begin
  1712. VSocketList := TIdSocketList.CreateSocketList;
  1713. end;
  1714. TIdSocketListWindows(VSocketList).SetFDSet(LSet);
  1715. end;
  1716. end;
  1717. class function TIdSocketListWindows.Select(AReadList, AWriteList,
  1718. AExceptList: TIdSocketList; const ATimeout: Integer): Boolean;
  1719. var
  1720. LReadSet: TFDSet;
  1721. LWriteSet: TFDSet;
  1722. LExceptSet: TFDSet;
  1723. LPReadSet: PFDSet;
  1724. LPWriteSet: PFDSet;
  1725. LPExceptSet: PFDSet;
  1726. procedure ReadSet(AList: TIdSocketList; var ASet: TFDSet; var APSet: PFDSet);
  1727. begin
  1728. if AList <> nil then begin
  1729. TIdSocketListWindows(AList).GetFDSet(ASet);
  1730. APSet := @ASet;
  1731. end else begin
  1732. APSet := nil;
  1733. end;
  1734. end;
  1735. begin
  1736. ReadSet(AReadList, LReadSet, LPReadSet);
  1737. ReadSet(AWriteList, LWriteSet, LPWriteSet);
  1738. ReadSet(AExceptList, LExceptSet, LPExceptSet);
  1739. Result := FDSelect(LPReadSet, LPWriteSet, LPExceptSet, ATimeout);
  1740. if AReadList <> nil then begin
  1741. TIdSocketListWindows(AReadList).SetFDSet(LReadSet);
  1742. end;
  1743. if AWriteList <> nil then begin
  1744. TIdSocketListWindows(AWriteList).SetFDSet(LWriteSet);
  1745. end;
  1746. if AExceptList <> nil then begin
  1747. TIdSocketListWindows(AExceptList).SetFDSet(LExceptSet);
  1748. end;
  1749. end;
  1750. procedure TIdSocketListWindows.SetFDSet(var VSet: TFDSet);
  1751. begin
  1752. Lock;
  1753. try
  1754. FFDSet := VSet;
  1755. finally
  1756. Unlock;
  1757. end;
  1758. end;
  1759. procedure TIdSocketListWindows.GetFDSet(var VSet: TFDSet);
  1760. begin
  1761. Lock;
  1762. try
  1763. VSet := FFDSet;
  1764. finally
  1765. Unlock;
  1766. end;
  1767. end;
  1768. procedure TIdStackWindows.SetBlocking(ASocket: TIdStackSocketHandle;
  1769. const ABlocking: Boolean);
  1770. var
  1771. LValue: UInt32;
  1772. begin
  1773. LValue := UInt32(not ABlocking);
  1774. CheckForSocketError(ioctlsocket(ASocket, FIONBIO, LValue));
  1775. end;
  1776. function TIdSocketListWindows.Clone: TIdSocketList;
  1777. begin
  1778. Result := TIdSocketListWindows.Create;
  1779. try
  1780. Lock;
  1781. try
  1782. TIdSocketListWindows(Result).SetFDSet(FFDSet);
  1783. finally
  1784. Unlock;
  1785. end;
  1786. except
  1787. FreeAndNil(Result);
  1788. raise;
  1789. end;
  1790. end;
  1791. function TIdStackWindows.WouldBlock(const AResult: Integer): Boolean;
  1792. begin
  1793. Result := (AResult = WSAEWOULDBLOCK);
  1794. end;
  1795. function TIdStackWindows.HostByName(const AHostName: string;
  1796. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  1797. var
  1798. {$IFDEF UNICODE}
  1799. LAddrInfo: pAddrInfoW;
  1800. Hints: TAddrInfoW;
  1801. {$ELSE}
  1802. LAddrInfo: pAddrInfo;
  1803. Hints: TAddrInfo;
  1804. {$ENDIF}
  1805. RetVal: Integer;
  1806. LHostName: String;
  1807. {$IFDEF STRING_UNICODE_MISMATCH}
  1808. LTemp: TIdPlatformString;
  1809. {$ENDIF}
  1810. begin
  1811. if not (AIPVersion in [Id_IPv4, Id_IPv6]) then begin
  1812. IPVersionUnsupported;
  1813. end;
  1814. ZeroMemory(@Hints, SIZE_TADDRINFO);
  1815. Hints.ai_family := IdIPFamily[AIPVersion];
  1816. Hints.ai_socktype := SOCK_STREAM;
  1817. LAddrInfo := nil;
  1818. if UseIDNAPI then begin
  1819. LHostName := IDNToPunnyCode(
  1820. {$IFDEF STRING_IS_UNICODE}
  1821. AHostName
  1822. {$ELSE}
  1823. TIdUnicodeString(AHostName) // explicit convert to Unicode
  1824. {$ENDIF}
  1825. );
  1826. end else begin
  1827. LHostName := AHostName;
  1828. end;
  1829. {$IFDEF STRING_UNICODE_MISMATCH}
  1830. LTemp := TIdPlatformString(LHostName); // explicit convert to Ansi/Unicode
  1831. {$ENDIF}
  1832. RetVal := getaddrinfo(
  1833. {$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(LHostName){$ENDIF},
  1834. nil, @Hints, @LAddrInfo);
  1835. if RetVal <> 0 then begin
  1836. RaiseSocketError(gaiErrorToWsaError(RetVal));
  1837. end;
  1838. try
  1839. if AIPVersion = Id_IPv4 then begin
  1840. Result := TranslateTInAddrToString(PSockAddrIn(LAddrInfo^.ai_addr)^.sin_addr, Id_IPv4)
  1841. end else begin
  1842. Result := TranslateTInAddrToString(PSockAddrIn6(LAddrInfo^.ai_addr)^.sin6_addr, Id_IPv6);
  1843. end;
  1844. finally
  1845. freeaddrinfo(LAddrInfo);
  1846. end;
  1847. end;
  1848. procedure TIdStackWindows.Connect(const ASocket: TIdStackSocketHandle;
  1849. const AIP: string; const APort: TIdPort;
  1850. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  1851. var
  1852. LAddr: SOCKADDR_STORAGE;
  1853. LSize: Integer;
  1854. begin
  1855. FillChar(LAddr, SizeOf(LAddr), 0);
  1856. case AIPVersion of
  1857. Id_IPv4: begin
  1858. PSockAddrIn(@LAddr)^.sin_family := Id_PF_INET4;
  1859. TranslateStringToTInAddr(AIP, PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
  1860. PSockAddrIn(@LAddr)^.sin_port := htons(APort);
  1861. LSize := SIZE_TSOCKADDRIN;
  1862. end;
  1863. Id_IPv6: begin
  1864. PSockAddrIn6(@LAddr)^.sin6_family := Id_PF_INET6;
  1865. TranslateStringToTInAddr(AIP, PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
  1866. PSockAddrIn6(@LAddr)^.sin6_port := htons(APort);
  1867. LSize := SIZE_TSOCKADDRIN6;
  1868. end;
  1869. else begin
  1870. LSize := 0; // avoid warning
  1871. IPVersionUnsupported;
  1872. end;
  1873. end;
  1874. CheckForSocketError(IdWinsock2.connect(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
  1875. end;
  1876. procedure TIdStackWindows.GetPeerName(ASocket: TIdStackSocketHandle;
  1877. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  1878. var
  1879. LSize: Integer;
  1880. LAddr: SOCKADDR_STORAGE;
  1881. begin
  1882. LSize := SizeOf(LAddr);
  1883. CheckForSocketError(IdWinsock2.getpeername(ASocket, IdWinsock2.PSOCKADDR(@LAddr), LSize));
  1884. case LAddr.ss_family of
  1885. Id_PF_INET4: begin
  1886. VIP := TranslateTInAddrToString(PSockAddrIn(@LAddr)^.sin_addr, Id_IPv4);
  1887. VPort := ntohs(PSockAddrIn(@LAddr)^.sin_port);
  1888. VIPVersion := Id_IPv4;
  1889. end;
  1890. Id_PF_INET6: begin
  1891. VIP := TranslateTInAddrToString(PSockAddrIn6(@LAddr)^.sin6_addr, Id_IPv6);
  1892. VPort := ntohs(PSockAddrIn6(@LAddr)^.sin6_port);
  1893. VIPVersion := Id_IPv6;
  1894. end;
  1895. else begin
  1896. IPVersionUnsupported;
  1897. end;
  1898. end;
  1899. end;
  1900. procedure TIdStackWindows.Disconnect(ASocket: TIdStackSocketHandle);
  1901. begin
  1902. // Windows uses Id_SD_Send, Linux should use Id_SD_Both
  1903. // RLebeau: why Id_SD_Send and not Id_SD_Both on Windows? What if a blocking read is in progress?
  1904. WSShutdown(ASocket, Id_SD_Send);
  1905. // SO_LINGER is false - socket may take a little while to actually close after this
  1906. WSCloseSocket(ASocket);
  1907. end;
  1908. procedure TIdStackWindows.{$IFDEF VCL_XE3_OR_ABOVE}GetSocketOption{$ELSE}WSGetSocketOption{$ENDIF}
  1909. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  1910. var AOptVal; var AOptLen: Integer);
  1911. begin
  1912. CheckForSocketError(
  1913. getsockopt(ASocket, ALevel, AOptName,
  1914. {$IFNDEF HAS_PAnsiChar}
  1915. // TODO: use TPtrWrapper here?
  1916. {PIdAnsiChar}@AOptVal
  1917. {$ELSE}
  1918. PIdAnsiChar(@AOptVal)
  1919. {$ENDIF},
  1920. AOptLen
  1921. )
  1922. );
  1923. end;
  1924. procedure TIdStackWindows.{$IFDEF VCL_XE3_OR_ABOVE}SetSocketOption{$ELSE}WSSetSocketOption{$ENDIF}
  1925. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  1926. const AOptVal; const AOptLen: Integer);
  1927. begin
  1928. CheckForSocketError(
  1929. setsockopt(ASocket, ALevel, Aoptname,
  1930. {$IFNDEF HAS_PAnsiChar}
  1931. // TODO: use TPtrWrapper here?
  1932. {PIdAnsiChar}@AOptVal
  1933. {$ELSE}
  1934. PIdAnsiChar(@AOptVal)
  1935. {$ENDIF},
  1936. AOptLen
  1937. )
  1938. );
  1939. end;
  1940. function TIdStackWindows.SupportsIPv4: Boolean;
  1941. var
  1942. LLen : DWORD;
  1943. LPInfo, LPCurPtr: LPWSAPROTOCOL_INFO;
  1944. LCount : Integer;
  1945. i : Integer;
  1946. begin
  1947. // TODO: move this logic into CheckIPVersionSupport() instead...
  1948. // Result := CheckIPVersionSupport(Id_IPv4);
  1949. Result := False;
  1950. LPInfo := nil;
  1951. try
  1952. LLen := 0;
  1953. // Note: WSAEnumProtocols returns -1 when it is just called to get the needed Buffer Size!
  1954. repeat
  1955. LCount := IdWinsock2.WSAEnumProtocols(nil, LPInfo, LLen);
  1956. if LCount = SOCKET_ERROR then
  1957. begin
  1958. if WSAGetLastError() <> WSAENOBUFS then begin
  1959. Exit;
  1960. end;
  1961. ReallocMem(LPInfo, LLen);
  1962. end else begin
  1963. Break;
  1964. end;
  1965. until False;
  1966. if LCount > 0 then
  1967. begin
  1968. LPCurPtr := LPInfo;
  1969. for i := 0 to LCount-1 do
  1970. begin
  1971. if LPCurPtr^.iAddressFamily = AF_INET then
  1972. begin
  1973. Result := True;
  1974. Exit;
  1975. end;
  1976. Inc(LPCurPtr);
  1977. end;
  1978. end;
  1979. finally
  1980. FreeMem(LPInfo);
  1981. end;
  1982. end;
  1983. {
  1984. based on
  1985. http://groups.google.com/groups?q=Winsock2+Delphi+protocol&hl=en&lr=&ie=UTF-8&oe=utf-8&selm=3cebe697_2%40dnews&rnum=9
  1986. }
  1987. function TIdStackWindows.SupportsIPv6: Boolean;
  1988. var
  1989. LLen : DWORD;
  1990. LPInfo, LPCurPtr: LPWSAPROTOCOL_INFO;
  1991. LCount : Integer;
  1992. i : Integer;
  1993. begin
  1994. // TODO: move this logic into CheckIPVersionSupport() instead...
  1995. // Result := CheckIPVersionSupport(Id_IPv6);
  1996. Result := False;
  1997. LPInfo := nil;
  1998. try
  1999. LLen := 0;
  2000. // Note: WSAEnumProtocols returns -1 when it is just called to get the needed Buffer Size!
  2001. repeat
  2002. LCount := IdWinsock2.WSAEnumProtocols(nil, LPInfo, LLen);
  2003. if LCount = SOCKET_ERROR then
  2004. begin
  2005. if WSAGetLastError() <> WSAENOBUFS then begin
  2006. Exit;
  2007. end;
  2008. ReallocMem(LPInfo, LLen);
  2009. end else begin
  2010. Break;
  2011. end;
  2012. until False;
  2013. if LCount > 0 then
  2014. begin
  2015. LPCurPtr := LPInfo;
  2016. for i := 0 to LCount-1 do
  2017. begin
  2018. if LPCurPtr^.iAddressFamily = AF_INET6 then
  2019. begin
  2020. Result := True;
  2021. Exit;
  2022. end;
  2023. Inc(LPCurPtr);
  2024. end;
  2025. end;
  2026. finally
  2027. FreeMem(LPInfo);
  2028. end;
  2029. end;
  2030. function TIdStackWindows.IOControl(const s: TIdStackSocketHandle;
  2031. const cmd: UInt32; var arg: UInt32): Integer;
  2032. begin
  2033. Result := IdWinsock2.ioctlsocket(s, cmd, arg);
  2034. end;
  2035. procedure TIdStackWindows.WSQuerryIPv6Route(ASocket: TIdStackSocketHandle;
  2036. const AIP: String; const APort: TIdPort; var VSource; var VDest);
  2037. var
  2038. Llocalif : TSockAddrIn6;
  2039. LAddr : TSockAddrIn6;
  2040. Bytes : DWORD;
  2041. begin
  2042. //make our LAddrInfo structure
  2043. FillChar(LAddr, SizeOf(LAddr), 0);
  2044. LAddr.sin6_family := AF_INET6;
  2045. TranslateStringToTInAddr(AIP, LAddr.sin6_addr, Id_IPv6);
  2046. Move(LAddr.sin6_addr, VDest, SizeOf(in6_addr));
  2047. LAddr.sin6_port := htons(APort);
  2048. // Find out which local interface for the destination
  2049. // RLebeau: in XE4+, PDWORD is NOT defined as ^DWORD, so we have to use a type-cast!
  2050. CheckForSocketError(WSAIoctl(ASocket, SIO_ROUTING_INTERFACE_QUERY,
  2051. @LAddr, SizeOf(LAddr), @Llocalif, SizeOf(Llocalif), PDWORD(@Bytes), nil, nil));
  2052. Move(Llocalif.sin6_addr, VSource, SizeOf(in6_addr));
  2053. end;
  2054. procedure TIdStackWindows.WriteChecksum(s: TIdStackSocketHandle;
  2055. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  2056. const APort: TIdPort; const AIPVersion: TIdIPVersion);
  2057. begin
  2058. case AIPVersion of
  2059. Id_IPv4 : CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(VBuffer)), VBuffer, AOffset);
  2060. Id_IPv6 : WriteChecksumIPv6(s, VBuffer, AOffset, AIP, APort);
  2061. else
  2062. IPVersionUnsupported;
  2063. end;
  2064. end;
  2065. procedure TIdStackWindows.WriteChecksumIPv6(s: TIdStackSocketHandle;
  2066. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  2067. const APort: TIdPort);
  2068. var
  2069. LSource : TIdIn6Addr;
  2070. LDest : TIdIn6Addr;
  2071. LTmp : TIdBytes;
  2072. LIdx : Integer;
  2073. LC : UInt32;
  2074. {
  2075. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  2076. | |
  2077. + +
  2078. | |
  2079. + Source Address +
  2080. | |
  2081. + +
  2082. | |
  2083. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  2084. | |
  2085. + +
  2086. | |
  2087. + Destination Address +
  2088. | |
  2089. + +
  2090. | |
  2091. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  2092. | Upper-Layer Packet Length |
  2093. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  2094. | zero | Next Header |
  2095. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  2096. }
  2097. begin
  2098. WSQuerryIPv6Route(s, AIP, APort, LSource, LDest);
  2099. SetLength(LTmp, 40+Length(VBuffer));
  2100. //16
  2101. Move(LSource, LTmp[0], SIZE_TIN6ADDR);
  2102. LIdx := SIZE_TIN6ADDR;
  2103. //32
  2104. Move(LDest, LTmp[LIdx], SIZE_TIN6ADDR);
  2105. Inc(LIdx, SIZE_TIN6ADDR);
  2106. //use a word so you don't wind up using the wrong network byte order function
  2107. LC := UInt32(Length(VBuffer));
  2108. CopyTIdUInt32(HostToNetwork(LC), LTmp, LIdx);
  2109. Inc(LIdx, 4);
  2110. //36
  2111. //zero the next three bytes
  2112. FillChar(LTmp[LIdx], 3, 0);
  2113. Inc(LIdx, 3);
  2114. //next header (protocol type determines it
  2115. LTmp[LIdx] := Id_IPPROTO_ICMPV6; // Id_IPPROTO_ICMP6;
  2116. Inc(LIdx);
  2117. //combine the two
  2118. CopyTIdBytes(VBuffer, 0, LTmp, LIdx, Length(VBuffer));
  2119. //zero out the checksum field
  2120. CopyTIdUInt16(0, LTmp, LIdx+AOffset);
  2121. CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(LTmp)), VBuffer, AOffset);
  2122. end;
  2123. function TIdStackWindows.ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer : TIdBytes;
  2124. APkt: TIdPacketInfo): UInt32;
  2125. var
  2126. LIP : String;
  2127. LPort : TIdPort;
  2128. LIPVersion : TIdIPVersion;
  2129. {Windows CE does not have WSARecvMsg}
  2130. {$IFNDEF WINCE}
  2131. LSize: PtrUInt;
  2132. LAddr: TIdBytes;
  2133. PAddr: PSOCKADDR_STORAGE;
  2134. LMsg : TWSAMSG;
  2135. LMsgBuf : TWSABUF;
  2136. LControl : TIdBytes;
  2137. LCurCmsg : LPWSACMSGHDR; //for iterating through the control buffer
  2138. PPktInfo: PInPktInfo;
  2139. PPktInfo6: PIn6PktInfo;
  2140. {$ENDIF}
  2141. begin
  2142. {$IFNDEF WINCE}
  2143. //This runs only on WIndows XP or later
  2144. // XP 5.1 at least, Vista 6.0
  2145. if IndyCheckWindowsVersion(5, 1) then
  2146. begin
  2147. //we call the macro twice because we specified two possible structures.
  2148. //Id_IPV6_HOPLIMIT and Id_IPV6_PKTINFO
  2149. LSize := WSA_CMSG_SPACE(SizeOf(Byte)) + WSA_CMSG_SPACE(SizeOf(IN6_PKTINFO));
  2150. SetLength(LControl, LSize);
  2151. LMsgBuf.len := Length(VBuffer); // Length(VMsgData);
  2152. LMsgBuf.buf := PIdAnsiChar(Pointer(VBuffer)); // @VMsgData[0];
  2153. FillChar(LMsg, SIZE_TWSAMSG, 0);
  2154. LMsg.lpBuffers := @LMsgBuf;
  2155. LMsg.dwBufferCount := 1;
  2156. LMsg.Control.Len := LSize;
  2157. LMsg.Control.buf := PIdAnsiChar(Pointer(LControl));
  2158. // RLebeau: despite that we are not performing an overlapped I/O operation,
  2159. // WSARecvMsg() does not like the SOCKADDR variable being allocated on the
  2160. // stack, at least on my tests with Windows 7. So we will allocate it on
  2161. // the heap instead to keep WinSock happy...
  2162. SetLength(LAddr, SizeOf(SOCKADDR_STORAGE));
  2163. PAddr := PSOCKADDR_STORAGE(@LAddr[0]);
  2164. LMsg.name := IdWinsock2.PSOCKADDR(PAddr);
  2165. LMsg.namelen := Length(LAddr);
  2166. CheckForSocketError(WSARecvMsg(ASocket, @LMsg, Result, nil, nil));
  2167. APkt.Reset;
  2168. case PAddr^.ss_family of
  2169. Id_PF_INET4: begin
  2170. APkt.SourceIP := TranslateTInAddrToString(PSockAddrIn(PAddr)^.sin_addr, Id_IPv4);
  2171. APkt.SourcePort := ntohs(PSockAddrIn(PAddr)^.sin_port);
  2172. APkt.SourceIPVersion := Id_IPv4;
  2173. end;
  2174. Id_PF_INET6: begin
  2175. APkt.SourceIP := TranslateTInAddrToString(PSockAddrIn6(PAddr)^.sin6_addr, Id_IPv6);
  2176. APkt.SourcePort := ntohs(PSockAddrIn6(PAddr)^.sin6_port);
  2177. APkt.SourceIPVersion := Id_IPv6;
  2178. end;
  2179. else begin
  2180. Result := 0; // avoid warning
  2181. IPVersionUnsupported;
  2182. end;
  2183. end;
  2184. LCurCmsg := nil;
  2185. repeat
  2186. LCurCmsg := WSA_CMSG_NXTHDR(@LMsg, LCurCmsg);
  2187. if LCurCmsg = nil then begin
  2188. Break;
  2189. end;
  2190. case LCurCmsg^.cmsg_type of
  2191. IP_PKTINFO : //done this way because IPV6_PKTINF and IP_PKTINFO are both 19
  2192. begin
  2193. case PAddr^.ss_family of
  2194. Id_PF_INET4: begin
  2195. PPktInfo := PInPktInfo(WSA_CMSG_DATA(LCurCmsg));
  2196. APkt.DestIP := TranslateTInAddrToString(PPktInfo^.ipi_addr, Id_IPv4);
  2197. APkt.DestIF := PPktInfo^.ipi_ifindex;
  2198. APkt.DestIPVersion := Id_IPv4;
  2199. end;
  2200. Id_PF_INET6: begin
  2201. PPktInfo6 := PIn6PktInfo(WSA_CMSG_DATA(LCurCmsg));
  2202. APkt.DestIP := TranslateTInAddrToString(PPktInfo6^.ipi6_addr, Id_IPv6);
  2203. APkt.DestIF := PPktInfo6^.ipi6_ifindex;
  2204. APkt.DestIPVersion := Id_IPv6;
  2205. end;
  2206. end;
  2207. end;
  2208. Id_IPV6_HOPLIMIT :
  2209. begin
  2210. APkt.TTL := WSA_CMSG_DATA(LCurCmsg)^;
  2211. end;
  2212. end;
  2213. until False;
  2214. end else
  2215. begin
  2216. {$ENDIF}
  2217. Result := RecvFrom(ASocket, VBuffer, Length(VBuffer), 0, LIP, LPort, LIPVersion);
  2218. APkt.Reset;
  2219. APkt.SourceIP := LIP;
  2220. APkt.SourcePort := LPort;
  2221. APkt.SourceIPVersion := LIPVersion;
  2222. APkt.DestIPVersion := LIPVersion;
  2223. {$IFNDEF WINCE}
  2224. end;
  2225. {$ENDIF}
  2226. end;
  2227. function TIdStackWindows.CheckIPVersionSupport(const AIPVersion: TIdIPVersion): Boolean;
  2228. var
  2229. LTmpSocket: TIdStackSocketHandle;
  2230. begin
  2231. LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Id_SOCK_STREAM, Id_IPPROTO_IP);
  2232. Result := LTmpSocket <> Id_INVALID_SOCKET;
  2233. if Result then begin
  2234. WSCloseSocket(LTmpSocket);
  2235. end;
  2236. end;
  2237. {$IFNDEF WINCE}
  2238. {
  2239. This is somewhat messy but I wanted to do things this way to support Int64
  2240. file sizes.
  2241. }
  2242. function ServeFile(ASocket: TIdStackSocketHandle; const AFileName: string): Int64;
  2243. var
  2244. LFileHandle: THandle;
  2245. LSize: LARGE_INTEGER;
  2246. {$IFDEF STRING_UNICODE_MISMATCH}
  2247. LTemp: TIdPlatformString;
  2248. {$ENDIF}
  2249. begin
  2250. Result := 0;
  2251. {$IFDEF STRING_UNICODE_MISMATCH}
  2252. LTemp := TIdPlatformString(AFileName); // explicit convert to Ansi/Unicode
  2253. {$ENDIF}
  2254. LFileHandle := CreateFile(
  2255. {$IFDEF STRING_UNICODE_MISMATCH}PIdPlatformChar(LTemp){$ELSE}PChar(AFileName){$ENDIF},
  2256. GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING,
  2257. FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
  2258. if LFileHandle <> INVALID_HANDLE_VALUE then
  2259. begin
  2260. try
  2261. if TransmitFile(ASocket, LFileHandle, 0, 0, nil, nil, 0) then
  2262. begin
  2263. if Assigned(GetFileSizeEx) then
  2264. begin
  2265. if not GetFileSizeEx(LFileHandle, LSize) then begin
  2266. Exit;
  2267. end;
  2268. end else
  2269. begin
  2270. LSize.LowPart := GetFileSize(LFileHandle, @LSize.HighPart);
  2271. if (LSize.LowPart = $FFFFFFFF) and (GetLastError() <> 0) then begin
  2272. Exit;
  2273. end;
  2274. end;
  2275. Result := LSize.QuadPart;
  2276. end;
  2277. finally
  2278. CloseHandle(LFileHandle);
  2279. end;
  2280. end;
  2281. end;
  2282. {$ENDIF}
  2283. procedure TIdStackWindows.SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  2284. const AEnabled: Boolean; const ATimeMS, AInterval: Integer);
  2285. var
  2286. ka: _tcp_keepalive;
  2287. Bytes: DWORD;
  2288. begin
  2289. // TODO: instead of doing an OS version check, always call SIO_KEEPALIVE_VALS
  2290. // when AEnabled is True, and then fallback to SO_KEEPALIVE if WSAIoctl()
  2291. // reports that SIO_KEEPALIVE_VALS is not supported...
  2292. // SIO_KEEPALIVE_VALS is supported on Win2K+ and WinCE 4.x only
  2293. if AEnabled and IndyCheckWindowsVersion({$IFDEF WINCE}4{$ELSE}5{$ENDIF}) then
  2294. begin
  2295. ka.onoff := 1;
  2296. ka.keepalivetime := ATimeMS;
  2297. ka.keepaliveinterval := AInterval;
  2298. // RLebeau: in XE4+, PDWORD is NOT defined as ^DWORD, so we have to use a type-cast!
  2299. WSAIoctl(ASocket, SIO_KEEPALIVE_VALS, @ka, SizeOf(ka), nil, 0, PDWORD(@Bytes), nil, nil);
  2300. end else begin
  2301. SetSocketOption(ASocket, Id_SOL_SOCKET, Id_SO_KEEPALIVE, iif(AEnabled, 1, 0));
  2302. end;
  2303. end;
  2304. initialization
  2305. GStarted := False;
  2306. GSocketListClass := TIdSocketListWindows;
  2307. // Check if we are running under windows NT
  2308. {$IFNDEF WINCE}
  2309. if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
  2310. GetFileSizeEx := LoadLibFunction(GetModuleHandle('Kernel32.dll'), 'GetFileSizeEx');
  2311. GServeFileProc := ServeFile;
  2312. end;
  2313. {$ENDIF}
  2314. {$IFDEF USE_IPHLPAPI}
  2315. InitializeIPHelperStubs;
  2316. {$ENDIF}
  2317. finalization
  2318. IdWship6.CloseLibrary;
  2319. UninitializeWinSock;
  2320. {$IFDEF USE_IPHLPAPI}
  2321. UninitializeIPHelperAPI;
  2322. {$ENDIF}
  2323. GStarted := False;
  2324. end.