===================類的代碼=========================={*******************************************************}
{                                                       }
{       CodeMachine                                     }
{                                                       }
{       版權所有 (C) 2004 nil                           }
{                                                       }
{       2004-6-10                                       }
{                                                       }
{*******************************************************}
{
    通常將TTracer的實例存放于application級的session中,在使用時,
    創(chuàng)建一個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;

//==============================================================================
// 跟蹤信息類 ,實現(xiàn) ITraceInfo
//==============================================================================

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

//==============================================================================
// 跟蹤信息輸出類,實現(xiàn) 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('沒有創(chuàng)建輸出目標%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.