===================类的代码===============
　　{*******************************************************}
　　{ }
　　{ 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.
　　=============测试代码===================
　　{***********************************}
　　{ }
　　{ 测试名称： }
　　{ 作 者： }
　　{ 版 本： }