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. // TODO: move this class into the implementation section! It is not used outside of this unit
  119. TIdSocketListDotNet = class(TIdSocketList)
  120. protected
  121. FSockets: ArrayList;
  122. function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  123. public
  124. constructor Create; override;
  125. destructor Destroy; override;
  126. procedure Add(AHandle: TIdStackSocketHandle); override;
  127. procedure Remove(AHandle: TIdStackSocketHandle); override;
  128. function Count: Integer; override;
  129. procedure Clear; override;
  130. function Clone: TIdSocketList; override;
  131. function ContainsSocket(AHandle: TIdStackSocketHandle): boolean; override;
  132. class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
  133. AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  134. function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  135. function SelectReadList(var VSocketList: TIdSocketList;
  136. const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  137. end;
  138. TIdStackDotNet = class(TIdStack)
  139. protected
  140. //Stuff for ICMPv6
  141. {$IFDEF DOTNET_2_OR_ABOVE}
  142. procedure QueryRoute(s : TIdStackSocketHandle; const AIP: String;
  143. const APort: TIdPort; var VSource, VDest : TIdBytes);
  144. procedure WriteChecksumIPv6(s: TIdStackSocketHandle;
  145. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  146. const APort: TIdPort);
  147. {$ENDIF}
  148. function ReadHostName: string; override;
  149. function HostByName(const AHostName: string;
  150. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  151. //internal IP Mutlicasting membership stuff
  152. procedure MembershipSockOpt(AHandle: TIdStackSocketHandle;
  153. const AGroupIP, ALocalIP : String; const ASockOpt : TIdSocketOption;
  154. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  155. public
  156. [ThreadStatic]
  157. LastSocketError: Integer; //static;
  158. constructor Create; override;
  159. destructor Destroy; override;
  160. procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string; const APort: TIdPort;
  161. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION ); override;
  162. procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  163. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  164. procedure Disconnect(ASocket: TIdStackSocketHandle); override;
  165. procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  166. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  167. procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  168. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  169. function WSGetLastError: Integer; override;
  170. procedure WSSetLastError(const AErr : Integer); override;
  171. function NewSocketHandle(const ASocketType: TIdSocketType;
  172. const AProtocol: TIdSocketProtocol;
  173. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION;
  174. const ANonBlocking: Boolean = False) : TIdStackSocketHandle; override;
  175. // Result:
  176. // > 0: Number of bytes received
  177. // 0: Connection closed gracefully
  178. // Will raise exceptions in other cases
  179. function Receive(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes) : Integer; override;
  180. function Send(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  181. const AOffset: Integer = 0; const ASize: Integer = -1): Integer; override;
  182. function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32;
  183. var arg: UInt32): Integer; override;
  184. function ReceiveFrom(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  185. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer; override;
  186. function ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  187. APkt: TIdPacketInfo): UInt32; override;
  188. function SendTo(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  189. const AOffset: Integer; const ASize: Integer; const AIP: string; const APort: TIdPort;
  190. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer; override;
  191. function HostToNetwork(AValue: UInt16): UInt16; override;
  192. function NetworkToHost(AValue: UInt16): UInt16; override;
  193. function HostToNetwork(AValue: UInt32): UInt32; override;
  194. function NetworkToHost(AValue: UInt32): UInt32; override;
  195. function HostToNetwork(AValue: TIdUInt64): TIdUInt64; override;
  196. function NetworkToHost(AValue: TIdUInt64): TIdUInt64; override;
  197. function HostByAddress(const AAddress: string;
  198. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  199. procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);override;
  200. function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort;
  201. var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
  202. procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  203. AOptName: TIdSocketOption; out AOptVal: Integer); override;
  204. procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel:TIdSocketOptionLevel;
  205. AOptName: TIdSocketOption; AOptVal: Integer); overload; override;
  206. function SupportsIPv4: Boolean; override;
  207. function SupportsIPv6: Boolean; override;
  208. //multicast stuff Kudzu permitted me to add here.
  209. procedure SetMulticastTTL(AHandle: TIdStackSocketHandle; const AValue : Byte;
  210. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  211. procedure SetLoopBack(AHandle: TIdStackSocketHandle; const AValue: Boolean;
  212. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  213. procedure DropMulticastMembership(AHandle: TIdStackSocketHandle;
  214. const AGroupIP, ALocalIP : String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  215. procedure AddMulticastMembership(AHandle: TIdStackSocketHandle;
  216. const AGroupIP, ALocalIP : String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  217. procedure WriteChecksum(s : TIdStackSocketHandle; var VBuffer : TIdBytes;
  218. const AOffset : Integer; const AIP : String; const APort : TIdPort;
  219. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  220. procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override;
  221. procedure SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  222. const AEnabled: Boolean; const ATimeMS, AInterval: Integer); override;
  223. end;
  224. {$IFDEF DOTNET_1_1}
  225. EIdNotSupportedInMicrosoftNET11 = class(EIdStackError);
  226. {$ENDIF}
  227. var
  228. GDotNETStack : TIdStackDotNet = nil;
  229. implementation
  230. uses
  231. IdException, IdResourceStrings;
  232. const
  233. IdIPFamily : array[TIdIPVersion] of AddressFamily = (AddressFamily.InterNetwork, AddressFamily.InterNetworkV6);
  234. { TIdStackDotNet }
  235. procedure DoRaiseException(AStack: TIdStackDotNet; AException: System.Exception);
  236. var
  237. LSocketError : System.Net.Sockets.SocketException;
  238. E: EIdException;
  239. begin
  240. if AException is System.Net.Sockets.SocketException then
  241. begin
  242. LSocketError := AException as System.Net.Sockets.SocketException;
  243. AStack.LastSocketError := LSocketError.ErrorCode;
  244. E := EIdSocketError.CreateError(LSocketError.ErrorCode, LSocketError.Message)
  245. end else begin
  246. E := EIdWrapperException.Create(AException.Message, AException);
  247. end;
  248. IndyRaiseOuterException(E);
  249. end;
  250. { TIdStackDotNet }
  251. constructor TIdStackDotNet.Create;
  252. begin
  253. inherited Create;
  254. GDotNETStack := Self;
  255. end;
  256. destructor TIdStackDotNet.Destroy;
  257. begin
  258. GDotNETStack := nil;
  259. inherited Destroy;
  260. end;
  261. procedure TIdStackDotNet.Bind(ASocket: TIdStackSocketHandle; const AIP: string;
  262. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  263. var
  264. LIPAddr : IPAddress;
  265. LEndPoint : IPEndPoint;
  266. LIP: String;
  267. begin
  268. try
  269. if not (AIPVersion in [Id_IPv4, Id_IPv6]) then
  270. begin
  271. IPVersionUnsupported;
  272. end;
  273. LIP := AIP;
  274. if LIP = '' then begin
  275. if AIPVersion = Id_IPv4 then begin
  276. LIPAddr := IPAddress.Any;
  277. end else begin
  278. LIPAddr := IPAddress.IPv6Any;
  279. end;
  280. end else begin
  281. LIPAddr := IPAddress.Parse(LIP);
  282. end;
  283. LEndPoint := IPEndPoint.Create(LIPAddr, APort);
  284. ASocket.Bind(LEndPoint);
  285. except
  286. on e: Exception do begin
  287. DoRaiseException(Self, e);
  288. end;
  289. end;
  290. end;
  291. procedure TIdStackDotNet.Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  292. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  293. var
  294. LEndPoint : IPEndPoint;
  295. begin
  296. try
  297. LEndPoint := IPEndPoint.Create(IPAddress.Parse(AIP), APort);
  298. ASocket.Connect(LEndPoint);
  299. except
  300. on e: Exception do begin
  301. DoRaiseException(Self, e);
  302. end;
  303. end;
  304. end;
  305. procedure TIdStackDotNet.Disconnect(ASocket: TIdStackSocketHandle);
  306. begin
  307. try
  308. ASocket.Close;
  309. except
  310. on e: Exception do begin
  311. DoRaiseException(Self, e);
  312. end;
  313. end;
  314. end;
  315. procedure TIdStackDotNet.Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);
  316. begin
  317. try
  318. ASocket.Listen(ABackLog);
  319. except
  320. on e: Exception do begin
  321. DoRaiseException(Self, e);
  322. end;
  323. end;
  324. end;
  325. function TIdStackDotNet.Accept(ASocket: TIdStackSocketHandle;
  326. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
  327. var
  328. LEndPoint: IPEndPoint;
  329. begin
  330. try
  331. Result := ASocket.Accept();
  332. LEndPoint := Result.RemoteEndPoint as IPEndPoint;
  333. if (Result.AddressFamily = AddressFamily.InterNetwork) or
  334. (Result.AddressFamily = AddressFamily.InterNetworkV6) then
  335. begin
  336. VIP := LEndPoint.Address.ToString();
  337. VPort := LEndPoint.Port;
  338. if Result.AddressFamily = AddressFamily.InterNetworkV6 then begin
  339. VIPVersion := Id_IPv6;
  340. end else begin
  341. VIPVersion := Id_IPv4;
  342. end;
  343. end else
  344. begin
  345. Result := Id_INVALID_SOCKET;
  346. IPVersionUnsupported;
  347. end;
  348. except
  349. on e: Exception do begin
  350. DoRaiseException(Self, e);
  351. end;
  352. end;
  353. end;
  354. procedure TIdStackDotNet.GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  355. var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  356. var
  357. LEndPoint : IPEndPoint;
  358. begin
  359. try
  360. if (ASocket.AddressFamily = AddressFamily.InterNetwork) or
  361. (ASocket.AddressFamily = AddressFamily.InterNetworkV6) then
  362. begin
  363. LEndPoint := ASocket.RemoteEndPoint as IPEndPoint;
  364. VIP := LEndPoint.Address.ToString;
  365. VPort := LEndPoint.Port;
  366. if ASocket.AddressFamily = AddressFamily.InterNetworkV6 then begin
  367. VIPVersion := Id_IPv6;
  368. end else begin
  369. VIPVersion := Id_IPv4;
  370. end;
  371. end else begin
  372. IPVersionUnsupported;
  373. end;
  374. except
  375. on e: Exception do begin
  376. DoRaiseException(Self, e);
  377. end;
  378. end;
  379. end;
  380. procedure TIdStackDotNet.GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  381. var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  382. var
  383. LEndPoint : IPEndPoint;
  384. begin
  385. try
  386. if (ASocket.AddressFamily = AddressFamily.InterNetwork) or
  387. (ASocket.AddressFamily = AddressFamily.InterNetworkV6) then
  388. begin
  389. LEndPoint := ASocket.LocalEndPoint as IPEndPoint;
  390. VIP := LEndPoint.Address.ToString;
  391. VPort := LEndPoint.Port;
  392. if ASocket.AddressFamily = AddressFamily.InterNetworkV6 then begin
  393. VIPVersion := Id_IPv6;
  394. end else begin
  395. VIPVersion := Id_IPv4;
  396. end;
  397. end else begin
  398. IPVersionUnsupported;
  399. end;
  400. except
  401. on e: Exception do begin
  402. DoRaiseException(Self, e);
  403. end;
  404. end;
  405. end;
  406. function TIdStackDotNet.HostByName(const AHostName: string;
  407. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  408. var
  409. LIP: array of IPAddress;
  410. a: Integer;
  411. begin
  412. try
  413. {
  414. [Warning] IdStackDotNet.pas(417): W1000 Symbol 'Resolve' is deprecated:
  415. 'Resolve is obsoleted for this type, please use GetHostEntry instead.
  416. http://go.microsoft.com/fwlink/?linkid=14202'
  417. }
  418. {$IFDEF DOTNET_2_OR_ABOVE}
  419. LIP := Dns.GetHostEntry(AHostName).AddressList;
  420. {$ENDIF}
  421. {$IFDEF DOTNET_1_1}
  422. LIP := Dns.Resolve(AHostName).AddressList;
  423. {$ENDIF}
  424. for a := Low(LIP) to High(LIP) do begin
  425. if LIP[a].AddressFamily = IdIPFamily[AIPVersion] then begin
  426. Result := LIP[a].ToString;
  427. Exit;
  428. end;
  429. end;
  430. raise System.Net.Sockets.SocketException.Create(11001);
  431. except
  432. on e: Exception do begin
  433. DoRaiseException(Self, e);
  434. end;
  435. end;
  436. end;
  437. function TIdStackDotNet.HostByAddress(const AAddress: string;
  438. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  439. begin
  440. try
  441. {$IFDEF DOTNET_2_OR_ABOVE}
  442. Result := Dns.GetHostEntry(AAddress).HostName;
  443. {$ENDIF}
  444. {$IFDEF DOTNET_1_1}
  445. Result := Dns.GetHostByAddress(AAddress).HostName;
  446. {$ENDIF}
  447. except
  448. on e: Exception do begin
  449. DoRaiseException(Self, e);
  450. end;
  451. end;
  452. end;
  453. function TIdStackDotNet.WSGetLastError: Integer;
  454. begin
  455. Result := LastSocketError;
  456. end;
  457. procedure TIdStackDotNet.WSSetLastError(const AErr : Integer);
  458. begin
  459. LastSocketError := AErr;
  460. end;
  461. function TIdStackDotNet.NewSocketHandle(const ASocketType: TIdSocketType;
  462. const AProtocol: TIdSocketProtocol; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION;
  463. const ANonBlocking: Boolean = False): TIdStackSocketHandle;
  464. begin
  465. try
  466. Result := Socket.Create(IdIPFamily[AIPVersion], ASocketType, AProtocol);
  467. Result.Blocking := not ANonBlocking;
  468. except
  469. on E: Exception do begin
  470. DoRaiseException(Self, E);
  471. end;
  472. end;
  473. end;
  474. function TIdStackDotNet.ReadHostName: string;
  475. begin
  476. try
  477. Result := System.Net.DNS.GetHostName;
  478. except
  479. on E: Exception do begin
  480. DoRaiseException(Self, e);
  481. end;
  482. end;
  483. end;
  484. function TIdStackDotNet.Receive(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes): Integer;
  485. begin
  486. try
  487. Result := ASocket.Receive(VBuffer, Length(VBuffer), SocketFlags.None);
  488. except
  489. on e: Exception do begin
  490. DoRaiseException(Self, e);
  491. end;
  492. end;
  493. end;
  494. function TIdStackDotNet.Send(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  495. const AOffset: Integer = 0; const ASize: Integer = -1): Integer;
  496. var
  497. Tmp: TIdBytes;
  498. begin
  499. Result := IndyLength(ABuffer, ASize, AOffset);
  500. try
  501. if Result > 0 then begin
  502. Result := ASocket.Send(ABuffer, AOffset, Result, SocketFlags.None);
  503. end else
  504. begin
  505. // RLebeau: this is to allow UDP sockets to send 0-length packets. Send()
  506. // raises an exception if its buffer parameter is nil, and a 0-length byte
  507. // array is nil...
  508. //
  509. // TODO: check the socket type and only allow this for UDP sockets...
  510. //
  511. SetLength(Tmp, 1);
  512. Tmp[0] := $00;
  513. Result := ASocket.Send(Tmp, 0, 0, SocketFlags.None);
  514. end;
  515. except
  516. on E: Exception do begin
  517. DoRaiseException(Self, E);
  518. end;
  519. end;
  520. end;
  521. function TIdStackDotNet.ReceiveFrom(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  522. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer;
  523. var
  524. LIPAddr : IPAddress;
  525. LEndPoint : EndPoint;
  526. begin
  527. Result := 0; // to make the compiler happy
  528. case ASocket.AddressFamily of
  529. AddressFamily.InterNetwork: LIPAddr := IPAddress.Any;
  530. AddressFamily.InterNetworkV6: LIPAddr := IPAddress.IPv6Any;
  531. else
  532. IPVersionUnsupported;
  533. end;
  534. LEndPoint := IPEndPoint.Create(LIPAddr, 0);
  535. try
  536. try
  537. Result := ASocket.ReceiveFrom(VBuffer, SocketFlags.None, LEndPoint);
  538. except
  539. on e: Exception do begin
  540. DoRaiseException(Self, e);
  541. end;
  542. end;
  543. VIP := IPEndPoint(LEndPoint).Address.ToString;
  544. VPort := IPEndPoint(LEndPoint).Port;
  545. case IPEndPoint(LEndPoint).AddressFamily of
  546. AddressFamily.InterNetwork: VIPVersion := Id_IPv4;
  547. AddressFamily.InterNetworkV6: VIPVersion := Id_IPv6;
  548. end;
  549. finally
  550. LEndPoint.Free;
  551. end;
  552. end;
  553. function TIdStackDotNet.SendTo(ASocket: TIdStackSocketHandle; const ABuffer: TIdBytes;
  554. const AOffset: Integer; const ASize: Integer; const AIP: string; const APort: TIdPort;
  555. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer;
  556. var
  557. LEndPoint : EndPoint;
  558. Tmp: TIdBytes;
  559. begin
  560. Result := IndyLength(ABuffer, ASize, AOffset);
  561. try
  562. LEndPoint := IPEndPoint.Create(IPAddress.Parse(AIP), APort);
  563. try
  564. if Result > 0 then begin
  565. Result := ASocket.SendTo(ABuffer, AOffset, Result, SocketFlags.None, LEndPoint);
  566. end else
  567. begin
  568. // RLebeau: this is to allow UDP sockets to send 0-length packets. SendTo()
  569. // raises an exception if its buffer parameter is nil, and a 0-length byte
  570. // array is nil...
  571. //
  572. // TODO: check the socket type and only allow this for UDP sockets...
  573. //
  574. SetLength(Tmp, 1);
  575. Tmp[0] := $00;
  576. Result := ASocket.SendTo(Tmp, 0, 0, SocketFlags.None, LEndPoint);
  577. end;
  578. finally
  579. LEndPoint.Free;
  580. end;
  581. except
  582. on e: Exception do begin
  583. DoRaiseException(Self, e);
  584. end;
  585. end;
  586. end;
  587. //////////////////////////////////////////////////////////////
  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.