IdStackWindows.pas 79 KB

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