庞大资源库的计算机教程网站!
设为首页
加入收藏
总编信箱
投稿或申请专栏请先 [登 陆]
首页 操作系统 程序设计 图形图像 媒体动画 机械电子 WEB开发 数 据 库 办公系列 路由技术 网络原理 网络应用
认证考试 安全技术
首页>程序设计>Delphi语言>实例分析>正文
资料搜索
Google搜索
Google
返回上级列表

推荐文章

快速保存网页中所有图片的方法
Windows中让光驱巧妙“隐身”技
防范非法用户入侵Win 2000/XP系
两款比较典型的ASP木马防范方法
有关表格边框的css语法整理
Windows XP中可以被禁用的服务
SQL Server导出导入数据方法
Javascript所有对象的属性的获
网页(HTML)中的特殊字符
与篮球共舞,尽显模式本色
QQ病毒的手工清除方法
Photoshop为极品美女打造性感睫
天衣无缝:IIS与PHP水火也相容
SQL Server存储过程编写和优化

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

 作者:本站收集   日期:2005-3-14
字号选择〖 〗/ 双击滚屏 单击停止   
===================类的代码=========================={*******************************************************}
{ }
{ 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.

上一篇:在DELPHI7中不使用任何第三方控件,实现放在工具栏上可拖动的XP风格菜单    下一篇:Delphi使用VB6编写的ActiveX控件???  
[发送给好友]  [关闭窗口]  [返回顶部]   转载请注明来源:www.it00.com   
特别声明: 本站除部分特别声明禁止转载的专稿外的其他文章可以自由转载,但请务必注明出处和原始作者。文章版权归文章原始作者所有。对于被本站转载文章的个人和网站,我们表示深深的谢意。如果本站转载的文章有版权问题请联系编辑人员,我们尽快予以更正。
责任编辑: 原点 投稿作者: 本站收集
信息来源: 网络 录入时间: 2005-3-14
关于我们 - 广告服务 - 版权申明 - 网站地图 - 联系方式 - 总编信箱 - 会员投稿