IdIntercept.pas 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 10209: IdIntercept.pas
  11. {
  12. { Rev 1.1 12/14/04 4:08:54 PM RLebeau
  13. { Promoted the TIdConnectionIntercept.Intercept property from protected to
  14. { published
  15. }
  16. {
  17. { Rev 1.0 2002.11.12 10:42:16 PM czhower
  18. }
  19. unit IdIntercept;
  20. {
  21. 2002-03-01 - Andrew P.Rybin
  22. - Nested Intercept support (ex: ->logging->compression->encryption)
  23. 2002-04-09 - Chuck Smith
  24. - set ABuffer.Position := 0; in OnSend/OnReceive for Nested Stream send/receive
  25. }
  26. interface
  27. uses
  28. Classes,
  29. IdBaseComponent,
  30. IdException;
  31. type
  32. EIdInterceptCircularLink = class(EIdException);
  33. TIdConnectionIntercept = class;
  34. TIdInterceptNotifyEvent = procedure(ASender: TIdConnectionIntercept) of object;
  35. TIdInterceptStreamEvent = procedure(ASender: TIdConnectionIntercept; AStream: TStream) of object;
  36. TIdConnectionIntercept = class(TIdBaseComponent)
  37. protected
  38. FConnection: TComponent;
  39. FIntercept: TIdConnectionIntercept;
  40. FIsClient: Boolean;
  41. FOnConnect: TIdInterceptNotifyEvent;
  42. FOnDisconnect: TIdInterceptNotifyEvent;
  43. FOnReceive: TIdInterceptStreamEvent;
  44. FOnSend: TIdInterceptStreamEvent;
  45. //
  46. procedure NestedConnect(AConnection: TComponent); virtual;
  47. procedure NestedDisconnect; virtual;
  48. procedure NestedReceive(ABuffer: TStream); virtual;
  49. procedure NestedSend(ABuffer: TStream); virtual;
  50. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  51. procedure SetIntercept(AValue: TIdConnectionIntercept);
  52. //
  53. public
  54. procedure Connect(AConnection: TComponent); virtual;
  55. constructor Create(AOwner: TComponent); override;
  56. procedure Disconnect; virtual;
  57. procedure Receive(ABuffer: TStream); virtual;
  58. procedure Send(ABuffer: TStream); virtual;
  59. //
  60. property Connection: TComponent read FConnection;
  61. property IsClient: Boolean read FIsClient;
  62. published
  63. property Intercept: TIdConnectionIntercept read FIntercept write SetIntercept;
  64. property OnConnect: TIdInterceptNotifyEvent read FOnConnect write FOnConnect;
  65. property OnDisconnect: TIdInterceptNotifyEvent read FOnDisconnect write FOnDisconnect;
  66. property OnReceive: TIdInterceptStreamEvent read FOnReceive write FOnReceive;
  67. property OnSend: TIdInterceptStreamEvent read FOnSend write FOnSend;
  68. end;
  69. TIdServerIntercept = class(TIdBaseComponent)
  70. public
  71. procedure Init; virtual; abstract;
  72. function Accept(AConnection: TComponent): TIdConnectionIntercept; virtual; abstract;
  73. end;
  74. implementation
  75. uses SysUtils, IdResourceStrings;
  76. { TIdIntercept }
  77. procedure TIdConnectionIntercept.Disconnect;
  78. begin
  79. NestedDisconnect;
  80. if Assigned(OnDisconnect) then begin
  81. OnDisconnect(Self);
  82. end;
  83. FConnection := NIL;
  84. end;
  85. procedure TIdConnectionIntercept.Connect(AConnection: TComponent);
  86. begin
  87. FConnection := AConnection;
  88. if Assigned(OnConnect) then begin
  89. OnConnect(Self);
  90. end;
  91. NestedConnect(AConnection);
  92. end;
  93. constructor TIdConnectionIntercept.Create(AOwner: TComponent);
  94. begin
  95. inherited;
  96. FIsClient := True;
  97. end;
  98. procedure TIdConnectionIntercept.Receive(ABuffer: TStream);
  99. begin
  100. NestedReceive(ABuffer);
  101. if Assigned(OnReceive) then begin
  102. OnReceive(Self, ABuffer);
  103. ABuffer.Position := 0;
  104. end;
  105. end;
  106. procedure TIdConnectionIntercept.Send(ABuffer: TStream);
  107. begin
  108. if Assigned(OnSend) then begin
  109. OnSend(Self, ABuffer);
  110. ABuffer.Position := 0;
  111. end;
  112. NestedSend(ABuffer);
  113. end;
  114. procedure TIdConnectionIntercept.SetIntercept(AValue: TIdConnectionIntercept);
  115. var
  116. LIntercept: TIdConnectionIntercept;
  117. Begin
  118. LIntercept := AValue;
  119. while Assigned(LIntercept) do begin
  120. if LIntercept = SELF then begin //recursion
  121. raise EIdInterceptCircularLink.Create(Format(RSInterceptCircularLink,[ClassName])); // TODO: Resource string and more english
  122. end;
  123. LIntercept := LIntercept.FIntercept;
  124. end;
  125. FIntercept := AValue;
  126. // add self to the Intercept's free notification list {Do not Localize}
  127. if Assigned(FIntercept) then begin
  128. FIntercept.FreeNotification(Self);
  129. end;
  130. End;
  131. procedure TIdConnectionIntercept.Notification(AComponent: TComponent;
  132. Operation: TOperation);
  133. Begin
  134. inherited Notification(AComponent, OPeration);
  135. if (Operation = opRemove) then begin
  136. if (AComponent = FIntercept) then begin
  137. FIntercept := NIL;
  138. end;
  139. end;
  140. End;//
  141. procedure TIdConnectionIntercept.NestedConnect(AConnection: TComponent);
  142. begin
  143. if Assigned(FIntercept) then begin
  144. FIntercept.Connect(AConnection);
  145. end;
  146. end;
  147. procedure TIdConnectionIntercept.NestedDisconnect;
  148. begin
  149. if Assigned(FIntercept) then begin
  150. FIntercept.Disconnect;
  151. end;
  152. end;
  153. procedure TIdConnectionIntercept.NestedReceive(ABuffer: TStream);
  154. begin
  155. if Assigned(FIntercept) then begin
  156. FIntercept.Receive(ABuffer);
  157. end;
  158. end;
  159. procedure TIdConnectionIntercept.NestedSend(ABuffer: TStream);
  160. begin
  161. if Assigned(FIntercept) then begin
  162. FIntercept.Send(ABuffer);
  163. end;
  164. end;
  165. end.