IdInterceptSimLog.pas 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152
  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.6 7/23/04 6:40:08 PM RLebeau
  18. Added extra exception handling to Connect()
  19. Rev 1.5 2004.05.20 11:39:10 AM czhower
  20. IdStreamVCL
  21. Rev 1.4 2004.02.03 4:17:18 PM czhower
  22. For unit name changes.
  23. Rev 1.3 10/19/2003 11:38:26 AM DSiders
  24. Added localization comments.
  25. Rev 1.2 2003.10.18 1:56:46 PM czhower
  26. Now uses ASCII instead of binary format.
  27. Rev 1.1 2003.10.17 6:16:20 PM czhower
  28. Functional complete.
  29. }
  30. unit IdInterceptSimLog;
  31. {
  32. This file uses string outputs instead of binary so that the results can be
  33. viewed and modified with notepad if necessary.
  34. Most times a Send/Receive includes a writeln, but may not always. We write out
  35. an additional EOL to guarantee separation in notepad.
  36. It also auto detects when an EOL can be used instead.
  37. TODO: Can also change it to detect several EOLs and non binary and use :Lines:x
  38. }
  39. interface
  40. {$i IdCompilerDefines.inc}
  41. uses
  42. Classes,
  43. IdGlobal, IdIntercept;
  44. type
  45. TIdInterceptSimLog = class(TIdConnectionIntercept)
  46. private
  47. protected
  48. FFilename: string;
  49. FStream: TStream;
  50. //
  51. procedure SetFilename(const AValue: string);
  52. procedure WriteRecord(const ATag: string; const ABuffer: TIdBytes);
  53. public
  54. procedure Connect(AConnection: TComponent); override;
  55. procedure Disconnect; override;
  56. procedure Receive(var ABuffer: TIdBytes); override;
  57. procedure Send(var ABuffer: TIdBytes); override;
  58. published
  59. property Filename: string read FFilename write SetFilename;
  60. end;
  61. implementation
  62. uses
  63. IdException, IdResourceStringsCore, SysUtils;
  64. { TIdInterceptSimLog }
  65. procedure TIdInterceptSimLog.Connect(AConnection: TComponent);
  66. begin
  67. inherited Connect(AConnection);
  68. // Warning! This will overwrite any existing file. It makes no sense
  69. // to concatenate sim logs.
  70. FStream := TIdFileCreateStream.Create(Filename);
  71. end;
  72. procedure TIdInterceptSimLog.Disconnect;
  73. begin
  74. FreeAndNil(FStream);
  75. inherited Disconnect;
  76. end;
  77. procedure TIdInterceptSimLog.Receive(var ABuffer: TIdBytes);
  78. begin
  79. // let the next Intercept in the chain decode its data first
  80. inherited Receive(ABuffer);
  81. WriteRecord('Recv', ABuffer); {do not localize}
  82. end;
  83. procedure TIdInterceptSimLog.Send(var ABuffer: TIdBytes);
  84. begin
  85. WriteRecord('Send', ABuffer); {do not localize}
  86. // let the next Intercept in the chain encode its data next
  87. inherited Send(ABuffer);
  88. end;
  89. procedure TIdInterceptSimLog.SetFilename(const AValue: string);
  90. begin
  91. if Assigned(FStream) then begin
  92. raise EIdException.Create(RSLogFileAlreadyOpen); // TODO: create a new Exception class for this
  93. end;
  94. FFilename := AValue;
  95. end;
  96. procedure TIdInterceptSimLog.WriteRecord(const ATag: string; const ABuffer: TIdBytes);
  97. var
  98. i: Integer;
  99. LUseEOL: Boolean;
  100. LSize: Integer;
  101. begin
  102. LUseEOL := False;
  103. LSize := Length(ABuffer);
  104. if LSize > 1 then begin
  105. if (ABuffer[LSize - 2] = 13) and (ABuffer[LSize - 1] = 10) then begin
  106. LUseEOL := True;
  107. for i := 0 to LSize - 3 do begin
  108. // If any binary, CR or LF
  109. if (ABuffer[i] < 32) or (ABuffer[i] > 127) then begin
  110. LUseEOL := False;
  111. Break;
  112. end;
  113. end;
  114. end;
  115. end;
  116. with FStream do begin
  117. if LUseEOL then begin
  118. WriteLn(ATag + ':EOL'); {do not localize}
  119. end else begin
  120. WriteLn(ATag + ':Bytes:' + IntToStr(LSize)); {do not localize}
  121. end;
  122. end;
  123. WriteStringToStream(FStream, '');
  124. WriteTIdBytesToStream(FStream, ABuffer, LSize);
  125. WriteStringToStream(FStream, EOL);
  126. end;
  127. end.