用法：
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.
