IdStackDotNet.pas 45 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417
  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. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.8 10/26/2004 8:12:30 PM JPMugaas
  18. Now uses TIdStrings and TIdStringList for portability.
  19. Rev 1.7 6/11/2004 8:28:56 AM DSiders
  20. Added "Do not Localize" comments.
  21. Rev 1.6 5/14/2004 12:14:50 PM BGooijen
  22. Fix for weird dotnet bug when querying the local binding
  23. Rev 1.5 4/18/04 2:45:54 PM RLebeau
  24. Conversion support for Int64 values
  25. Rev 1.4 2004.03.07 11:45:26 AM czhower
  26. Flushbuffer fix + other minor ones found
  27. Rev 1.3 3/6/2004 5:16:30 PM JPMugaas
  28. Bug 67 fixes. Do not write to const values.
  29. Rev 1.2 2/10/2004 7:33:26 PM JPMugaas
  30. I had to move the wrapper exception here for DotNET stack because Borland's
  31. update 1 does not permit unlisted units from being put into a package. That
  32. now would report an error and I didn't want to move IdExceptionCore into the
  33. System package.
  34. Rev 1.1 2/4/2004 8:48:30 AM JPMugaas
  35. Should compile.
  36. Rev 1.0 2004.02.03 3:14:46 PM czhower
  37. Move and updates
  38. Rev 1.32 2/1/2004 6:10:54 PM JPMugaas
  39. GetSockOpt.
  40. Rev 1.31 2/1/2004 3:28:32 AM JPMugaas
  41. Changed WSGetLocalAddress to GetLocalAddress and moved into IdStack since
  42. that will work the same in the DotNET as elsewhere. This is required to
  43. reenable IPWatch.
  44. Rev 1.30 1/31/2004 1:12:54 PM JPMugaas
  45. Minor stack changes required as DotNET does support getting all IP addresses
  46. just like the other stacks.
  47. Rev 1.29 2004.01.22 2:46:52 PM czhower
  48. Warning fixed.
  49. Rev 1.28 12/4/2003 3:14:54 PM BGooijen
  50. Added HostByAddress
  51. Rev 1.27 1/3/2004 12:22:14 AM BGooijen
  52. Added function SupportsIPv6
  53. Rev 1.26 1/2/2004 4:24:08 PM BGooijen
  54. This time both IPv4 and IPv6 work
  55. Rev 1.25 02/01/2004 15:58:00 HHariri
  56. fix for bind
  57. Rev 1.24 12/31/2003 9:52:00 PM BGooijen
  58. Added IPv6 support
  59. Rev 1.23 10/28/2003 10:12:36 PM BGooijen
  60. DotNet
  61. Rev 1.22 10/26/2003 10:31:16 PM BGooijen
  62. oops, checked in debug version <g>, this is the right one
  63. Rev 1.21 10/26/2003 5:04:26 PM BGooijen
  64. UDP Server and Client
  65. Rev 1.20 10/21/2003 11:03:50 PM BGooijen
  66. More SendTo, ReceiveFrom
  67. Rev 1.19 10/21/2003 9:24:32 PM BGooijen
  68. Started on SendTo, ReceiveFrom
  69. Rev 1.18 10/19/2003 5:21:30 PM BGooijen
  70. SetSocketOption
  71. Rev 1.17 10/11/2003 4:16:40 PM BGooijen
  72. Compiles again
  73. Rev 1.16 10/5/2003 9:55:28 PM BGooijen
  74. TIdTCPServer works on D7 and DotNet now
  75. Rev 1.15 10/5/2003 3:10:42 PM BGooijen
  76. forgot to clone the Sockets list in some Select methods, + added Listen and
  77. Accept
  78. Rev 1.14 10/5/2003 1:52:14 AM BGooijen
  79. Added typecasts with network ordering calls, there are required for some
  80. reason
  81. Rev 1.13 10/4/2003 10:39:38 PM BGooijen
  82. Renamed WSXXX functions in implementation section too
  83. Rev 1.12 04/10/2003 22:32:00 HHariri
  84. moving of WSNXXX method to IdStack and renaming of the DotNet ones
  85. Rev 1.11 04/10/2003 21:28:42 HHariri
  86. Netowkr ordering functions
  87. Rev 1.10 10/3/2003 11:02:02 PM BGooijen
  88. fixed calls to Socket.Select
  89. Rev 1.9 10/3/2003 11:39:38 PM GGrieve
  90. more work
  91. Rev 1.8 10/3/2003 12:09:32 AM BGooijen
  92. DotNet
  93. Rev 1.7 10/2/2003 8:23:52 PM BGooijen
  94. .net
  95. Rev 1.6 10/2/2003 8:08:52 PM BGooijen
  96. .Connect works not in .net
  97. Rev 1.5 10/2/2003 7:31:20 PM BGooijen
  98. .net
  99. Rev 1.4 10/2/2003 6:12:36 PM GGrieve
  100. work in progress (hardly started)
  101. Rev 1.3 2003.10.01 9:11:24 PM czhower
  102. .Net
  103. Rev 1.2 2003.10.01 5:05:18 PM czhower
  104. .Net
  105. Rev 1.1 2003.10.01 1:12:40 AM czhower
  106. .Net
  107. Rev 1.0 2003.09.30 10:35:40 AM czhower
  108. Initial Checkin
  109. }
  110. unit IdStackDotNet;
  111. interface
  112. {$i IdCompilerDefines.inc}
  113. uses
  114. Classes,
  115. IdGlobal, IdStack, IdStackConsts,
  116. System.Collections, System.IO, System.Net, System.Net.Sockets;
  117. type
  118. TIdSocketListDotNet = class(TIdSocketList)
  119. protected
  120. FSockets: ArrayList;
  121. function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  122. public
  123. constructor Create; override;
  124. destructor Destroy; override;
  125. procedure Add(AHandle: TIdStackSocketHandle); override;
  126. procedure Remove(AHandle: TIdStackSocketHandle); override;
  127. function Count: Integer; override;
  128. procedure Clear; override;
  129. function Clone: TIdSocketList; override;
  130. function ContainsSocket(AHandle: TIdStackSocketHandle): boolean; override;
  131. class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
  132. AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  133. function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  134. function SelectReadList(var VSocketList: TIdSocketList;
  135. const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  136. end;
  137. TIdStackDotNet = class(TIdStack)
  138. protected
  139. //Stuff for ICMPv6
  140. {$IFDEF DOTNET_2_OR_ABOVE}
  141. procedure QueryRoute(s : TIdStackSocketHandle; const AIP: String;
  142. const APort: TIdPort; var VSource, VDest : TIdBytes);
  143. procedure WriteChecksumIPv6(s: TIdStackSocketHandle;
  144. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  145. const APort: TIdPort);
  146. {$ENDIF}
  147. function ReadHostName: string; override;
  148. function HostByName(const AHostName: string;
  149. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  150. //internal IP Mutlicasting membership stuff
  151. procedure MembershipSockOpt(AHandle: TIdStackSocketHandle;
  152. const AGroupIP, ALocalIP : String; const ASockOpt : TIdSocketOption;
  153. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  154. public
  155. [ThreadStatic]
  156. LastSocketError: Integer; //static;
  157. constructor Create; override;
  158. destructor Destroy; override;
  159. procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string; const APort: TIdPort;
  160. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION ); override;
  161. procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  162. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  163. procedure Disconnect(ASocket: TIdStackSocketHandle); override;
  164. procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  165. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  166. procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  167. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  168. function WSGetLastError: Integer; override;
  169. procedure WSSetLastError(const AErr : Integer); override;
  170. function NewSocketHandle(const ASocketType: TIdSocketType;
  171. const AProtocol: TIdSocketProtocol;
  172. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION;
  173. const ANonBlocking: Boolean = False) : TIdStackSocketHandle; override;
  174. // Result:
  175. // > 0: Number of bytes received
  176. // 0: Connection closed gracefully
  177. // Will raise exceptions in other cases
  178. function Receive(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes) : Integer; override;
  179. function Send(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  180. const AOffset: Integer = 0; const ASize: Integer = -1): Integer; override;
  181. function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32;
  182. var arg: UInt32): Integer; override;
  183. function ReceiveFrom(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  184. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer; override;
  185. function ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  186. APkt: TIdPacketInfo): UInt32; override;
  187. function SendTo(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  188. const AOffset: Integer; const ASize: Integer; const AIP: string; const APort: TIdPort;
  189. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer; override;
  190. function HostToNetwork(AValue: UInt16): UInt16; override;
  191. function NetworkToHost(AValue: UInt16): UInt16; override;
  192. function HostToNetwork(AValue: UInt32): UInt32; override;
  193. function NetworkToHost(AValue: UInt32): UInt32; override;
  194. function HostToNetwork(AValue: TIdUInt64): TIdUInt64; override;
  195. function NetworkToHost(AValue: TIdUInt64): TIdUInt64; override;
  196. function HostByAddress(const AAddress: string;
  197. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  198. procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);override;
  199. function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort;
  200. var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
  201. procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  202. AOptName: TIdSocketOption; out AOptVal: Integer); override;
  203. procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel:TIdSocketOptionLevel;
  204. AOptName: TIdSocketOption; AOptVal: Integer); overload; override;
  205. function SupportsIPv4: Boolean; override;
  206. function SupportsIPv6: Boolean; override;
  207. //multicast stuff Kudzu permitted me to add here.
  208. procedure SetMulticastTTL(AHandle: TIdStackSocketHandle; const AValue : Byte;
  209. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  210. procedure SetLoopBack(AHandle: TIdStackSocketHandle; const AValue: Boolean;
  211. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  212. procedure DropMulticastMembership(AHandle: TIdStackSocketHandle;
  213. const AGroupIP, ALocalIP : String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  214. procedure AddMulticastMembership(AHandle: TIdStackSocketHandle;
  215. const AGroupIP, ALocalIP : String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  216. procedure WriteChecksum(s : TIdStackSocketHandle; var VBuffer : TIdBytes;
  217. const AOffset : Integer; const AIP : String; const APort : TIdPort;
  218. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  219. procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override;
  220. procedure SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  221. const AEnabled: Boolean; const ATimeMS, AInterval: Integer); override;
  222. end;
  223. {$IFDEF DOTNET_1_1}
  224. EIdNotSupportedInMicrosoftNET11 = class(EIdStackError);
  225. {$ENDIF}
  226. var
  227. GDotNETStack : TIdStackDotNet = nil;
  228. implementation
  229. uses
  230. IdException, IdResourceStrings;
  231. const
  232. IdIPFamily : array[TIdIPVersion] of AddressFamily = (AddressFamily.InterNetwork, AddressFamily.InterNetworkV6);
  233. { TIdStackDotNet }
  234. procedure DoRaiseException(AStack: TIdStackDotNet; AException: System.Exception);
  235. var
  236. LSocketError : System.Net.Sockets.SocketException;
  237. E: EIdException;
  238. begin
  239. if AException is System.Net.Sockets.SocketException then
  240. begin
  241. LSocketError := AException as System.Net.Sockets.SocketException;
  242. AStack.LastSocketError := LSocketError.ErrorCode;
  243. E := EIdSocketError.CreateError(LSocketError.ErrorCode, LSocketError.Message)
  244. end else begin
  245. E := EIdWrapperException.Create(AException.Message, AException);
  246. end;
  247. IndyRaiseOuterException(E);
  248. end;
  249. { TIdStackDotNet }
  250. constructor TIdStackDotNet.Create;
  251. begin
  252. inherited Create;
  253. GDotNETStack := Self;
  254. end;
  255. destructor TIdStackDotNet.Destroy;
  256. begin
  257. GDotNETStack := nil;
  258. inherited Destroy;
  259. end;
  260. procedure TIdStackDotNet.Bind(ASocket: TIdStackSocketHandle; const AIP: string;
  261. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  262. var
  263. LIPAddr : IPAddress;
  264. LEndPoint : IPEndPoint;
  265. LIP: String;
  266. begin
  267. try
  268. if not (AIPVersion in [Id_IPv4, Id_IPv6]) then
  269. begin
  270. IPVersionUnsupported;
  271. end;
  272. LIP := AIP;
  273. if LIP = '' then begin
  274. if AIPVersion = Id_IPv4 then begin
  275. LIPAddr := IPAddress.Any;
  276. end else begin
  277. LIPAddr := IPAddress.IPv6Any;
  278. end;
  279. end else begin
  280. LIPAddr := IPAddress.Parse(LIP);
  281. end;
  282. LEndPoint := IPEndPoint.Create(LIPAddr, APort);
  283. ASocket.Bind(LEndPoint);
  284. except
  285. on e: Exception do begin
  286. DoRaiseException(Self, e);
  287. end;
  288. end;
  289. end;
  290. procedure TIdStackDotNet.Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  291. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  292. var
  293. LEndPoint : IPEndPoint;
  294. begin
  295. try
  296. LEndPoint := IPEndPoint.Create(IPAddress.Parse(AIP), APort);
  297. ASocket.Connect(LEndPoint);
  298. except
  299. on e: Exception do begin
  300. DoRaiseException(Self, e);
  301. end;
  302. end;
  303. end;
  304. procedure TIdStackDotNet.Disconnect(ASocket: TIdStackSocketHandle);
  305. begin
  306. try
  307. ASocket.Close;
  308. except
  309. on e: Exception do begin
  310. DoRaiseException(Self, e);
  311. end;
  312. end;
  313. end;
  314. procedure TIdStackDotNet.Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);
  315. begin
  316. try
  317. ASocket.Listen(ABackLog);
  318. except
  319. on e: Exception do begin
  320. DoRaiseException(Self, e);
  321. end;
  322. end;
  323. end;
  324. function TIdStackDotNet.Accept(ASocket: TIdStackSocketHandle;
  325. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
  326. var
  327. LEndPoint: IPEndPoint;
  328. begin
  329. try
  330. Result := ASocket.Accept();
  331. LEndPoint := Result.RemoteEndPoint as IPEndPoint;
  332. if (Result.AddressFamily = AddressFamily.InterNetwork) or
  333. (Result.AddressFamily = AddressFamily.InterNetworkV6) then
  334. begin
  335. VIP := LEndPoint.Address.ToString();
  336. VPort := LEndPoint.Port;
  337. if Result.AddressFamily = AddressFamily.InterNetworkV6 then begin
  338. VIPVersion := Id_IPv6;
  339. end else begin
  340. VIPVersion := Id_IPv4;
  341. end;
  342. end else
  343. begin
  344. Result := Id_INVALID_SOCKET;
  345. IPVersionUnsupported;
  346. end;
  347. except
  348. on e: Exception do begin
  349. DoRaiseException(Self, e);
  350. end;
  351. end;
  352. end;
  353. procedure TIdStackDotNet.GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  354. var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  355. var
  356. LEndPoint : IPEndPoint;
  357. begin
  358. try
  359. if (ASocket.AddressFamily = AddressFamily.InterNetwork) or
  360. (ASocket.AddressFamily = AddressFamily.InterNetworkV6) then
  361. begin
  362. LEndPoint := ASocket.RemoteEndPoint as IPEndPoint;
  363. VIP := LEndPoint.Address.ToString;
  364. VPort := LEndPoint.Port;
  365. if ASocket.AddressFamily = AddressFamily.InterNetworkV6 then begin
  366. VIPVersion := Id_IPv6;
  367. end else begin
  368. VIPVersion := Id_IPv4;
  369. end;
  370. end else begin
  371. IPVersionUnsupported;
  372. end;
  373. except
  374. on e: Exception do begin
  375. DoRaiseException(Self, e);
  376. end;
  377. end;
  378. end;
  379. procedure TIdStackDotNet.GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  380. var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  381. var
  382. LEndPoint : IPEndPoint;
  383. begin
  384. try
  385. if (ASocket.AddressFamily = AddressFamily.InterNetwork) or
  386. (ASocket.AddressFamily = AddressFamily.InterNetworkV6) then
  387. begin
  388. LEndPoint := ASocket.LocalEndPoint as IPEndPoint;
  389. VIP := LEndPoint.Address.ToString;
  390. VPort := LEndPoint.Port;
  391. if ASocket.AddressFamily = AddressFamily.InterNetworkV6 then begin
  392. VIPVersion := Id_IPv6;
  393. end else begin
  394. VIPVersion := Id_IPv4;
  395. end;
  396. end else begin
  397. IPVersionUnsupported;
  398. end;
  399. except
  400. on e: Exception do begin
  401. DoRaiseException(Self, e);
  402. end;
  403. end;
  404. end;
  405. function TIdStackDotNet.HostByName(const AHostName: string;
  406. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  407. var
  408. LIP: array of IPAddress;
  409. a: Integer;
  410. begin
  411. try
  412. {
  413. [Warning] IdStackDotNet.pas(417): W1000 Symbol 'Resolve' is deprecated:
  414. 'Resolve is obsoleted for this type, please use GetHostEntry instead.
  415. http://go.microsoft.com/fwlink/?linkid=14202'
  416. }
  417. {$IFDEF DOTNET_2_OR_ABOVE}
  418. LIP := Dns.GetHostEntry(AHostName).AddressList;
  419. {$ENDIF}
  420. {$IFDEF DOTNET_1_1}
  421. LIP := Dns.Resolve(AHostName).AddressList;
  422. {$ENDIF}
  423. for a := Low(LIP) to High(LIP) do begin
  424. if LIP[a].AddressFamily = IdIPFamily[AIPVersion] then begin
  425. Result := LIP[a].ToString;
  426. Exit;
  427. end;
  428. end;
  429. raise System.Net.Sockets.SocketException.Create(11001);
  430. except
  431. on e: Exception do begin
  432. DoRaiseException(Self, e);
  433. end;
  434. end;
  435. end;
  436. function TIdStackDotNet.HostByAddress(const AAddress: string;
  437. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  438. begin
  439. try
  440. {$IFDEF DOTNET_2_OR_ABOVE}
  441. Result := Dns.GetHostEntry(AAddress).HostName;
  442. {$ENDIF}
  443. {$IFDEF DOTNET_1_1}
  444. Result := Dns.GetHostByAddress(AAddress).HostName;
  445. {$ENDIF}
  446. except
  447. on e: Exception do begin
  448. DoRaiseException(Self, e);
  449. end;
  450. end;
  451. end;
  452. function TIdStackDotNet.WSGetLastError: Integer;
  453. begin
  454. Result := LastSocketError;
  455. end;
  456. procedure TIdStackDotNet.WSSetLastError(const AErr : Integer);
  457. begin
  458. LastSocketError := AErr;
  459. end;
  460. function TIdStackDotNet.NewSocketHandle(const ASocketType: TIdSocketType;
  461. const AProtocol: TIdSocketProtocol; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION;
  462. const ANonBlocking: Boolean = False): TIdStackSocketHandle;
  463. begin
  464. try
  465. Result := Socket.Create(IdIPFamily[AIPVersion], ASocketType, AProtocol);
  466. Result.Blocking := not ANonBlocking;
  467. except
  468. on E: Exception do begin
  469. DoRaiseException(Self, E);
  470. end;
  471. end;
  472. end;
  473. function TIdStackDotNet.ReadHostName: string;
  474. begin
  475. try
  476. Result := System.Net.DNS.GetHostName;
  477. except
  478. on E: Exception do begin
  479. DoRaiseException(Self, e);
  480. end;
  481. end;
  482. end;
  483. function TIdStackDotNet.Receive(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes): Integer;
  484. begin
  485. try
  486. Result := ASocket.Receive(VBuffer, Length(VBuffer), SocketFlags.None);
  487. except
  488. on e: Exception do begin
  489. DoRaiseException(Self, e);
  490. end;
  491. end;
  492. end;
  493. function TIdStackDotNet.Send(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  494. const AOffset: Integer = 0; const ASize: Integer = -1): Integer;
  495. var
  496. Tmp: TIdBytes;
  497. begin
  498. Result := IndyLength(ABuffer, ASize, AOffset);
  499. try
  500. if Result > 0 then begin
  501. Result := ASocket.Send(ABuffer, AOffset, Result, SocketFlags.None);
  502. end else
  503. begin
  504. // RLebeau: this is to allow UDP sockets to send 0-length packets. Send()
  505. // raises an exception if its buffer parameter is nil, and a 0-length byte
  506. // array is nil...
  507. //
  508. // TODO: check the socket type and only allow this for UDP sockets...
  509. //
  510. SetLength(Tmp, 1);
  511. Tmp[0] := $00;
  512. Result := ASocket.Send(Tmp, 0, 0, SocketFlags.None);
  513. end;
  514. except
  515. on E: Exception do begin
  516. DoRaiseException(Self, E);
  517. end;
  518. end;
  519. end;
  520. function TIdStackDotNet.ReceiveFrom(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  521. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer;
  522. var
  523. LIPAddr : IPAddress;
  524. LEndPoint : EndPoint;
  525. begin
  526. Result := 0; // to make the compiler happy
  527. case ASocket.AddressFamily of
  528. AddressFamily.InterNetwork: LIPAddr := IPAddress.Any;
  529. AddressFamily.InterNetworkV6: LIPAddr := IPAddress.IPv6Any;
  530. else
  531. IPVersionUnsupported;
  532. end;
  533. LEndPoint := IPEndPoint.Create(LIPAddr, 0);
  534. try
  535. try
  536. Result := ASocket.ReceiveFrom(VBuffer, SocketFlags.None, LEndPoint);
  537. except
  538. on e: Exception do begin
  539. DoRaiseException(Self, e);
  540. end;
  541. end;
  542. VIP := IPEndPoint(LEndPoint).Address.ToString;
  543. VPort := IPEndPoint(LEndPoint).Port;
  544. case IPEndPoint(LEndPoint).AddressFamily of
  545. AddressFamily.InterNetwork: VIPVersion := Id_IPv4;
  546. AddressFamily.InterNetworkV6: VIPVersion := Id_IPv6;
  547. end;
  548. finally
  549. LEndPoint.Free;
  550. end;
  551. end;
  552. function TIdStackDotNet.SendTo(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  553. const AOffset: Integer; const ASize: Integer; const AIP: string; const APort: TIdPort;
  554. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer;
  555. var
  556. LEndPoint : EndPoint;
  557. Tmp: TIdBytes;
  558. begin
  559. Result := IndyLength(ABuffer, ASize, AOffset);
  560. try
  561. LEndPoint := IPEndPoint.Create(IPAddress.Parse(AIP), APort);
  562. try
  563. if Result > 0 then begin
  564. Result := ASocket.SendTo(ABuffer, AOffset, Result, SocketFlags.None, LEndPoint);
  565. end else
  566. begin
  567. // RLebeau: this is to allow UDP sockets to send 0-length packets. SendTo()
  568. // raises an exception if its buffer parameter is nil, and a 0-length byte
  569. // array is nil...
  570. //
  571. // TODO: check the socket type and only allow this for UDP sockets...
  572. //
  573. SetLength(Tmp, 1);
  574. Tmp[0] := $00;
  575. Result := ASocket.SendTo(Tmp, 0, 0, SocketFlags.None, LEndPoint);
  576. end.
  577. finally
  578. LEndPoint.Free;
  579. end;
  580. except
  581. on e: Exception do begin
  582. DoRaiseException(Self, e);
  583. end;
  584. end;
  585. end;
  586. //////////////////////////////////////////////////////////////
  587. constructor TIdSocketListDotNet.Create;
  588. begin
  589. inherited Create;
  590. FSockets := ArrayList.Create;
  591. end;
  592. destructor TIdSocketListDotNet.Destroy;
  593. begin
  594. FSockets.Free;
  595. inherited Destroy;
  596. end;
  597. procedure TIdSocketListDotNet.Add(AHandle: TIdStackSocketHandle);
  598. begin
  599. FSockets.Add(AHandle);
  600. end;
  601. procedure TIdSocketListDotNet.Clear;
  602. begin
  603. FSockets.Clear;
  604. end;
  605. function TIdSocketListDotNet.ContainsSocket(AHandle: TIdStackSocketHandle): Boolean;
  606. begin
  607. Result := FSockets.Contains(AHandle);
  608. end;
  609. function TIdSocketListDotNet.Count: Integer;
  610. begin
  611. Result := FSockets.Count;
  612. end;
  613. function TIdSocketListDotNet.GetItem(AIndex: Integer): TIdStackSocketHandle;
  614. begin
  615. Result := (FSockets.Item[AIndex]) as TIdStackSocketHandle;
  616. end;
  617. procedure TIdSocketListDotNet.Remove(AHandle: TIdStackSocketHandle);
  618. begin
  619. FSockets.Remove(AHandle);
  620. end;
  621. const
  622. cMaxMSPerLoop = MaxInt div 1000; // max milliseconds per Socket.Select() call
  623. function TIdSocketListDotNet.SelectRead(const ATimeout: Integer): Boolean;
  624. var
  625. LTimeout: Integer;
  626. function DoSelect(const AInterval: Integer): Boolean;
  627. var
  628. LTemp: ArrayList;
  629. begin
  630. // DotNet updates this object on return, so we need to copy it each time we need it
  631. LTemp := ArrayList(FSockets.Clone);
  632. try
  633. Socket.Select(LTemp, nil, nil, AInterval);
  634. Result := LTemp.Count > 0;
  635. finally
  636. LTemp.Free;
  637. end;
  638. end;
  639. begin
  640. Result := False;
  641. try
  642. // RLebeau 8/27/2007: the .NET docs say that -1 is supposed to
  643. // cause an infinite timeout, but it doesn't actually work!
  644. // So loop manually instead until Microsoft fixes it...
  645. if ATimeout = IdTimeoutInfinite then
  646. begin
  647. repeat
  648. Result := DoSelect(MaxInt);
  649. until Result;
  650. end else
  651. begin
  652. // RLebeau: Select() accepts a timeout in microseconds, not
  653. // milliseconds, so have to loop anyway to handle timeouts
  654. // that are greater then 35 minutes...
  655. LTimeout := ATimeout;
  656. while LTimeout >= cMaxMSPerLoop do
  657. begin
  658. Result := DoSelect(cMaxMSPerLoop * 1000);
  659. if Result then begin
  660. Exit;
  661. end;
  662. Dec(LTimeout, cMaxMSPerLoop);
  663. end;
  664. if (not Result) and (LTimeout > 0) then begin
  665. Result := DoSelect(LTimeout * 1000);
  666. end;
  667. end;
  668. except
  669. on e: ArgumentNullException do begin
  670. Result := False;
  671. end;
  672. on e: Exception do begin
  673. DoRaiseException(GDotNETStack, e);
  674. end;
  675. end;
  676. end;
  677. function TIdSocketListDotNet.SelectReadList(var VSocketList: TIdSocketList;
  678. const ATimeout: Integer): Boolean;
  679. var
  680. LTemp: ArrayList;
  681. LTimeout: Integer;
  682. function DoSelect(const AInterval: Integer; var VList: ArrayList): Boolean;
  683. var
  684. LLTemp: ArrayList;
  685. begin
  686. // DotNet updates this object on return, so we need to copy it each time we need it
  687. LLTemp := ArrayList(FSockets.Clone);
  688. try
  689. Socket.Select(LLTemp, nil, nil, AInterval);
  690. Result := LLTemp.Count > 0;
  691. if Result then
  692. begin
  693. VList := LLTemp;
  694. LLTemp := nil;
  695. end;
  696. finally
  697. LLTemp.Free;
  698. end;
  699. end;
  700. begin
  701. Result := False;
  702. try
  703. // RLebeau 8/27/2007: the .NET docs say that -1 is supposed to
  704. // cause an infinite timeout, but it doesn't actually work!
  705. // So loop manually instead until Microsoft fixes it...
  706. if ATimeout = IdTimeoutInfinite then
  707. begin
  708. repeat
  709. Result := DoSelect(MaxInt, LTemp);
  710. until Result;
  711. end else
  712. begin
  713. // RLebeau: Select() accepts a timeout in microseconds, not
  714. // milliseconds, so have to loop anyway to handle timeouts
  715. // that are greater then 35 minutes...
  716. LTimeout := ATimeout;
  717. while LTimeout >= cMaxMSPerLoop do
  718. begin
  719. Result := DoSelect(cMaxMSPerLoop * 1000, LTemp);
  720. if Result then begin
  721. Break;
  722. end;
  723. Dec(LTimeout, cMaxMSPerLoop);
  724. end;
  725. if (not Result) and (LTimeout > 0) then begin
  726. Result := DoSelect(LTimeout * 1000, LTemp);
  727. end;
  728. end;
  729. if Result then
  730. begin
  731. try
  732. if VSocketList = nil then begin
  733. VSocketList := TIdSocketList.CreateSocketList;
  734. end;
  735. TIdSocketListDotNet(VSocketList).FSockets.Free;
  736. TIdSocketListDotNet(VSocketList).FSockets := LTemp;
  737. except
  738. LTemp.Free;
  739. raise;
  740. end;
  741. end;
  742. except
  743. on e: ArgumentNullException do begin
  744. Result := False;
  745. end;
  746. on e: Exception do begin
  747. DoRaiseException(GDotNETStack, e);
  748. end;
  749. end;
  750. end;
  751. class function TIdSocketListDotNet.Select(AReadList, AWriteList, AExceptList: TIdSocketList;
  752. const ATimeout: Integer): Boolean;
  753. var
  754. LTimeout: Integer;
  755. LReadTemp, LWriteTemp, LExceptTemp: ArrayList;
  756. function DoSelect(var VReadList, VWriteList, VExceptList: ArrayList;
  757. const AInterval: Integer): Boolean;
  758. var
  759. LLReadTemp: ArrayList;
  760. LLWriteTemp: ArrayList;
  761. LLExceptTemp: ArrayList;
  762. begin
  763. LLReadTemp := nil;
  764. LLWriteTemp := nil;
  765. LLExceptTemp := nil;
  766. VReadList := nil;
  767. VWriteList := nil;
  768. VExceptList := nil;
  769. // DotNet updates these objects on return, so we need to copy them each time we need them
  770. if Assigned(AReadList) and Assigned(TIdSocketListDotNet(AReadList).FSockets) then begin
  771. LLReadTemp := ArrayList(TIdSocketListDotNet(AReadList).FSockets.Clone);
  772. end;
  773. try
  774. if Assigned(AWriteList) and Assigned(TIdSocketListDotNet(AWriteList).FSockets) then begin
  775. LLWriteTemp := ArrayList(TIdSocketListDotNet(AWriteList).FSockets.Clone);
  776. end;
  777. try
  778. if Assigned(AExceptList) and Assigned(TIdSocketListDotNet(AExceptList).FSockets) then begin
  779. LLExceptTemp := ArrayList(TIdSocketListDotNet(AExceptList).FSockets.Clone);
  780. end;
  781. try
  782. Socket.Select(LLReadTemp, LLWriteTemp, LLExceptTemp, AInterval);
  783. Result := (LLReadTemp.Count > 0) or
  784. (LLWriteTemp.Count > 0) or
  785. (LLExceptTemp.Count > 0);
  786. if Result then
  787. begin
  788. VReadList := LLReadTemp;
  789. LLReadTemp:= nil;
  790. VWriteList := LLWriteTemp;
  791. LLWriteTemp:= nil;
  792. VExceptList := LLExceptTemp;
  793. LLExceptTemp:= nil;
  794. end;
  795. finally
  796. LLExceptTemp.Free;
  797. end;
  798. finally
  799. LLWriteTemp.Free;
  800. end;
  801. finally
  802. LLReadTemp.Free;
  803. end;
  804. end;
  805. begin
  806. Result := False;
  807. try
  808. // RLebeau 8/27/2007: the .NET docs say that -1 is supposed to
  809. // cause an infinite timeout, but it doesn't actually work!
  810. // So loop manually instead until Microsoft fixes it...
  811. if ATimeout = IdTimeoutInfinite then
  812. begin
  813. repeat
  814. Result := DoSelect(
  815. LReadTemp, LWriteTemp, LExceptTemp,
  816. MaxInt);
  817. until Result;
  818. end else
  819. begin
  820. // RLebeau: Select() accepts a timeout in microseconds, not
  821. // milliseconds, so have to loop anyway to handle timeouts
  822. // that are greater then 35 minutes...
  823. LTimeout := ATimeout;
  824. while LTimeout >= cMaxMSPerLoop do
  825. begin
  826. Result := DoSelect(
  827. LReadTemp, LWriteTemp, LExceptTemp,
  828. cMaxMSPerLoop * 1000);
  829. if Result then begin
  830. Break;
  831. end;
  832. Dec(LTimeout, cMaxMSPerLoop);
  833. end;
  834. if (not Result) and (LTimeout > 0) then
  835. begin
  836. Result := DoSelect(
  837. LReadTemp, LWriteTemp, LExceptTemp,
  838. LTimeout * 1000);
  839. end;
  840. end;
  841. // RLebeau: this method is meant to update the
  842. // source lists inlined regardless of the Result...
  843. if Assigned(AReadList) then
  844. begin
  845. TIdSocketListDotNet(AReadList).FSockets.Free;
  846. TIdSocketListDotNet(AReadList).FSockets := LReadTemp;
  847. end;
  848. if Assigned(AWriteList) then
  849. begin
  850. TIdSocketListDotNet(AWriteList).FSockets.Free;
  851. TIdSocketListDotNet(AWriteList).FSockets := LWriteTemp;
  852. end;
  853. if Assigned(AExceptList) then
  854. begin
  855. TIdSocketListDotNet(AExceptList).FSockets.Free;
  856. TIdSocketListDotNet(AExceptList).FSockets := LExceptTemp;
  857. end;
  858. except
  859. on e: ArgumentNullException do begin
  860. Result := False;
  861. end;
  862. on e: Exception do begin
  863. DoRaiseException(GDotNETStack, e);
  864. end;
  865. end;
  866. end;
  867. function TIdSocketListDotNet.Clone: TIdSocketList;
  868. begin
  869. Result := TIdSocketListDotNet.Create; //BGO: TODO: make prettier
  870. TIdSocketListDotNet(Result).FSockets.Free;
  871. TIdSocketListDotNet(Result).FSockets := ArrayList(FSockets.Clone);
  872. end;
  873. function TIdStackDotNet.HostToNetwork(AValue: UInt16): UInt16;
  874. begin
  875. Result := UInt16(IPAddress.HostToNetworkOrder(Int16(AValue)));
  876. end;
  877. function TIdStackDotNet.HostToNetwork(AValue: UInt32): UInt32;
  878. begin
  879. Result := UInt32(IPAddress.HostToNetworkOrder(Int32(AValue)));
  880. end;
  881. function TIdStackDotNet.HostToNetwork(AValue: TIdUInt64): TIdUInt64;
  882. begin
  883. Result := TIdUInt64(IPAddress.HostToNetworkOrder(Int64(AValue)));
  884. end;
  885. function TIdStackDotNet.NetworkToHost(AValue: UInt16): UInt16;
  886. begin
  887. Result := UInt16(IPAddress.NetworkToHostOrder(Int16(AValue)));
  888. end;
  889. function TIdStackDotNet.NetworkToHost(AValue: UInt32): UInt32;
  890. begin
  891. Result := UInt32(IPAddress.NetworkToHostOrder(Int32(AValue)));
  892. end;
  893. function TIdStackDotNet.NetworkToHost(AValue: TIdUInt64): TIdUInt64;
  894. begin
  895. Result := TIdUInt64(IPAddress.NetworkToHostOrder(Int64(AValue));
  896. end;
  897. procedure TIdStackDotNet.GetSocketOption(ASocket: TIdStackSocketHandle;
  898. ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; out AOptVal: Integer);
  899. var
  900. L : System.Object;
  901. begin
  902. L := ASocket.GetSocketOption(ALevel, AoptName);
  903. AOptVal := Integer(L);
  904. end;
  905. procedure TIdStackDotNet.SetSocketOption(ASocket: TIdStackSocketHandle;
  906. ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; AOptVal: Integer);
  907. begin
  908. ASocket.SetSocketOption(ALevel, AOptName, AOptVal);
  909. end;
  910. function TIdStackDotNet.SupportsIPv4: Boolean;
  911. begin
  912. {
  913. [Warning] IdStackDotNet.pas(734): W1000 Symbol 'SupportsIPv4' is deprecated:
  914. 'SupportsIPv4 is obsoleted for this type, please use OSSupportsIPv4 instead.
  915. http://go.microsoft.com/fwlink/?linkid=14202'
  916. }
  917. {$IFDEF DOTNET_2_OR_ABOVE}
  918. Result := Socket.OSSupportsIPv4;
  919. {$ENDIF}
  920. {$IFDEF DOTNET_1_1}
  921. Result := Socket.SupportsIPv4;
  922. {$ENDIF}
  923. end;
  924. function TIdStackDotNet.SupportsIPv6: Boolean;
  925. begin
  926. {
  927. [Warning] IdStackDotNet.pas(734): W1000 Symbol 'SupportsIPv6' is deprecated:
  928. 'SupportsIPv6 is obsoleted for this type, please use OSSupportsIPv6 instead.
  929. http://go.microsoft.com/fwlink/?linkid=14202'
  930. }
  931. {$IFDEF DOTNET_2_OR_ABOVE}
  932. Result := Socket.OSSupportsIPv6;
  933. {$ENDIF}
  934. {$IFDEF DOTNET_1_1}
  935. Result := Socket.SupportsIPv6;
  936. {$ENDIF}
  937. end;
  938. procedure TIdStackDotNet.GetLocalAddressList(AAddresses: TIdStackLocalAddressList);
  939. var
  940. {$IFDEF DOTNET_1_1}
  941. LAddr : IPAddress;
  942. {$ENDIF}
  943. LHost : IPHostEntry;
  944. LIPAddresses: array of IPAddress;
  945. LIPAddress: IPAddress;
  946. i : Integer;
  947. begin
  948. {$IFDEF DOTNET_2_OR_ABOVE}
  949. // TODO: use NetworkInterface.GetAllNetworkInterfaces() instead.
  950. // See this article for an example:
  951. // http://blogs.msdn.com/b/dgorti/archive/2005/10/04/477078.aspx
  952. LHost := DNS.GetHostEntry(DNS.GetHostName);
  953. {$ENDIF}
  954. {$IFDEF DOTNET_1_1}
  955. LAddr := IPAddress.Any;
  956. LHost := DNS.GetHostByAddress(LAddr);
  957. {$ENDIF}
  958. LIPAddresses := LHost.AddressList;
  959. if Length(LIPAddresses) > 0 then
  960. begin
  961. AAddresses.BeginUpdate;
  962. try
  963. for i := Low(LIPAddresses) to High(LIPAddresses) do
  964. begin
  965. LIPAddress := LIPAddresses[i];
  966. //This may be returning various types of addresses.
  967. case LIPAddress.AddressFamily of
  968. AddressFamily.InterNetwork: begin
  969. TIdStackLocalAddressIPv4.Create(AAddresses, LIPAddress.ToString, ''); // TODO: SubNet
  970. end;
  971. AddressFamily.InterNetworkV6: begin
  972. TIdStackLocalAddressIPv6.Create(AAddresses, LIPAddress.ToString);
  973. end;
  974. end;
  975. end;
  976. finally
  977. AAddresses.EndUpdate;
  978. end;
  979. end;
  980. end;
  981. procedure TIdStackDotNet.SetLoopBack(AHandle: TIdStackSocketHandle;
  982. const AValue: Boolean; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  983. begin
  984. //necessary because SetSocketOption only accepts an integer
  985. //see: http://groups-beta.google.com/group/microsoft.public.dotnet.languages.csharp/browse_thread/thread/6a35c6d9052cfc2b/f01fea11f9a24508?q=SetSocketOption+DotNET&rnum=2&hl=en#f01fea11f9a24508
  986. AHandle.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.MulticastLoopback, iif(AValue, 1, 0));
  987. end;
  988. procedure TIdStackDotNet.DropMulticastMembership(AHandle: TIdStackSocketHandle;
  989. const AGroupIP, ALocalIP: String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  990. begin
  991. MembershipSockOpt(AHandle, AGroupIP, ALocalIP, SocketOptionName.DropMembership);
  992. end;
  993. procedure TIdStackDotNet.AddMulticastMembership(AHandle: TIdStackSocketHandle;
  994. const AGroupIP, ALocalIP: String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  995. begin
  996. MembershipSockOpt(AHandle, AGroupIP, ALocalIP, SocketOptionName.AddMembership);
  997. end;
  998. procedure TIdStackDotNet.SetMulticastTTL(AHandle: TIdStackSocketHandle;
  999. const AValue: Byte; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  1000. begin
  1001. if AIPVersion = Id_IPv4 then begin
  1002. AHandle.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.MulticastTimeToLive, AValue);
  1003. end else begin
  1004. AHandle.SetSocketOption(SocketOptionLevel.IPv6, SocketOptionName.MulticastTimeToLive, AValue);
  1005. end;
  1006. end;
  1007. procedure TIdStackDotNet.MembershipSockOpt(AHandle: TIdStackSocketHandle;
  1008. const AGroupIP, ALocalIP: String; const ASockOpt: TIdSocketOption;
  1009. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  1010. var
  1011. LM4 : MulticastOption;
  1012. LM6 : IPv6MulticastOption;
  1013. LGroupIP, LLocalIP : System.Net.IPAddress;
  1014. begin
  1015. LGroupIP := IPAddress.Parse(AGroupIP);
  1016. if LGroupIP.AddressFamily = AddressFamily.InterNetworkV6 then
  1017. begin
  1018. LM6 := IPv6MulticastOption.Create(LGroupIP);
  1019. AHandle.SetSocketOption(SocketOptionLevel.IPv6, ASockOpt, LM6);
  1020. end else
  1021. begin
  1022. if ALocalIP.Length = 0 then begin
  1023. LM4 := System.Net.Sockets.MulticastOption.Create(LGroupIP);
  1024. end else
  1025. begin
  1026. LLocalIP := IPAddress.Parse(ALocalIP);
  1027. LM4 := System.Net.Sockets.MulticastOption.Create(LGroupIP, LLocalIP);
  1028. end;
  1029. AHandle.SetSocketOption(SocketOptionLevel.IP, ASockOpt, LM4);
  1030. end;
  1031. end;
  1032. function TIdStackDotNet.ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  1033. APkt: TIdPacketInfo): UInt32;
  1034. var
  1035. {$IFDEF DOTNET_1_1}
  1036. LIP : String;
  1037. LPort : TIdPort;
  1038. LIPVersion: TIdIPVersion;
  1039. {$ELSE}
  1040. LSF : SocketFlags;
  1041. LIPAddr : IPAddress;
  1042. LRemEP : EndPoint;
  1043. LPki : IPPacketInformation;
  1044. {$ENDIF}
  1045. begin
  1046. {$IFDEF DOTNET_1_1}
  1047. Result := ReceiveFrom(ASocket, VBuffer, LIP, LPort, LIPVersion);
  1048. APkt.Reset;
  1049. APkt.SourceIP := LIP;
  1050. APkt.SourcePort := LPort;
  1051. APkt.SourceIPVersion := LIPVersion;
  1052. APkt.DestIPVersion := LIPVersion;
  1053. {$ELSE}
  1054. LSF := SocketFlags.None;
  1055. {
  1056. The AddressFamily of the EndPoint used in ReceiveFrom needs to match the
  1057. AddressFamily of the EndPoint used in SendTo.
  1058. }
  1059. case ASocket.AddressFamily of
  1060. AddressFamily.InterNetwork: LIPAddr := IPAddress.Any;
  1061. AddressFamily.InterNetworkV6: LIPAddr := IPAddress.IPv6Any;
  1062. else
  1063. Result := 0; // keep the compiler happy
  1064. IPVersionUnsupported;
  1065. end;
  1066. LRemEP := IPEndPoint.Create(LIPAddr, 0);
  1067. Result := ASocket.ReceiveMessageFrom(VBuffer, 0, Length(VBUffer), LSF, LRemEP, lpki);
  1068. APkt.Reset;
  1069. APkt.SourceIP := IPEndPoint(LRemEP).Address.ToString;
  1070. APkt.SourcePort := IPEndPoint(LRemEP).Port;
  1071. case IPEndPoint(LRemEP).AddressFamily of
  1072. AddressFamily.InterNetwork: APkt.SourceIPVersion := Id_IPv4;
  1073. AddressFamily.InterNetworkV6: APkt.SourceIPVersion := Id_IPv6;
  1074. end;
  1075. APkt.DestIP := LPki.Address.ToString;
  1076. APkt.DestIF := LPki.&Interface;
  1077. APkt.DestIPVersion := APkt.SourceIPVersion;
  1078. {$ENDIF}
  1079. end;
  1080. {
  1081. This extracts an IP address as a series of bytes from a TIdBytes that contains
  1082. one SockAddress structure.
  1083. }
  1084. procedure SockAddrToIPBytes(const ASockAddr : TIdBytes; var VIPAddr : TIdBytes);
  1085. {$IFDEF USE_INLINE}inline;{$ENDIF}
  1086. begin
  1087. case BytesToUInt16(ASockAddr,0) of
  1088. 23 : //AddressFamily.InterNetworkV6 :
  1089. begin
  1090. //16 = size of SOCKADDR_IN6.sin6_addr
  1091. SetLength(VIPAddr,16);
  1092. // 8 = offset of sin6_addr in SOCKADDR_IN6
  1093. // sin6_family : Smallint; // AF_INET6
  1094. // sin6_port : u_short; // Transport level port number
  1095. // sin6_flowinfo : u_long; // IPv6 flow information
  1096. System.array.Copy(ASockAddr,8, VIPAddr, 0, 16);
  1097. end;
  1098. 2 : //AddressFamily.InterNetwork :
  1099. begin
  1100. //size of sockaddr_in.sin_addr
  1101. SetLength(VIPAddr,4);
  1102. // 4 = offset of sockaddr_in.sin_addr
  1103. // sin_family : u_short;
  1104. // sin_port : u_short;
  1105. System.array.Copy(ASockAddr,4, VIPAddr, 0, 4);
  1106. end;
  1107. end;
  1108. end;
  1109. procedure TIdStackDotNet.QueryRoute(s : TIdStackSocketHandle; const AIP: String;
  1110. const APort: TIdPort; var VSource, VDest : TIdBytes);
  1111. {$IFDEF DOTNET_2_OR_ABOVE}
  1112. const
  1113. SIO_ROUTING_INTERFACE_QUERY = 3355443220;
  1114. {$ENDIF}
  1115. var
  1116. LEP : IPEndPoint;
  1117. LDestIF : SocketAddress;
  1118. LIn, LOut : TBytes;
  1119. i : Integer;
  1120. begin
  1121. LEP := IPEndPoint.Create(IPAddress.Parse(AIP),APort);
  1122. LDestIf := LEP.Serialize;
  1123. {
  1124. The first 2 bytes of the underlying buffer are reserved for the AddressFamily
  1125. enumerated value. When the SocketAddress is used to store a serialized
  1126. IPEndPoint, the third and fourth bytes are used to store port number
  1127. information. The next bytes are used to store the IP address. You can access any
  1128. information within this underlying byte buffer by referring to its index
  1129. position; the byte buffer uses zero-based indexing. You can also use the Family
  1130. and Size properties to get the AddressFamily value and the buffer size,
  1131. respectively. To view any of this information as a string, use the ToString
  1132. method.
  1133. }
  1134. SetLength(LIn,LDestIf.Size);
  1135. for i := 0 to LDestIf.Size - 1 do
  1136. begin
  1137. LIn[i] := LDestIf[i];
  1138. end;
  1139. SetLength(LOut,LDestIf.Size);
  1140. {
  1141. IMPORTANT!!!!
  1142. We can not do something like:
  1143. s.IOControl( IOControlCode.RoutingInterfaceQuery, LIn, LOut);
  1144. because to IOControlCode.RoutingInterfaceQuery has a value of -539371432
  1145. and that is not correct. I found that out the hard way.
  1146. }
  1147. s.IOControl(LongInt(SIO_ROUTING_INTERFACE_QUERY),Lin,LOut);
  1148. SockAddrToIPBytes(LOut,VSource);
  1149. SockAddrToIPBytes(LIn,VDest);
  1150. end;
  1151. procedure TIdStackDotNet.WriteChecksumIPv6(s: TIdStackSocketHandle;
  1152. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1153. const APort: TIdPort);
  1154. var
  1155. LSource : TIdBytes;
  1156. LDest : TIdBytes;
  1157. LTmp : TIdBytes;
  1158. LIdx : Integer;
  1159. LC : UInt32;
  1160. {
  1161. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  1162. | |
  1163. + +
  1164. | |
  1165. + Source Address +
  1166. | |
  1167. + +
  1168. | |
  1169. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  1170. | |
  1171. + +
  1172. | |
  1173. + Destination Address +
  1174. | |
  1175. + +
  1176. | |
  1177. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  1178. | Upper-Layer Packet Length |
  1179. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  1180. | zero | Next Header |
  1181. +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  1182. }
  1183. begin
  1184. QueryRoute(s, AIP, APort, LSource, LDest);
  1185. SetLength(LTmp, 40+Length(VBuffer));
  1186. System.&Array.Clear(LTmp,0,Length(LTmp));
  1187. //16
  1188. CopyTIdBytes(LSource, 0, LTmp, 0, 16);
  1189. LIdx := 16;
  1190. //32
  1191. CopyTIdBytes(LDest, 0, LTmp,LIdx, 16);
  1192. Inc(LIdx, 16);
  1193. //use a word so you don't wind up using the wrong network byte order function
  1194. LC := Length(VBuffer);
  1195. CopyTIdUInt32(HostToNetwork(LC), LTmp, LIdx);
  1196. Inc(LIdx, 4);
  1197. //36
  1198. //zero the next three bytes
  1199. //done in the begging
  1200. Inc(LIdx, 3);
  1201. //next header (protocol type determines it
  1202. LTmp[LIdx] := Ord(Id_IPPROTO_ICMPv6);
  1203. Inc(LIdx);
  1204. //combine the two
  1205. CopyTIdBytes(VBuffer, 0, LTmp, LIdx, Length(VBuffer));
  1206. //zero out the checksum field
  1207. CopyTIdUInt16(0, LTmp, LIdx+AOffset);
  1208. CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(LTmp)), VBuffer, AOffset);
  1209. end;
  1210. {$ENDIF}
  1211. procedure TIdStackDotNet.WriteChecksum(s: TIdStackSocketHandle;
  1212. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1213. const APort: TIdPort; const AIPVersion: TIdIPVersion);
  1214. begin
  1215. if AIPVersion = Id_IPv4 then begin
  1216. CopyTIdUInt16(CalcCheckSum(VBuffer), VBuffer, AOffset);
  1217. end else
  1218. begin
  1219. {$IFDEF DOTNET_1_1}
  1220. {This is a todo because to do a checksum for ICMPv6, you need to obtain
  1221. the address for the IP the packet will come from (query the network interfaces).
  1222. You then have to make a IPv6 pseudo header. About the only other alternative is
  1223. to have the kernel (or DotNET Framework) generate the checksum but we don't have
  1224. an API for it.
  1225. I'm not sure if we have an API for it at all. Even if we did, would it be worth
  1226. doing when you consider that Microsoft's NET Framework 1.1 does not support ICMPv6
  1227. in its enumerations.}
  1228. raise EIdNotSupportedInMicrosoftNET11.Create(RSNotSupportedInMicrosoftNET11);
  1229. {$ELSE}
  1230. WriteChecksumIPv6(s,VBuffer,AOffset,AIP,APort);
  1231. {$ENDIF}
  1232. end;
  1233. end;
  1234. function TIdStackDotNet.IOControl(const s: TIdStackSocketHandle;
  1235. const cmd: UInt32; var arg: UInt32): Integer;
  1236. var
  1237. LTmp : TIdBytes;
  1238. begin
  1239. LTmp := ToBytes(arg);
  1240. s.IOControl(cmd, ToBytes(arg), LTmp);
  1241. arg := BytesToUInt32(LTmp);
  1242. Result := 0;
  1243. end;
  1244. {$IFDEF DOTNET_2_OR_ABOVE}
  1245. function ServeFile(ASocket: TIdStackSocketHandle; const AFileName: string): Int64;
  1246. var
  1247. LFile : FileInfo;
  1248. begin
  1249. ASocket.SendFile(AFileName);
  1250. LFile := System.IO.FileInfo.Create(AFileName);
  1251. Result := LFile.Length;
  1252. end;
  1253. {$ENDIF}
  1254. procedure TIdStackDotNet.SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  1255. const AEnabled: Boolean; const ATimeMS, AInterval: Integer);
  1256. {$IFNDEF DOTNET_2_OR_ABOVE}
  1257. const
  1258. SIO_KEEPALIVE_VALS = 2550136836;
  1259. {$ENDIF}
  1260. var
  1261. LBuf: TIdBytes;
  1262. begin
  1263. // SIO_KEEPALIVE_VALS is supported on Win2K+ only
  1264. if AEnabled and (System.OperatingSystem.Version.Major >= 5) then
  1265. begin
  1266. SetLength(LBuf, 12);
  1267. CopyTIdUInt32(1, LBuf, 0);
  1268. CopyTIdUInt32(ATimeMS, LBuf, 4);
  1269. CopyTIdUInt32(AInterval, LBuf, 8);
  1270. ASocket.IOControl(
  1271. {$IFDEF DOTNET_2_OR_ABOVE}IOControlCode.KeepAliveValues{$ELSE}SIO_KEEPALIVE_VALS{$ENDIF},
  1272. LBuf, nil);
  1273. end else begin
  1274. LBuf := nil;
  1275. ASocket.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.KeepAlive, iif(AEnabled, 1, 0));
  1276. end;
  1277. end;
  1278. initialization
  1279. GSocketListClass := TIdSocketListDotNet;
  1280. {$IFDEF DOTNET_2_OR_ABOVE}
  1281. GServeFileProc := ServeFile;
  1282. {$ENDIF}
  1283. end.