IdStackDotNet.pas 45 KB

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