IdStackWindows.pas 81 KB

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