IdTCPClient.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544
  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. type
  109. TIdTCPClientCustom = class(TIdTCPConnection)
  110. protected
  111. FBoundIP: String;
  112. FBoundPort: TIdPort;
  113. FBoundPortMax: TIdPort;
  114. FBoundPortMin: TIdPort;
  115. FConnectTimeout: Integer;
  116. FDestination: string;
  117. FHost: string;
  118. FIPVersion: TIdIPVersion;
  119. FOnConnected: TNotifyEvent;
  120. FPassword: string;
  121. FPort: TIdPort;
  122. FReadTimeout: Integer;
  123. FUsername: string;
  124. FReuseSocket: TIdReuseSocket;
  125. FUseNagle: Boolean;
  126. //
  127. FOnBeforeBind: TNotifyEvent;
  128. FOnAfterBind: TNotifyEvent;
  129. FOnSocketAllocated: TNotifyEvent;
  130. //
  131. procedure DoOnConnected; virtual;
  132. function MakeImplicitClientHandler: TIdIOHandler; virtual;
  133. //
  134. procedure SetConnectTimeout(const AValue: Integer);
  135. procedure SetReadTimeout(const AValue: Integer);
  136. procedure SetReuseSocket(const AValue: TIdReuseSocket);
  137. procedure SetUseNagle(const AValue: Boolean);
  138. procedure SetBoundIP(const AValue: String);
  139. procedure SetBoundPort(const AValue: TIdPort);
  140. procedure SetBoundPortMax(const AValue: TIdPort);
  141. procedure SetBoundPortMin(const AValue: TIdPort);
  142. procedure SetHost(const AValue: string); virtual;
  143. procedure SetPort(const AValue: TIdPort); virtual;
  144. procedure SetIPVersion(const AValue: TIdIPVersion); virtual;
  145. //
  146. procedure SetOnBeforeBind(const AValue: TNotifyEvent);
  147. procedure SetOnAfterBind(const AValue: TNotifyEvent);
  148. procedure SetOnSocketAllocated(const AValue: TNotifyEvent);
  149. //
  150. procedure SetIOHandler(AValue: TIdIOHandler); override;
  151. procedure InitComponent; override;
  152. //
  153. function GetReadTimeout: Integer;
  154. function GetReuseSocket: TIdReuseSocket;
  155. function GetUseNagle: Boolean;
  156. //
  157. property Host: string read FHost write SetHost;
  158. property IPVersion: TIdIPVersion read FIPVersion write SetIPVersion;
  159. property Password: string read FPassword write FPassword;
  160. property Port: TIdPort read FPort write SetPort;
  161. property Username: string read FUsername write FUsername;
  162. public
  163. procedure Connect; overload; virtual;
  164. // This is overridden and not as default params so that descendants
  165. // do not have to worry about the arguments.
  166. // Also has been split further to allow usage from C# as it does not have optional
  167. // params
  168. procedure Connect(const AHost: string); overload;
  169. procedure Connect(const AHost: string; const APort: TIdPort); overload;
  170. function ConnectAndGetAll: string; virtual;
  171. //
  172. property BoundIP: string read FBoundIP write SetBoundIP;
  173. property BoundPort: TIdPort read FBoundPort write SetBoundPort default DEF_PORT_ANY;
  174. property BoundPortMax: TIdPort read FBoundPortMax write SetBoundPortMax default DEF_PORT_ANY;
  175. property BoundPortMin: TIdPort read FBoundPortMin write SetBoundPortMin default DEF_PORT_ANY;
  176. //
  177. property ConnectTimeout: Integer read FConnectTimeout write SetConnectTimeout;
  178. property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
  179. property ReuseSocket: TIdReuseSocket read GetReuseSocket write SetReuseSocket default rsOSDependent;
  180. property UseNagle: Boolean read GetUseNagle write SetUseNagle default True;
  181. //
  182. property OnBeforeBind: TNotifyEvent read FOnBeforeBind write SetOnBeforeBind;
  183. property OnAfterBind: TNotifyEvent read FOnAfterBind write SetOnAfterBind;
  184. property OnSocketAllocated: TNotifyEvent read FOnSocketAllocated write SetOnSocketAllocated;
  185. //
  186. published
  187. property OnConnected: TNotifyEvent read FOnConnected write FOnConnected;
  188. end;
  189. TIdTCPClient = class(TIdTCPClientCustom)
  190. published
  191. property BoundIP;
  192. property BoundPort;
  193. property ConnectTimeout;
  194. property Host;
  195. property IPVersion default ID_DEFAULT_IP_VERSION;
  196. property Port;
  197. property ReadTimeout;
  198. property ReuseSocket;
  199. property UseNagle;
  200. property OnBeforeBind;
  201. property OnAfterBind;
  202. property OnSocketAllocated;
  203. end;
  204. //Temp IFDEF till we change aliaser
  205. // Temp - reversed it for code freeze - will rereverse later.
  206. implementation
  207. uses
  208. IdComponent, IdResourceStringsCore, IdIOHandlerSocket;
  209. { TIdTCPClientCustom }
  210. procedure TIdTCPClientCustom.InitComponent;
  211. begin
  212. inherited InitComponent;
  213. FIPVersion := ID_DEFAULT_IP_VERSION;
  214. FReadTimeOut := IdTimeoutDefault;
  215. FBoundPort := DEF_PORT_ANY;
  216. FBoundPortMin := DEF_PORT_ANY;
  217. FBoundPortMax := DEF_PORT_ANY;
  218. FUseNagle := True;
  219. end;
  220. procedure TIdTCPClientCustom.Connect;
  221. begin
  222. if Connected then begin
  223. raise EIdAlreadyConnected.Create(RSAlreadyConnected);
  224. end;
  225. if Host = '' then begin
  226. raise EIdHostRequired.Create('A Host is required'); {do not localize}
  227. end;
  228. if Port = 0 then begin
  229. raise EIdPortRequired.Create('A Port is required'); {do not localize}
  230. end;
  231. if IOHandler = nil then begin
  232. IOHandler := MakeImplicitClientHandler;
  233. ManagedIOHandler := True;
  234. // TODO: always assign the OnStatus event even if the IOHandler is not implicit?
  235. IOHandler.OnStatus := OnStatus; // TODO: assign DoStatus() instead of the handler directly...
  236. end;
  237. try
  238. // Bypass GetDestination
  239. if FDestination <> '' then begin
  240. IOHandler.Destination := FDestination;
  241. end;
  242. {BGO: not any more, TIdTCPClientCustom has precedence now (for port protocols, and things like that)
  243. // We retain the settings that are in here (filled in by the user)
  244. // we only do this when the iohandler has no settings,
  245. // because the iohandler has precedence
  246. if (IOHandler.Port = 0) and (IOHandler.Host = '') then begin
  247. IOHandler.Port := FPort;
  248. IOHandler.Host := FHost;
  249. end;
  250. }
  251. IOHandler.Port := FPort; //BGO: just to make sure
  252. IOHandler.Host := FHost;
  253. IOHandler.ConnectTimeout := FConnectTimeout;
  254. IOHandler.ReadTimeout := FReadTimeout;
  255. if Socket <> nil then begin
  256. Socket.BoundIP := FBoundIP;
  257. Socket.BoundPort := FBoundPort;
  258. Socket.BoundPortMin := FBoundPortMin;
  259. Socket.BoundPortMax := FBoundPortMax;
  260. Socket.IPVersion := FIPVersion;
  261. Socket.ReuseSocket := FReuseSocket;
  262. Socket.UseNagle := FUseNagle;
  263. Socket.OnBeforeBind := FOnBeforeBind;
  264. Socket.OnAfterBind := FOnAfterBind;
  265. Socket.OnSocketAllocated := FOnSocketAllocated;
  266. end;
  267. IOHandler.Open;
  268. if IOHandler.Intercept <> nil then begin
  269. IOHandler.Intercept.Connect(Self);
  270. end;
  271. DoStatus(hsConnected, [Host]);
  272. DoOnConnected;
  273. except
  274. if IOHandler <> nil then begin
  275. IOHandler.Close;
  276. if ManagedIOHandler then begin
  277. IOHandler := nil; // RLebeau - SetIOHandler() will free the IOHandler
  278. end;
  279. end;
  280. raise;
  281. end;
  282. end;
  283. function TIdTCPClientCustom.ConnectAndGetAll: string;
  284. begin
  285. Connect; try
  286. Result := IOHandler.AllData;
  287. finally Disconnect; end;
  288. end;
  289. procedure TIdTCPClientCustom.DoOnConnected;
  290. begin
  291. if Assigned(OnConnected) then begin
  292. OnConnected(Self);
  293. end;
  294. end;
  295. procedure TIdTCPClientCustom.SetConnectTimeout(const AValue: Integer);
  296. begin
  297. FConnectTimeout := AValue;
  298. if IOHandler <> nil then begin
  299. IOHandler.ConnectTimeout := AValue;
  300. end;
  301. end;
  302. procedure TIdTCPClientCustom.SetReadTimeout(const AValue: Integer);
  303. begin
  304. FReadTimeout := AValue;
  305. if IOHandler <> nil then begin
  306. IOHandler.ReadTimeout := AValue;
  307. end;
  308. end;
  309. procedure TIdTCPClientCustom.SetReuseSocket(const AValue: TIdReuseSocket);
  310. begin
  311. FReuseSocket := AValue;
  312. if Socket <> nil then begin
  313. Socket.ReuseSocket := AValue;
  314. end;
  315. end;
  316. procedure TIdTCPClientCustom.SetUseNagle(const AValue: Boolean);
  317. begin
  318. FUseNagle := AValue;
  319. if Socket <> nil then begin
  320. Socket.UseNagle := AValue;
  321. end;
  322. end;
  323. procedure TIdTCPClientCustom.SetBoundIP(const AValue: String);
  324. begin
  325. FBoundIP := AValue;
  326. if Socket <> nil then begin
  327. Socket.BoundIP := AValue;
  328. end;
  329. end;
  330. procedure TIdTCPClientCustom.SetBoundPort(const AValue: TIdPort);
  331. begin
  332. FBoundPort := AValue;
  333. if Socket <> nil then begin
  334. Socket.BoundPort := AValue;
  335. end;
  336. end;
  337. procedure TIdTCPClientCustom.SetBoundPortMax(const AValue: TIdPort);
  338. begin
  339. FBoundPortMax := AValue;
  340. if Socket <> nil then begin
  341. Socket.BoundPortMax := AValue;
  342. end;
  343. end;
  344. procedure TIdTCPClientCustom.SetBoundPortMin(const AValue: TIdPort);
  345. begin
  346. FBoundPortMin := AValue;
  347. if Socket <> nil then begin
  348. Socket.BoundPortMin := AValue;
  349. end;
  350. end;
  351. procedure TIdTCPClientCustom.SetHost(const AValue: string);
  352. begin
  353. FHost := AValue;
  354. if IOHandler <> nil then begin
  355. IOHandler.Host := AValue;
  356. end;
  357. end;
  358. procedure TIdTCPClientCustom.SetPort(const AValue: TIdPort);
  359. begin
  360. FPort := AValue;
  361. if IOHandler <> nil then begin
  362. IOHandler.Port := AValue;
  363. end;
  364. end;
  365. procedure TIdTCPClientCustom.SetIPVersion(const AValue: TIdIPVersion);
  366. begin
  367. FIPVersion := AValue;
  368. if Socket <> nil then begin
  369. Socket.IPVersion := AValue;
  370. end;
  371. end;
  372. procedure TIdTCPClientCustom.SetOnBeforeBind(const AValue: TNotifyEvent);
  373. begin
  374. FOnBeforeBind := AValue;
  375. if Socket <> nil then begin
  376. Socket.OnBeforeBind := AValue;
  377. end;
  378. end;
  379. procedure TIdTCPClientCustom.SetOnAfterBind(const AValue: TNotifyEvent);
  380. begin
  381. FOnAfterBind := AValue;
  382. if Socket <> nil then begin
  383. Socket.OnAfterBind := AValue;
  384. end;
  385. end;
  386. procedure TIdTCPClientCustom.SetOnSocketAllocated(const AValue: TNotifyEvent);
  387. begin
  388. FOnSocketAllocated := AValue;
  389. if Socket <> nil then begin
  390. Socket.OnSocketAllocated := AValue;
  391. end;
  392. end;
  393. procedure TIdTCPClientCustom.SetIOHandler(AValue: TIdIOHandler);
  394. begin
  395. inherited SetIOHandler(AValue);
  396. // TIdTCPClientCustom overrides settings in iohandler to initialize
  397. // protocol defaults.
  398. if IOHandler <> nil then begin
  399. IOHandler.Port := FPort;
  400. IOHandler.Host := FHost;
  401. IOHandler.ConnectTimeout := FConnectTimeout;
  402. IOHandler.ReadTimeout := FReadTimeout;
  403. end;
  404. if Socket <> nil then begin
  405. Socket.BoundIP := FBoundIP;
  406. Socket.BoundPort := FBoundPort;
  407. Socket.BoundPortMin := FBoundPortMin;
  408. Socket.BoundPortMax := FBoundPortMax;
  409. Socket.IPVersion := FIPVersion;
  410. Socket.ReuseSocket := FReuseSocket;
  411. Socket.UseNagle := FUseNagle;
  412. // TODO: use local event handlers that then trigger the user event handler if assigned
  413. Socket.OnBeforeBind := FOnBeforeBind;
  414. Socket.OnAfterBind := FOnAfterBind;
  415. Socket.OnSocketAllocated := FOnSocketAllocated;
  416. end;
  417. end;
  418. function TIdTCPClientCustom.MakeImplicitClientHandler: TIdIOHandler;
  419. begin
  420. Result := TIdIOHandler.MakeDefaultIOHandler(Self);
  421. end;
  422. procedure TIdTCPClientCustom.Connect(const AHost: string);
  423. begin
  424. Host := AHost;
  425. Connect;
  426. end;
  427. procedure TIdTCPClientCustom.Connect(const AHost: string; const APort: TIdPort);
  428. begin
  429. Host := AHost;
  430. Port := APort;
  431. Connect;
  432. end;
  433. function TIdTCPClientCustom.GetReadTimeout: Integer;
  434. begin
  435. if IOHandler <> nil then begin
  436. Result := IOHandler.ReadTimeout;
  437. end else begin
  438. Result := FReadTimeout;
  439. end;
  440. end;
  441. function TIdTCPClientCustom.GetReuseSocket: TIdReuseSocket;
  442. begin
  443. if Socket <> nil then begin
  444. Result := Socket.ReuseSocket;
  445. end else begin
  446. Result := FReuseSocket;
  447. end;
  448. end;
  449. function TIdTCPClientCustom.GetUseNagle: Boolean;
  450. begin
  451. if Socket <> nil then begin
  452. Result := Socket.UseNagle;
  453. end else begin
  454. Result := FUseNagle;
  455. end;
  456. end;
  457. end.