[原创]一个可动态配置的Log模块

用法：

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.

本文地址：http://com.8s8s.com/it/it32399.htm