| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137 |
- { $HDR$}
- {**********************************************************************}
- { Unit archived using Team Coherence }
- { Team Coherence is Copyright 2002 by Quality Software Components }
- { }
- { For further information / comments, visit our WEB site at }
- { http://www.TeamCoherence.com }
- {**********************************************************************}
- {}
- { $Log: 10237: IdLogFile.pas
- {
- { Rev 1.1 7/23/04 6:13:28 PM RLebeau
- { TFileStream access right tweak for Open()
- }
- {
- { Rev 1.0 2002.11.12 10:44:30 PM czhower
- }
- unit IdLogFile;
- {
- Revision History:
- 19-Aug-2001 DSiders Fixed bug in Open. Use file mode fmCreate when Filename
- does *not* exist.
- 19-Aug-2001 DSiders Added protected method TIdLogFile.LogWriteString.
- 19-Aug-2001 DSiders Changed implementation of TIdLogFile methods LogStatus,
- LogReceivedData, and LogSentData to use LogWriteString.
- 19-Aug-2001 DSiders Added class TIdLogFileEx with the LogFormat method.
- }
- interface
- uses
- Classes,
- IdLogBase,
- SysUtils;
- type
- TIdLogFile = class(TIdLogBase)
- protected
- FFilename: TFilename;
- FFileStream: TFileStream;
- //
- procedure Close; override;
- procedure LogFormat(const AFormat: string; const AArgs: array of const); virtual;
- procedure LogReceivedData(const AText: string; const AData: string); override;
- procedure LogSentData(const AText: string; const AData: string); override;
- procedure LogStatus(const AText: string); override;
- procedure LogWriteString(const AText: string); virtual;
- procedure Open; override;
- public
- published
- property Filename: TFilename read FFilename write FFilename;
- end;
- implementation
- uses
- IdGlobal,
- IdResourceStrings;
- { TIdLogFile }
- procedure TIdLogFile.Close;
- begin
- FreeAndNil(FFileStream);
- end;
- procedure TIdLogFile.LogReceivedData(const AText, AData: string);
- begin
- LogWriteString(RSLogRecv + AText + ': ' + AData + EOL); {Do not translate}
- end;
- procedure TIdLogFile.LogSentData(const AText, AData: string);
- begin
- LogWriteString(RSLogSent + AText + ': ' + AData + EOL); {Do not translate}
- end;
- procedure TIdLogFile.LogStatus(const AText: string);
- begin
- LogWriteString(RSLogStat + AText + EOL);
- end;
- procedure TIdLogFile.Open;
- begin
- if not (csDesigning in ComponentState) then begin
- if not FileExists(Filename) then begin
- FFileStream := TFileStream.Create(Filename, fmCreate);
- end else begin
- FFileStream := TFileStream.Create(Filename, fmOpenReadWrite or fmShareDenyWrite);
- FFileStream.Position := FFileStream.Size;
- end;
- end;
- end;
- procedure TIdLogFile.LogWriteString(const AText: string);
- begin
- if Length(AText) > 0 then begin
- FFileStream.WriteBuffer(AText[1], Length(AText));
- end;
- end;
- procedure TIdLogFile.LogFormat(const AFormat: string; const AArgs: array of const);
- var
- sPre: string;
- sMsg: string;
- sData: string;
- begin
- // forces Open to be called prior to Connect
- if not Active then
- begin
- Active := True;
- end;
- sPre := ''; {Do not translate}
- sMsg := ''; {Do not translate}
- if LogTime then
- begin
- sPre := DateTimeToStr(Now) + ' ' ; {Do not translate}
- end;
- sData := Format(AFormat, AArgs);
- if FReplaceCRLF then begin
- sData := StringReplace(sData, EOL, RSLogEOL, [rfReplaceAll]);
- sData := StringReplace(sData, CR, RSLogCR, [rfReplaceAll]);
- sData := StringReplace(sData, LF, RSLogLF, [rfReplaceAll]);
- end;
- sMsg := sPre + sData + EOL;
- LogWriteString(sMsg);
- end;
- end.
|