IdStackWindows.pas 78 KB

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