一个简单Tracer类,用来为应用写入跟踪

　2006-02-04 13:46:44　来源：WEB开发网　　　

===================类的代码=========================={*******************************************************}
{　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{　　　 CodeMachine　　　　　　　　　　　　　　　　　　 }
{　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{　　　版权所有 (C) 2004 nil　　　　　　　　　　　　　 }
{　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{　　　 2004-6-10　　　　　　　　　　　　　　　　　　　 }
{　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{*******************************************************}
{
　　通常将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.