loggerunit.pas

一个实现程序日志功能的com组件

unit LoggerUnit;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Classes, ComObj, ActiveX, Log_TLB, StdVcl;

const

  MAX_LOGFILESIZE       = 20971520;  // 最大20M
type
  TLogger = class(TAutoObject, ILogger)
  private
    FLog: TFileStream;
    FSize: integer;
    FEnabled: boolean;
    FFileName: string;

    function GetLogger: TFileStream;

  protected
    function Get_Enabled: WordBool; safecall;
    function Get_FileName: WideString; safecall;
    function Get_MaxSize: Integer; safecall;
    procedure Log(const AInfo: WideString); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_FileName(const Value: WideString); safecall;
    procedure Set_MaxSize(Value: Integer); safecall;
    procedure FreeResource; safecall;
    { Protected declarations }
  public
    destructor Destroy; override;
    property Logger: TFileStream read GetLogger;

  end;

implementation

uses ComServ, SysUtils, Common, StrUtils;

destructor TLogger.Destroy;
begin
  if Assigned(FLog) then
    FreeAndNil(FLog);
  inherited;
end;

function TLogger.GetLogger: TFileStream;
begin
  if not Assigned(FLog) then
  begin
    if FFileName = '' then
    begin
      FFileName := TSystem.ApplicationNameWithPath + '.log';
    end;
    if not FileExists(FFileName) then
    begin
      FLog := TFileStream.Create(FFileName,
                       fmCreate or fmShareDenyWrite);
      FLog.Free;
    end;

    try
      FLog := TFileStream.Create(FFileName,
                   fmOpenReadWrite + fmShareDenyWrite);
    except
      // Hide Error.
    end;
  end;

  if FSize <= 0 then
    FSize := MAX_LOGFILESIZE;
  // ...
  Result := Flog;
end;

function TLogger.Get_Enabled: WordBool;
begin
  Result := FEnabled;
end;

function TLogger.Get_FileName: WideString;
begin
  Result := FFileName;
end;

function TLogger.Get_MaxSize: Integer;
begin
  Result := FSize;
end;

procedure TLogger.Log(const AInfo: WideString);
var
  strTmp: string;
begin
  if not FEnabled then
    exit;
  try
    if Logger.Size > FSize then
    begin  // 如果日志文件已经大于设定值，
         // 则需要把日志文件删除后重建
      // 如果需要更高级的日志功能在这里增加功能。
      FreeAndNil(Flog);
      strTmp := FFileName + '.ls';
      if FileExists(strTmp) then
        DeleteFile(strTmp);
      RenameFile(FFileName, strTmp);
      Log(AInfo);
    end
    else
    begin
      Logger.Seek(0, soFromEnd);
      strTmp := Format('%s [' + AInfo + ']...' + #13 + #10,
                 [DateTimeTostr(Now)]);
      Logger.Write(PChar(strTmp)^, Length(strTmp));
    end;
  except
    // Hide Error.
    //FEnabled := false;
  end;
end;

procedure TLogger.Set_Enabled(Value: WordBool);
begin
  FEnabled := Value;
  {
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    if FEnabled then
    begin
      Set_Filename(FFileName);
      try
        FLog := TFileStream.Create(FFileName,
                 fmOpenReadWrite + fmShareDenyWrite);
      except
        FEnabled := false;
      end;
      Log('Logger is Enabled');
    end
    else
      if Assigned(FLog) then
        FreeAndNil(FLog);
  end;   }
end;

procedure TLogger.Set_FileName(const Value: WideString);
begin
  FFileName := Value;
  {
  if FFileName = '' then
  begin
    FFileName := TSystem.ApplicationNameWithPath + '.log';
  end;

  if not FileExists(FFileName) then
  begin
    FLog := TFileStream.Create(FFileName,
                     fmCreate or fmShareDenyWrite);
    FLog.Free;
  end}
end;

procedure TLogger.Set_MaxSize(Value: Integer);
begin
  FSize := Value;
end;

procedure TLogger.FreeResource;
begin
  if Assigned(FLog) then
    FreeAndNil(FLog);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TLogger, Class_Logger,
    ciMultiInstance, tmApartment);
end.