IdStackWindows.pas 81 KB

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