unitapplogger.pas

简单封装数据库表的类的一个简单的例子： http://www.delphifans.com/SoftView/SoftView_1476.html

unit UnitAppLogger;

interface

uses
  classes, SysUtils, SyncObjs
  {$ifdef CodeSite}
  ,CsIntf
  {$endif}  // CodeSite
  ;

type
  TLoggerType = (logInfo, logWarning, logError, logDebug);
//  TEventType = (etInfo, etWarning, etError);
  TAppEvent = procedure (Sender: TObject; AEventText: string; AEventType:
          TLoggerType) of object;
  TAppLogger = class(TComponent)
  private
    FFileName: string;
    FLock: TCriticalSection;
    FLogFilePath: string;
    FOnAppLog: TAppEvent;
    procedure AddTextToFile(Sender: TObject; Text: string; LogType:
            TLoggerType);
    function GetFileName: string;
    procedure SetLogFilePath(const Value: string);
  public
    constructor Create(AOwner: TComponent); reintroduce; overload; override;
    constructor Create(AOwner: TComponent; AFileName: string); reintroduce;
            overload;
    destructor Destroy; override;
    procedure AddLog(Sender: TObject; Text: string; Args: array of const;
            LogType: TLoggerType = logError); overload;
    procedure AddLog(Sender: TObject; Text: string; LogType: TLoggerType =
            logError); overload;
    procedure Debug(Sender: TObject; Text: string); overload;
    procedure Debug(Sender: TObject; Text: string; Args: array of const);
            overload;
    property FileName: string read GetFileName;
    property LogFilePath: string read FLogFilePath write SetLogFilePath;
    property OnAppLog: TAppEvent read FOnAppLog write FOnAppLog;
  end;
  
function AppLogger: TAppLogger;

const
  STR_EVENT_TYPE : array [TLoggerType] of string =
   ('信息', '警告', '错误', '调试');

implementation


const
//  LOGGER_TYPE_TEXT: array [TLoggerType] of string = ('Error', 'Info', 'Warning', 'Debug');

  sAppLogFormat        = '[%s][%s][%s]%s';
  sDateTimeFormat      = 'yyyy-mm-dd hh:nn:ss';

var
  fLogger: TAppLogger;

function AppLogger: TAppLogger;
begin
  if fLogger = nil then
    fLogger := TAppLogger.Create(nil);
  result := fLogger;
end;

{ TAppLogger }

{
********************************** TAppLogger **********************************
}
constructor TAppLogger.Create(AOwner: TComponent);
begin
  inherited;
  FLock := TCriticalSection.Create;
end;

constructor TAppLogger.Create(AOwner: TComponent; AFileName: string);
begin
  Create(AOwner);
  FFileName := AFileName;
end;

destructor TAppLogger.Destroy;
begin
  FLock.Free;
  inherited;
end;

procedure TAppLogger.AddLog(Sender: TObject; Text: string; Args: array of const;
        LogType: TLoggerType = logError);
begin
  AddLog(Sender, Format(Text, Args), LogType);
end;

procedure TAppLogger.AddLog(Sender: TObject; Text: string; LogType: TLoggerType
        = logError);
begin
  AddTextToFile(Sender, Text, LogType);
end;

procedure TAppLogger.AddTextToFile(Sender: TObject; Text: string; LogType:
        TLoggerType);
var
  varFile: TextFile;
  fText: string;
  fLocFileName: string;
  fSource: string;
begin
  try
    try
      if Assigned(FOnAppLog) then
        FOnAppLog(Sender, Text, LogType);
    except
    end;    // try/except
    if Sender <> nil then
    begin
      FSource := Sender.ClassName;
      fSource := fSource + StringOfChar(#32, 20 - Length(fSource));
    end
    else
      FSource := EmptyStr;
      {$ifdef CodeSite}
    CodeSite.Send(Ord(LogType), Format('[%s]%s',
      [STR_EVENT_TYPE[LogType], FSource]), Text);
      {$endif}  // CodeSite
  //    if LogType = logDebug then
  //      fLocFileName := ChangeFileExt(FileName, '.debug')
  //    else
    fLocFileName := FileName;
  
    fText := Format(sAppLogFormat, [
      FormatDateTime(sDateTimeFormat, Now),
      STR_EVENT_TYPE[LogType], fSource, Text  ]);
    try
      FLock.Enter;
      AssignFile(varFile, fLocFileName);
      if not FileExists(fLocFileName) then
        ReWrite(varFile);
      Append(varFile);
      WriteLn(varFile, fText);
      CloseFile(varFile);
    finally
      FLock.Leave;
    end;
  except
  end;  { try/except }
end;

procedure TAppLogger.Debug(Sender: TObject; Text: string);
begin
  {$ifdef CodeSite}
  CodeSite.Send(8, STR_EVENT_TYPE[LogDebug] , Text);
  {$else}
    {$ifdef APP_DEBUG}
      AddTextToFile(Sender, Text, logDebug);
    {$endif}  // APP_DEBUG
  {$endif}  // CodeSite
  try
    if Assigned(FOnAppLog) then
      FOnAppLog(Sender, Text, LogDebug);
  except
  end;    // try/except
end;

procedure TAppLogger.Debug(Sender: TObject; Text: string; Args: array of const);
begin
  Debug(Sender, Format(Text, Args));
end;

function TAppLogger.GetFileName: string;
var
  fAppFile: string;
  fDateFile: string;
begin
  fDateFile := FormatDateTime('yyyy-mm-dd', Now);
  //  fOldName := ChangeFileExt(ExtractFileName(FFileName), '');
  //  if (fOldName = '') or (StrToDate(fOldName) < StrToDate(fDateFile)) then
  ////  if FFileName = '' then
  //  begin
  fAppFile := GetModuleName(hInstance);
  FFileName := ChangeFileExt(fAppFile, fDateFile + '.log');
  if LogFilePath <> EmptyStr then
    FFileName := LogFilePath + ExtractFilename(FFileName);
  //    FFileName := ExtractFilePath(fAppFile) + fOldName + fDateFile + '.log';
  //    FFileName := ChangeFileExt(fAppFile, '.log');
  //  end;
  result := FFileName;
end;

procedure TAppLogger.SetLogFilePath(const Value: string);
begin
  FLogFilePath := Value;
  if Copy(FLogFilePath, Length(FLogFilePath), 1) <> '\' then
    FLogFilePath := FLogFilePath + '\';
  if not DirectoryExists(FLogFilePath) then
     CreateDir(FLogFilePath);
end;


initialization

finalization
  if fLogger <> nil then
    fLogger.Free;

end.