用简单的Tracer类来为应用写入跟踪

{
通常将TTracer的实例存放于application级的Session中,在使用时,
创建一个ITraceInfo,调用TTracer.Write(ITraceInfo)即可,
}

unit com.sunset.app.tracer;

interface

uses StrUtils,classes,SysUtils;

type

//==========================
// 接口声明
//==========================

//跟踪信息的接口
ITraceInfo = interface
  function ToString: string;
end;
//输出目标的接口
IOutput = interface
  procedure Write(const aInfo: ITraceInfo); //写入跟踪信息
end;

//==========================
// 跟踪信息类 ,实现 ITraceInfo
//==========================

//string形式的跟踪记录
TStringTI = class(TInterfacedObject, ITraceInfo)
private
  FData: string;
public
  constructor Create(data: string);
  function ToString: string;
end;

//==========================
// 跟踪信息输出类,实现 IOutput
//==========================

TFileLog = class(TInterfacedObject, IOutput)
private
  FLogFile: string;
public
  constructor Create(const FileName: string);
  procedure Write(const aInfo: ITraceInfo); //写入跟踪信息
end;

TProcStr = procedure(const value:string) of Object;
TDatabaseLog = class(TInterfacedObject, IOutput)
private
  FWriteProc :TProcStr;
public
  constructor Create(WriteProc: TProcStr);
  procedure Write(const aInfo: ITraceInfo); //写入跟踪信息
end;

//==========================
// 跟踪工具
//==========================

{ TTracer }
//用来进行记录跟踪日志的类
TTracer = class(TObject)
private
  FOutput: IOutput; //输出目标
  procedure SetOutput(const Value: IOutput);
public
  constructor Create; overload;
  constructor Create(aOutput: IOutput); overload;
  destructor Destroy; override;
  property Output: IOutput read FOutput write SetOutput;
  procedure Write(const aInfo: ITraceInfo); //写入跟踪信息
end;

implementation

{ TTracer }

constructor TTracer.Create;
begin

end;

constructor TTracer.Create(aOutput: IOutput);
begin
FOutput := aOutput;
end;

destructor TTracer.Destroy;
begin
if FOutput <> nil then FOutput := nil;
inherited;
end;

procedure TTracer.SetOutput(const Value: IOutput);
begin
FOutput := Value;
end;

procedure TTracer.Write(const aInfo: ITraceInfo);
begin
if FOutput = nil then raise Exception.CreateFmt('没有创建输出目标%s!!!', []);
FOutput.Write(aInfo);
end;

{ TStringTI }

constructor TStringTI.Create(data: string);
begin
FData := Data;
end;

function TStringTI.ToString: string;
begin
Result := FData;
end;

{ TStringLog }

constructor TFileLog.Create(const FileName: string);
begin
FLogFile := FileName;
end;

procedure TFileLog.Write(const aInfo: ITraceInfo);
begin
if not FileExists(FLogFile) then FileClose(FileCreate(FLogFile));
with TStringList.Create do
begin
  try
   LoadFromFile(FLogFile);
   Add(aInfo.ToString);
   SaveToFile(FLogFile);
  finally
   Free;
  end;
end;
end;

{ TDatabaseLog }

constructor TDatabaseLog.Create(WriteProc: TProcStr);
begin
FWriteProc := WriteProc;
if not Assigned(FWriteProc) then raise Exception.CreateFmt('没有传入正确的写入跟踪方法%s!!!', []);
end;

procedure TDatabaseLog.Write(const aInfo: ITraceInfo);
begin
FWriteProc(aInfo.ToString);
end;

end.

===========测试代码===========
{************************}
{  }
{ 测试名称：   }
{ 作 者：    }
{ 版 本：  }
{ 说 明：  }
{ 备 注： }
{    }
{***********************}

unit test.com.sunset.app.tracer;

interface

uses
  Windows, SysUtils, Classes, TestFramework, TestExtensions,
  com.sunset.app.tracer;

type
  TTest = class(TTestCase)
  protected
procedure SetUp; override;
procedure TearDown; override;

published
procedure TestTracer;
  end;

implementation

procedure TTest.Setup;
begin

end;

procedure TTest.TearDown;
begin

end;

procedure TTest.TestTracer;
var
tracer:TTracer;
aInfo:ITraceInfo;
const
testData ='adfadfdasf';
testFile ='d:\2.txt';
begin
aInfo := TStringTI.Create(testData);
Tracer := TTracer.Create(TFileLog.Create(testfile));
Tracer.Write(aInfo);
Tracer.Free;
aInfo := nil;
with TStringList.Create do
begin
  LoadFromFile(testfile);
  Check(Strings[Count -1] = testData);
  Free;
end;
end;

initialization
  TestFramework.RegisterTest(TTest.Suite);

end.