IdTCPClient.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546
  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.38 1/15/05 2:14:58 PM RLebeau
  18. Removed virtual specifier from SetConnectTimeout() and SetReadTimeout(), not
  19. being used by any descendants.
  20. Rev 1.37 11/29/2004 11:49:24 PM JPMugaas
  21. Fixes for compiler errors.
  22. Rev 1.36 11/29/04 10:38:58 AM RLebeau
  23. Updated Connect() to release the IOHandler on error if implicitally created.
  24. Rev 1.35 11/28/04 2:28:22 PM RLebeau
  25. Added 'const' to various property setter parameters.
  26. Removed redundant getter methods.
  27. Rev 1.34 11/27/2004 8:27:44 PM JPMugaas
  28. Fix for compiler errors.
  29. Rev 1.33 11/26/04 3:46:10 PM RLebeau
  30. Added support for BoundIP and BoundPort properties
  31. Rev 1.32 2004.11.05 10:58:34 PM czhower
  32. Changed connect overloads for C#.
  33. Rev 1.31 8/8/04 12:32:08 AM RLebeau
  34. Redeclared ReadTimeout and ConnectTimeout properties as public instead of
  35. protected in TIdTCPClientCustom
  36. Rev 1.30 8/4/2004 5:37:34 AM DSiders
  37. Changed camel-casing on ReadTimeout to be consistent with ConnectTimeout.
  38. Rev 1.29 8/3/04 11:17:30 AM RLebeau
  39. Added support for ReadTimeout property
  40. Rev 1.28 8/2/04 5:50:58 PM RLebeau
  41. Added support for ConnectTimeout property
  42. Rev 1.27 2004.03.06 10:40:28 PM czhower
  43. Changed IOHandler management to fix bug in server shutdowns.
  44. Rev 1.26 2004.02.03 4:16:54 PM czhower
  45. For unit name changes.
  46. Rev 1.25 1/8/2004 8:22:54 PM JPMugaas
  47. SetIPVersion now virtual so I can override in TIdFTP. Other stuff may need
  48. the override as well.
  49. Rev 1.24 1/2/2004 12:02:18 AM BGooijen
  50. added OnBeforeBind/OnAfterBind
  51. Rev 1.23 12/31/2003 9:52:04 PM BGooijen
  52. Added IPv6 support
  53. Rev 1.20 2003.10.14 1:27:00 PM czhower
  54. Uupdates + Intercept support
  55. Rev 1.19 2003.10.01 9:11:26 PM czhower
  56. .Net
  57. Rev 1.18 2003.10.01 2:30:42 PM czhower
  58. .Net
  59. Rev 1.17 2003.10.01 11:16:36 AM czhower
  60. .Net
  61. Rev 1.16 2003.09.30 1:23:06 PM czhower
  62. Stack split for DotNet
  63. Rev 1.15 2003.09.18 2:59:46 PM czhower
  64. Modified port and host overrides to only override if values exist.
  65. Rev 1.14 6/3/2003 11:48:32 PM BGooijen
  66. Undid change from version 1.12, is now fixed in iohandlersocket
  67. Rev 1.13 2003.06.03 7:27:56 PM czhower
  68. Added overloaded Connect method
  69. Rev 1.12 5/23/2003 6:45:32 PM BGooijen
  70. ClosedGracefully is now set if Connect failes.
  71. Rev 1.11 2003.04.10 8:05:34 PM czhower
  72. removed unneeded self. reference
  73. Rev 1.10 4/7/2003 06:58:32 AM JPMugaas
  74. Implicit IOHandler now created in virtual method
  75. function TIdTCPClientCustom.MakeImplicitClientHandler: TIdIOHandler;
  76. Rev 1.9 3/17/2003 9:40:16 PM BGooijen
  77. Host and Port were not properly synchronised with the IOHandler, fixed that
  78. Rev 1.8 3/5/2003 11:05:24 PM BGooijen
  79. Intercept
  80. Rev 1.7 2003.02.25 1:36:16 AM czhower
  81. Rev 1.6 12-14-2002 22:52:34 BGooijen
  82. now also saves host and port settings when an explicit iohandler is used. the
  83. host and port settings are copied to the iohandler if the iohandler doesn't
  84. have them specified.
  85. Rev 1.5 12-14-2002 22:38:26 BGooijen
  86. The host and port settings were lost when the implicit iohandler was created
  87. in .Connect, fixed that.
  88. Rev 1.4 2002.12.07 12:26:12 AM czhower
  89. Rev 1.2 12/6/2002 02:11:42 PM JPMugaas
  90. Protected Port and Host properties added to TCPClient because those are
  91. needed by protocol implementations. Socket property added to TCPConnection.
  92. Rev 1.1 6/12/2002 4:08:34 PM SGrobety
  93. Rev 1.0 11/13/2002 09:00:26 AM JPMugaas
  94. }
  95. unit IdTCPClient;
  96. {$i IdCompilerDefines.inc}
  97. interface
  98. uses
  99. Classes,
  100. IdGlobal, IdExceptionCore, IdIOHandler, IdTCPConnection;
  101. (*$HPPEMIT '#if defined(_VCL_ALIAS_RECORDS)' *)
  102. (*$HPPEMIT '#if !defined(UNICODE)' *)
  103. (*$HPPEMIT '#pragma alias "@Idtcpclient@TIdTCPClientCustom@SetPortA$qqrxus"="@Idtcpclient@TIdTCPClientCustom@SetPort$qqrxus"' *)
  104. (*$HPPEMIT '#else' *)
  105. (*$HPPEMIT '#pragma alias "@Idtcpclient@TIdTCPClientCustom@SetPortW$qqrxus"="@Idtcpclient@TIdTCPClientCustom@SetPort$qqrxus"' *)
  106. (*$HPPEMIT '#endif' *)
  107. (*$HPPEMIT '#endif' *)
  108. // TODO: when compiling with bcc64x, use this pragma instead:
  109. // #pragma comment(linker, "/alternatename:<name1>=<name2>")
  110. type
  111. TIdTCPClientCustom = class(TIdTCPConnection)
  112. protected
  113. FBoundIP: String;
  114. FBoundPort: TIdPort;
  115. FBoundPortMax: TIdPort;
  116. FBoundPortMin: TIdPort;
  117. FConnectTimeout: Integer;
  118. FDestination: string;
  119. FHost: string;
  120. FIPVersion: TIdIPVersion;
  121. FOnConnected: TNotifyEvent;
  122. FPassword: string;
  123. FPort: TIdPort;
  124. FReadTimeout: Integer;
  125. FUsername: string;
  126. FReuseSocket: TIdReuseSocket;
  127. FUseNagle: Boolean;
  128. //
  129. FOnBeforeBind: TNotifyEvent;
  130. FOnAfterBind: TNotifyEvent;
  131. FOnSocketAllocated: TNotifyEvent;
  132. //
  133. procedure DoOnConnected; virtual;
  134. function MakeImplicitClientHandler: TIdIOHandler; virtual;
  135. //
  136. procedure SetConnectTimeout(const AValue: Integer);
  137. procedure SetReadTimeout(const AValue: Integer);
  138. procedure SetReuseSocket(const AValue: TIdReuseSocket);
  139. procedure SetUseNagle(const AValue: Boolean);
  140. procedure SetBoundIP(const AValue: String);
  141. procedure SetBoundPort(const AValue: TIdPort);
  142. procedure SetBoundPortMax(const AValue: TIdPort);
  143. procedure SetBoundPortMin(const AValue: TIdPort);
  144. procedure SetHost(const AValue: string); virtual;
  145. procedure SetPort(const AValue: TIdPort); virtual;
  146. procedure SetIPVersion(const AValue: TIdIPVersion); virtual;
  147. //
  148. procedure SetOnBeforeBind(const AValue: TNotifyEvent);
  149. procedure SetOnAfterBind(const AValue: TNotifyEvent);
  150. procedure SetOnSocketAllocated(const AValue: TNotifyEvent);
  151. //
  152. procedure SetIOHandler(AValue: TIdIOHandler); override;
  153. procedure InitComponent; override;
  154. //
  155. function GetReadTimeout: Integer;
  156. function GetReuseSocket: TIdReuseSocket;
  157. function GetUseNagle: Boolean;
  158. //
  159. property Host: string read FHost write SetHost;
  160. property IPVersion: TIdIPVersion read FIPVersion write SetIPVersion;
  161. property Password: string read FPassword write FPassword;
  162. property Port: TIdPort read FPort write SetPort;
  163. property Username: string read FUsername write FUsername;
  164. public
  165. procedure Connect; overload; virtual;
  166. // This is overridden and not as default params so that descendants
  167. // do not have to worry about the arguments.
  168. // Also has been split further to allow usage from C# as it does not have optional
  169. // params
  170. procedure Connect(const AHost: string); overload;
  171. procedure Connect(const AHost: string; const APort: TIdPort); overload;
  172. function ConnectAndGetAll: string; virtual;
  173. //
  174. property BoundIP: string read FBoundIP write SetBoundIP;
  175. property BoundPort: TIdPort read FBoundPort write SetBoundPort default DEF_PORT_ANY;
  176. property BoundPortMax: TIdPort read FBoundPortMax write SetBoundPortMax default DEF_PORT_ANY;
  177. property BoundPortMin: TIdPort read FBoundPortMin write SetBoundPortMin default DEF_PORT_ANY;
  178. //
  179. property ConnectTimeout: Integer read FConnectTimeout write SetConnectTimeout;
  180. property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
  181. property ReuseSocket: TIdReuseSocket read GetReuseSocket write SetReuseSocket default rsOSDependent;
  182. property UseNagle: Boolean read GetUseNagle write SetUseNagle default True;
  183. //
  184. property OnBeforeBind: TNotifyEvent read FOnBeforeBind write SetOnBeforeBind;
  185. property OnAfterBind: TNotifyEvent read FOnAfterBind write SetOnAfterBind;
  186. property OnSocketAllocated: TNotifyEvent read FOnSocketAllocated write SetOnSocketAllocated;
  187. //
  188. published
  189. property OnConnected: TNotifyEvent read FOnConnected write FOnConnected;
  190. end;
  191. TIdTCPClient = class(TIdTCPClientCustom)
  192. published
  193. property BoundIP;
  194. property BoundPort;
  195. property ConnectTimeout;
  196. property Host;
  197. property IPVersion default ID_DEFAULT_IP_VERSION;
  198. property Port;
  199. property ReadTimeout;
  200. property ReuseSocket;
  201. property UseNagle;
  202. property OnBeforeBind;
  203. property OnAfterBind;
  204. property OnSocketAllocated;
  205. end;
  206. //Temp IFDEF till we change aliaser
  207. // Temp - reversed it for code freeze - will rereverse later.
  208. implementation
  209. uses
  210. IdComponent, IdResourceStringsCore, IdIOHandlerSocket;
  211. { TIdTCPClientCustom }
  212. procedure TIdTCPClientCustom.InitComponent;
  213. begin
  214. inherited InitComponent;
  215. FIPVersion := ID_DEFAULT_IP_VERSION;
  216. FReadTimeOut := IdTimeoutDefault;
  217. FBoundPort := DEF_PORT_ANY;
  218. FBoundPortMin := DEF_PORT_ANY;
  219. FBoundPortMax := DEF_PORT_ANY;
  220. FUseNagle := True;
  221. end;
  222. procedure TIdTCPClientCustom.Connect;
  223. begin
  224. if Connected then begin
  225. raise EIdAlreadyConnected.Create(RSAlreadyConnected);
  226. end;
  227. if Host = '' then begin
  228. raise EIdHostRequired.Create('A Host is required'); {do not localize}
  229. end;
  230. if Port = 0 then begin
  231. raise EIdPortRequired.Create('A Port is required'); {do not localize}
  232. end;
  233. if IOHandler = nil then begin
  234. IOHandler := MakeImplicitClientHandler;
  235. ManagedIOHandler := True;
  236. // TODO: always assign the OnStatus event even if the IOHandler is not implicit?
  237. IOHandler.OnStatus := OnStatus; // TODO: assign DoStatus() instead of the handler directly...
  238. end;
  239. try
  240. // Bypass GetDestination
  241. if FDestination <> '' then begin
  242. IOHandler.Destination := FDestination;
  243. end;
  244. {BGO: not any more, TIdTCPClientCustom has precedence now (for port protocols, and things like that)
  245. // We retain the settings that are in here (filled in by the user)
  246. // we only do this when the iohandler has no settings,
  247. // because the iohandler has precedence
  248. if (IOHandler.Port = 0) and (IOHandler.Host = '') then begin
  249. IOHandler.Port := FPort;
  250. IOHandler.Host := FHost;
  251. end;
  252. }
  253. IOHandler.Port := FPort; //BGO: just to make sure
  254. IOHandler.Host := FHost;
  255. IOHandler.ConnectTimeout := FConnectTimeout;
  256. IOHandler.ReadTimeout := FReadTimeout;
  257. if Socket <> nil then begin
  258. Socket.BoundIP := FBoundIP;
  259. Socket.BoundPort := FBoundPort;
  260. Socket.BoundPortMin := FBoundPortMin;
  261. Socket.BoundPortMax := FBoundPortMax;
  262. Socket.IPVersion := FIPVersion;
  263. Socket.ReuseSocket := FReuseSocket;
  264. Socket.UseNagle := FUseNagle;
  265. Socket.OnBeforeBind := FOnBeforeBind;
  266. Socket.OnAfterBind := FOnAfterBind;
  267. Socket.OnSocketAllocated := FOnSocketAllocated;
  268. end;
  269. IOHandler.Open;
  270. if IOHandler.Intercept <> nil then begin
  271. IOHandler.Intercept.Connect(Self);
  272. end;
  273. DoStatus(hsConnected, [Host]);
  274. DoOnConnected;
  275. except
  276. if IOHandler <> nil then begin
  277. IOHandler.Close;
  278. if ManagedIOHandler then begin
  279. IOHandler := nil; // RLebeau - SetIOHandler() will free the IOHandler
  280. end;
  281. end;
  282. raise;
  283. end;
  284. end;
  285. function TIdTCPClientCustom.ConnectAndGetAll: string;
  286. begin
  287. Connect; try
  288. Result := IOHandler.AllData;
  289. finally Disconnect; end;
  290. end;
  291. procedure TIdTCPClientCustom.DoOnConnected;
  292. begin
  293. if Assigned(OnConnected) then begin
  294. OnConnected(Self);
  295. end;
  296. end;
  297. procedure TIdTCPClientCustom.SetConnectTimeout(const AValue: Integer);
  298. begin
  299. FConnectTimeout := AValue;
  300. if IOHandler <> nil then begin
  301. IOHandler.ConnectTimeout := AValue;
  302. end;
  303. end;
  304. procedure TIdTCPClientCustom.SetReadTimeout(const AValue: Integer);
  305. begin
  306. FReadTimeout := AValue;
  307. if IOHandler <> nil then begin
  308. IOHandler.ReadTimeout := AValue;
  309. end;
  310. end;
  311. procedure TIdTCPClientCustom.SetReuseSocket(const AValue: TIdReuseSocket);
  312. begin
  313. FReuseSocket := AValue;
  314. if Socket <> nil then begin
  315. Socket.ReuseSocket := AValue;
  316. end;
  317. end;
  318. procedure TIdTCPClientCustom.SetUseNagle(const AValue: Boolean);
  319. begin
  320. FUseNagle := AValue;
  321. if Socket <> nil then begin
  322. Socket.UseNagle := AValue;
  323. end;
  324. end;
  325. procedure TIdTCPClientCustom.SetBoundIP(const AValue: String);
  326. begin
  327. FBoundIP := AValue;
  328. if Socket <> nil then begin
  329. Socket.BoundIP := AValue;
  330. end;
  331. end;
  332. procedure TIdTCPClientCustom.SetBoundPort(const AValue: TIdPort);
  333. begin
  334. FBoundPort := AValue;
  335. if Socket <> nil then begin
  336. Socket.BoundPort := AValue;
  337. end;
  338. end;
  339. procedure TIdTCPClientCustom.SetBoundPortMax(const AValue: TIdPort);
  340. begin
  341. FBoundPortMax := AValue;
  342. if Socket <> nil then begin
  343. Socket.BoundPortMax := AValue;
  344. end;
  345. end;
  346. procedure TIdTCPClientCustom.SetBoundPortMin(const AValue: TIdPort);
  347. begin
  348. FBoundPortMin := AValue;
  349. if Socket <> nil then begin
  350. Socket.BoundPortMin := AValue;
  351. end;
  352. end;
  353. procedure TIdTCPClientCustom.SetHost(const AValue: string);
  354. begin
  355. FHost := AValue;
  356. if IOHandler <> nil then begin
  357. IOHandler.Host := AValue;
  358. end;
  359. end;
  360. procedure TIdTCPClientCustom.SetPort(const AValue: TIdPort);
  361. begin
  362. FPort := AValue;
  363. if IOHandler <> nil then begin
  364. IOHandler.Port := AValue;
  365. end;
  366. end;
  367. procedure TIdTCPClientCustom.SetIPVersion(const AValue: TIdIPVersion);
  368. begin
  369. FIPVersion := AValue;
  370. if Socket <> nil then begin
  371. Socket.IPVersion := AValue;
  372. end;
  373. end;
  374. procedure TIdTCPClientCustom.SetOnBeforeBind(const AValue: TNotifyEvent);
  375. begin
  376. FOnBeforeBind := AValue;
  377. if Socket <> nil then begin
  378. Socket.OnBeforeBind := AValue;
  379. end;
  380. end;
  381. procedure TIdTCPClientCustom.SetOnAfterBind(const AValue: TNotifyEvent);
  382. begin
  383. FOnAfterBind := AValue;
  384. if Socket <> nil then begin
  385. Socket.OnAfterBind := AValue;
  386. end;
  387. end;
  388. procedure TIdTCPClientCustom.SetOnSocketAllocated(const AValue: TNotifyEvent);
  389. begin
  390. FOnSocketAllocated := AValue;
  391. if Socket <> nil then begin
  392. Socket.OnSocketAllocated := AValue;
  393. end;
  394. end;
  395. procedure TIdTCPClientCustom.SetIOHandler(AValue: TIdIOHandler);
  396. begin
  397. inherited SetIOHandler(AValue);
  398. // TIdTCPClientCustom overrides settings in iohandler to initialize
  399. // protocol defaults.
  400. if IOHandler <> nil then begin
  401. IOHandler.Port := FPort;
  402. IOHandler.Host := FHost;
  403. IOHandler.ConnectTimeout := FConnectTimeout;
  404. IOHandler.ReadTimeout := FReadTimeout;
  405. end;
  406. if Socket <> nil then begin
  407. Socket.BoundIP := FBoundIP;
  408. Socket.BoundPort := FBoundPort;
  409. Socket.BoundPortMin := FBoundPortMin;
  410. Socket.BoundPortMax := FBoundPortMax;
  411. Socket.IPVersion := FIPVersion;
  412. Socket.ReuseSocket := FReuseSocket;
  413. Socket.UseNagle := FUseNagle;
  414. // TODO: use local event handlers that then trigger the user event handler if assigned
  415. Socket.OnBeforeBind := FOnBeforeBind;
  416. Socket.OnAfterBind := FOnAfterBind;
  417. Socket.OnSocketAllocated := FOnSocketAllocated;
  418. end;
  419. end;
  420. function TIdTCPClientCustom.MakeImplicitClientHandler: TIdIOHandler;
  421. begin
  422. Result := TIdIOHandler.MakeDefaultIOHandler(Self);
  423. end;
  424. procedure TIdTCPClientCustom.Connect(const AHost: string);
  425. begin
  426. Host := AHost;
  427. Connect;
  428. end;
  429. procedure TIdTCPClientCustom.Connect(const AHost: string; const APort: TIdPort);
  430. begin
  431. Host := AHost;
  432. Port := APort;
  433. Connect;
  434. end;
  435. function TIdTCPClientCustom.GetReadTimeout: Integer;
  436. begin
  437. if IOHandler <> nil then begin
  438. Result := IOHandler.ReadTimeout;
  439. end else begin
  440. Result := FReadTimeout;
  441. end;
  442. end;
  443. function TIdTCPClientCustom.GetReuseSocket: TIdReuseSocket;
  444. begin
  445. if Socket <> nil then begin
  446. Result := Socket.ReuseSocket;
  447. end else begin
  448. Result := FReuseSocket;
  449. end;
  450. end;
  451. function TIdTCPClientCustom.GetUseNagle: Boolean;
  452. begin
  453. if Socket <> nil then begin
  454. Result := Socket.UseNagle;
  455. end else begin
  456. Result := FUseNagle;
  457. end;
  458. end;
  459. end.