======================================================= {* *********************************************************** ****} {} {codemachine} {} {copyright (c) 2004 nil} {} {2004-6-10} {} {***************** ***********************************************} {usually store TTracer instances in the Application level In the session, when you are using, create a ItraceInfo, call TTracer.write (ItraceInfo),} unit com.sunset.app.tracer; interface buys strutils, classes, sysutils; type // ======== ============================================================================================================================================================================================================= ==================== // Interface declaration / / ============================================================================================================================================================ ============================================================================================================================================================================================================= ====
// Track information interface iATraceInfo = interface; end; // Output target interface Ioutput = interface procedure write (const ainfo: iTraceInfo); // Write tracking information end; // ====== ============================================================================================================================================================================================================= ====================== // Track information classes, realize itraceinfo // =================== ============================================================================================================================================================================================================= ========= // String Form Track Record TStringti = Class (TinterFaceDObject, ItraceInfo) Private fdata: string; public constructor create (data: string); function toString: string; end; // == ============================================================================================================================================================================================================= ========================== // Track information output classes, implement Ioutput // ============= ==========
============================================================================================================================================================================================================= ===== TFileLog = class (TInterfacedObject, IOutput) private FLogFile: string; public constructor Create (const FileName: string); procedure write (const aInfo: ITraceInfo); // write trace 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); // write trace end; // == ============================================================================================================================================================================================================= ========================== // Track tool / / ========================================================================================================================================================================= ============================================================================================================================================================================================================= ========== {TTracer} // TTRACER = Class (TOBJECT) private foutput: Ioutput; // Output target procedure setput (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); // write trace 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 .SETOTOTPUT (Const Value: IOUTPUT); Begin Foutput: = Value; End; Procedure TTracer.write (const ainfo: iTraceInfo); begin if futput = nil the raise exception.createfmt ('Nothing created output target% 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 Flogfi le: = 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 ( 'no Passing the correct write tracking method% s !!! ', []); end; procedure tdatabaselog.write (const ainfo: iTraceInfo); begin fwriteproc (ainfo.toString); end;
=================== Test code =========================== {** *********************************************************** **************************} {} {test name:} {author:} {version:} { }} {} {***************************************************** ******************************************} Unit Test.com.sunSet.App.tracer; Interface Uses Windows , Sysutils, Classes, Testframework, Testextensions, com.sunset.app.tracer; type ttest = class (ttestcase) protected procate setup; override; procedure teardown; Overri de; 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.
