用法:
var StringsLogger: TStringsLogger; begin //log StringsLogger := TStringsLogger.Create(); StringsLogger.MaxLogCount := 20; StringsLogger.Strings := txtLog.Lines; //一个memo的Lines Log := TMultiThreadLog.Create(StringsLogger, LT_DEBUG); //多线程,使用了队列,效率估计很低 //Log := TSingleThreadLog.Create(StringsLogger, LT_DEBUG); //单线程 end;
以下是unitLog.pas //============================================================================= unit unitLog;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type //log分成五个等级,如下: ELogType = (LT_FATAL, LT_ERROR, LT_WARN, LT_INFO, LT_DEBUG);
//log信息类 TLogMsg = class LogType: ELogType; time: TDateTime; Msg: string; end;
//Log写模块的基础类,用于写入Log的过程,后面的TStringsLogger就是继承它,也可以实现各种形式的写模块,如TFileLogger、TStreamLogger等等,这样可以达到随意定向Log输出的目的。 TLoggerBase = class procedure open(); virtual; abstract; procedure close(); virtual; abstract; procedure write(logMsg: TLogMsg); virtual; abstract; end;
//Log模块基础类,是后面的单线程Log和多线程Log都继承它 TLogBase = class protected FLogType: ELogType; FLogger: TLoggerBase; constructor Create();overload; public property LogType: ELogType read FLogType write FLogType; property Logger: TLoggerBase read FLogger write FLogger; constructor Create(logger: TLoggerBase; logType: ELogType = LT_INFO); overload; destructor Destroy(); override; public procedure fatal(msg: string); procedure error(msg: string); procedure warn(msg: string); procedure info(msg: string); procedure debug(msg: string); procedure log(logMsg: TLogMsg); virtual; abstract; end;
//以TStrings为基础的写入类 TStringsLogger = class(TLoggerBase) protected FStrings: TStrings; FMaxLogCount: integer; public property Strings: TStrings read FStrings write FStrings; property MaxLogCount: integer read FMaxLogCount write FMaxLogCount; procedure open(); override; procedure close(); override; procedure write(logMsg: TLogMsg); override; end;
//单线程Log TSingleThreadLog = class(TLogBase) public procedure log(logMsg: TLogMsg); override; end;
TMultiThreadLog = class; //多线程Log的线程类 TMsgThread = class(TThread) protected MsgList: TThreadList; public MultiThreadLog: TMultiThreadLog; constructor Create(CreateSuspended: Boolean); destructor Destroy(); override; procedure Execute; override; procedure HandleInput; procedure pushMsg(logMsg: TLogMsg); function popMsg(): TLogMsg; end; //多线程Log,使用TThreadList来作为信息的队列,每隔固定时间输出一个,实现笨拙,估计效率也不高 TMultiThreadLog = class(TLogBase) protected MsgThread: TMsgThread; public constructor Create(logger: TLoggerBase; logType: ELogType = LT_INFO); overload; procedure log(logMsg: TLogMsg); override; procedure logOne(logMsg: TLogMsg); end;
function getLogTypeString(logType: ELogType): string; var Log: TLogBase;//全局变量,只需要创建一次对象就可以了。 implementation
{ Public functions } function getLogTypeString(logType: ELogType): string; begin case logType of LT_FATAL: result := 'Fatal'; LT_ERROR: result := 'Error'; LT_WARN: result := 'Warn'; LT_INFO: result := 'Info'; LT_DEBUG: result := 'Debug'; end; end;
{ TLogBase }
constructor TLogBase.Create(); begin end;
constructor TLogBase.Create(logger: TLoggerBase; logType: ELogType = LT_INFO); begin FLogType := logType; FLogger := logger; FLogger.open(); end;
destructor TLogBase.Destroy; begin FLogger.close(); inherited; end;
procedure TLogBase.debug(msg: string); var logMsg: TLogMsg; begin if FLogType >= LT_DEBUG then begin logMsg := TLogMsg.Create; logMsg.LogType := LT_DEBUG; logMsg.time := Now(); logMsg.Msg := msg; log(logMsg); end; end;
procedure TLogBase.info(msg: string); var logMsg: TLogMsg; begin if FLogType >= LT_INFO then begin logMsg := TLogMsg.Create; logMsg.LogType := LT_INFO; logMsg.time := Now(); logMsg.Msg := msg; log(logMsg); end; end;
procedure TLogBase.warn(msg: string); var logMsg: TLogMsg; begin if FLogType >= LT_WARN then begin logMsg := TLogMsg.Create; logMsg.LogType := LT_WARN; logMsg.time := Now(); logMsg.Msg := msg; log(logMsg); end; end;
procedure TLogBase.error(msg: string); var logMsg: TLogMsg; begin if FLogType >= LT_ERROR then begin logMsg := TLogMsg.Create; logMsg.LogType := LT_ERROR; logMsg.time := Now(); logMsg.Msg := msg; log(logMsg); end; end;
procedure TLogBase.fatal(msg: string); var logMsg: TLogMsg; begin if FLogType >= LT_FATAL then begin logMsg := TLogMsg.Create; logMsg.LogType := LT_FATAL; logMsg.time := Now(); logMsg.Msg := msg; log(logMsg); end; end;
{ TSingleThreadLog }
procedure TSingleThreadLog.log(logMsg: TLogMsg); begin FLogger.write(logMsg); logMsg.Destroy; end;
{ TMultiThreadLog }
constructor TMultiThreadLog.Create(logger: TLoggerBase; logType: ELogType); begin inherited Create(logger, logType); MsgThread := TMsgThread.Create(true); MsgThread.MultiThreadLog := self; MsgThread.FreeOnTerminate:=True; MsgThread.Resume; end;
procedure TMultiThreadLog.log(logMsg: TLogMsg); begin MsgThread.pushMsg(logMsg); end;
procedure TMultiThreadLog.logOne(logMsg: TLogMsg); begin FLogger.write(logMsg); end;
{ TMsgThread }
constructor TMsgThread.Create(CreateSuspended: Boolean); begin inherited Create(CreateSuspended); MsgList := TThreadList.Create; end;
destructor TMsgThread.Destroy; begin MsgList.Destroy; inherited; end;
procedure TMsgThread.Execute; begin while not Terminated do begin Synchronize(HandleInput); sleep(10); end; end;
procedure TMsgThread.HandleInput; var logMsg: TLogMsg; begin logMsg := popMsg(); if logMsg <> nil then begin MultiThreadLog.logOne(logMsg); logMsg.Destroy; end; end;
function TMsgThread.popMsg: TLogMsg; var list: TList; begin list := MsgList.LockList; if list.Count <> 0 then begin result := list.First; list.Delete(0); end else begin result := nil; end; MsgList.UnlockList; end;
procedure TMsgThread.pushMsg(logMsg: TLogMsg); begin MsgList.Add(logMsg); end;
{ TStringsLogger } procedure TStringsLogger.open; begin inherited; end;
procedure TStringsLogger.close; begin inherited; end;
procedure TStringsLogger.write(logMsg: TLogMsg); begin inherited; if FStrings.Count >= FMaxLogCount then FStrings.Delete(0); FStrings.Add('[' + DateTimeToStr(logMsg.time) + ']-[' + getLogTypeString(logMsg.LogType) + '] ' + logMsg.Msg); end;
end.

|