{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}

{$MINSTACKSIZE $00004000}

{$MAXSTACKSIZE $00100000}

{$IMAGEBASE $00400000}

{$APPTYPE GUI}

unit ExeLogu; {logfrm}

interface
uses Classes, SysUtils{v0.39}, WinUtl, PropUtl{/v0.39}{v0.43},UtlType{/v0.43}
  {v0.44}, MMSystem{/v0.44}
  ;

{v0.39}
const
  LogExt = '.LOG';
  DefLogDir = 'LOG';
{/v0.39}
{v0.43}
  LogSection = 'LOG';{for INI file}
{/v0.43}
type
  TExeLogLog = procedure(const msg:string) of object;

  TLogEvents = (
    leInfo,   { default event, information about anything happening, used if Log() method used }
    leAction, { some important not very often occuring program process started/ended }
    leDebug,  { debugging purposes }
    leUserWarning, { user tried to do something what he should not, gui window appeared }
    leUserInfo,    { user is informed that some action started, is going on or ended,
                     gui window appeared}
    leUserConfirm,  { user is aked to do some decision, gui window appeared }
    leWarning,     { some expectable problem arised (disk full,...) }
    leError,       { some real program error occurred (unexpected, that should not happen) }
    leFatalError   { real disaster happened }
  );

  TLogEvent = set of TLogEvents;

  TExeLog = class(TComponent)
  private
    FLogDir: string;
      { Directory for log files (if not absolute path, then relative to exedir
        is considered), default = LOG. Used if FFileName does not contain absolute
        path }
    {v0.39}
    FDefExt: string;
      { Appended if AFileName has no extension. = .LOG }
    {/v0.39}
    FFileName: string;
      { Name of the log file. If none specified then ExeName.Log is used.
        If does not contain absolute path then placed to FLogDir. }{logu}
    FText: text;
      { the text file handle }
    FActive: boolean;
      { is the log file opened }
    FAutoOpen: boolean;
      { should the log file be opened upon program start? }
    FOverWrite: boolean;
      { should erase eventually existing log file upon opening? }
    FLogEvent: TLogEvent;
      { last log event logged }
    FAutoFlushInterval: integer;
      { how often the log should be flushed to disk (in seconds), not
        flushed at all if = 0 (flushing can take place only during Log call),
        if = 1, then flushed every log call (useful for debug crash) }
    FLastFlushTime: TDateTime;
      { last time when the file was flushed to disk }
    FOnLog: TExeLogLog;
    {v0.26}
    FAssigningOnLog: boolean;
    {/v0.26}
    {v0.39}
    FLogToSysLog: boolean;
      { Log not only to itself, but also to program's main log file?
        (if self is not the main log file) }
    {/v0.39}
    {v0.44}
    FNoHead: boolean;
    FNoFoot: boolean;
    FDateTimeInLine: TDateTimeParts;
    function GetDateTimeSec: string;
    {/v0.44}
  protected
    procedure SetActive(OnOff:boolean);
    procedure SetFileName(const AFileName: string);
    {v0.26}
    procedure SetOnLog(AExeLogLog: TExeLogLog);
    {/v0.26}
    {v0.39}
    procedure SetLogDir(const ADir: string);
    {/v0.39}
  public
    constructor Create(AOwner: TComponent; const AFileName: string);reintroduce;
      { if AFileName = '' then ExeName.LOG will be used; Created not Active!!! }
    destructor Destroy;override;
    procedure Log(const Msg: string);
    {v0.39}
    procedure LogErr(const Msg: string);
    {/v0.39}
    procedure LogEvent(ALogEvent: TLogEvent; const Msg: string);

    property Active: boolean read FActive write SetActive;
    property AutoOpen: boolean read FAutoOpen write FAutoOpen;
    property FileName: string read FFileName write SetFileName;
    {v0.39 moved to published}{/v0.39
    property OverWrite: boolean read FOverWrite write FOverWrite;}
    {v0.42}
    {/v0.42
    property AutoFlushInterval: integer read FAutoFlushInterval write FAutoFlushInterval;}
    property OnLog: TExeLogLog read FOnLog write {v0.26}SetOnLog{/v0.26 FOnLog};
    property LogDir: string read FLogDir write SetLogDir;
  {v0.39}
  published
    property LogToSysLog: boolean read FLogToSysLog write FLogToSysLog;
    property OverWrite: boolean read FOverWrite write FOverWrite;
  {/v0.39}
  {v0.42}
    property AutoFlushInterval: integer read FAutoFlushInterval write FAutoFlushInterval;
  {/v0.42}
  {v0.44}
    property NoHead: boolean read FNoHead write FNoHead;
    property NoFoot: boolean read FNoFoot write FNoFoot;
    property DateTimeInLine: TDateTimeParts read FDateTimeInLine write FDateTimeInLine;
  {/v0.44}
  end;

const
  ExeLog: TExeLog = nil;

{v0.40}
procedure DebLog(const msg: string);
{/v0.40}


implementation

{v0.43}
const
  UseDebugLog: boolean = false;
  FDebLog: TExeLog = nil;
{/v0.43}

procedure TExeLog.SetActive(OnOff:boolean);
begin
  if OnOff <> FActive then begin
    if OnOff then begin
      AssignFile(FText, FFileName);
      if FileExists(FFileName) then begin
        if FOverWrite then
          Rewrite(FText)
        else
          Append(FText);
      end else begin
        Rewrite(FText);
      end;
      {v0.44}
      if not FNoHead then
      {/v0.44}
      begin
        Writeln(FText, '');
        Writeln(FText, '*** Log Started ' + FormatDateTime('',Now) + ' ***');
        Writeln(FText, '');
      end;
    end else begin
      {v0.44}
      if not FNoFoot then
      {/v0.44}
      begin
        Writeln(FText, '');
        Writeln(FText, '*** Log Stopped ' + FormatDateTime('',Now) + ' ***');
        Writeln(FText, '');
      end;
      CloseFile(FText);
    end;
    FActive := OnOff;
  end;
end;

procedure TExeLog.SetFileName(const AFileName: string);
var wasa:boolean;
begin
  if AFileName = '' then
    exit;
  if AFileName <> FFileName then begin
    {v0.39}
    if ExtractFileExt(AFileName) = '' then
      FFileName := ChangeFileExt(AFileName, FDefExt)
    else
      FFileName := AFileName;
    if ExtractFilePath(FFileName) = '' then
      FFileName := FLogDir + FFileName;
    {/v0.39}
    wasa := Active;
    if wasa then
      Active := false;
    FFileName := ExpandFileName({v0.39}FFileName{/v0.39 AFileName});
    if wasa then
      Active := true;
  end;
end;

{v0.39}
procedure TExeLog.SetLogDir(const ADir: string);
var d: string;
begin
  if ADir = '' then begin
    d := ExtractFilePath(paramstr(0)) + DefLogDir;
  end else begin
    if ExtractFilePath(ADir) = '' then begin
      d := ExtractFilePath(paramstr(0)) + ADir;
    end else begin
      d := ADir;
    end;
  end;
  d := AddBackSlash(d);
  if {winutl}CheckDirExists(d) then
   FLogDir := d;
end;
{/v0.39}

{v0.39}
function GetSecName(const AFileName: string): string;
begin
  if AFileName = '' then
    Result := paramstr(0)
  else
    Result := AFileName;
  Result := ChangeFileExt(ExtractFileName(Result), '') + 'Log';
end;
{/v0.39}

constructor TExeLog.Create(AOwner: TComponent; const AFileName: string);
begin
  inherited Create(AOwner);
  {v0.39}
  FDefExt := LogExt;
  LogDir := '';
  if Name = '' then
    Name := GetSecName(AFileName);
  ClassReadWriteIniFile(Self, 2, '', true);
  {/v0.39}
  if AFileName = '' then begin
    SetFileName(ChangeFileExt(paramstr(0), FDefExt));
  end {v0.39} else begin
    SetFileName(AFileName);
  end{/v0.39};
end;

destructor TExeLog.Destroy;
begin
  Active := false;
  ClassReadWriteIniFile(Self, 2, '', false);
  inherited Destroy;
end;

procedure TExeLog.Log(const Msg: string);
begin
  if not Active then
    exit;
  LogEvent([leInfo], Msg);
end;

procedure TExeLog.LogErr(const Msg: string);
begin
  if not Active then
    exit;
  LogEvent([leError], Msg);
end;

procedure TExeLog.SetOnLog(AExeLogLog: TExeLogLog);
begin
{  if AExeLogLog <> FOnLog then
    exit;}
  fAssigningOnLog := true;
  try
    FOnLog := AExeLogLog;
  finally
    fAssigningOnLog := false;
  end;
end;

{v0.44}
function TExeLog.GetDateTimeSec: string;
var
  i: TDateTimePart;
  d: TDateTime;
  dt: array[TDateTimePart] of word;

  function IntToString(i:integer; len:integer):string;
  begin
    str(i, result);
    while length(result) < len do
      result := '0' + result;
  end;

begin
  Result := '';
  if DateTimeInLine <> [] then begin
    d := Now;
    DecodeDate(d, dt[dtYear], dt[dtMonth], dt[dtDay]);
    DecodeTime(d, dt[dtHour], dt[dtMinute], dt[dtSecond], dt[dtMilisecond]);
    for i := high(TDateTimePart) downto low(TDateTimePart) do begin
      if i in DateTimeInLine then begin
        case i of
          dtYear: Result := Result + IntToStr(dt[i]) + '-';
          dtMonth, dtDay: Result := Result + IntToString(dt[i],2) + '-';
          {dtDay: Result := Result := IntToString(dt[i],2) + '-';}
          dtHour,dtMinute: Result := Result + IntToString(dt[i],2) + ':';
          dtSecond: Result := Result + IntToString(dt[i],2);
          dtMilisecond: Result := Result + '.' + IntToString((TimeGetTime mod 1000){dt[i]},3);
        end;
      end;
    end;
    Result := Result + ' ';
  end;
end;
{/v0.44}
procedure TExeLog.LogEvent(ALogEvent: TLogEvent; const Msg: string);
{v0.39}
var s: string;
{/v0.39}
begin
  if not Active then
    exit;
  FLogEvent := ALogEvent;
  {v0.39}
  s := Msg;
  if (leError in FLogEvent) then
    s := 'ERR: ' + Msg;
  {/v0.39}
  {v0.44}
  s := GetDateTimeSec + s;
  {v0.54}
  IoResult;
  {/v0.54}
  Writeln(FText, {v0.39}s {/v0.39 Msg});
  if {v0.26} (not FAssigningOnLog) and {v0.26} Assigned(FOnLog) then
    FOnLog({v0.39} s {/v0.39 Msg});
  {v0.39}
  if FLogToSysLog and (Self <> ExeLog) and (ExeLog <> nil) {v0.43} and (Self <> FDebLog){/v0.43} then
    ExeLog.LogEvent(ALogEvent, {v0.39} s{/v0.39 Msg});
  {/v0.39}
  {v0.43}
  if UseDebugLog and (Self <> FDebLog) then
    DebLog(s);
  {/v0.43}
  if FAutoFlushInterval <> 0 then begin
    if {v0.42}
       (FAutoFlushInterval = 1) or
       {/v0.42}
      ((Now - FLastFlushTime) * 24 * 3600 > FAutoFlushInterval) then
    begin
      Flush(FText);
      FLastFlushTime := Now;
    end;
  end;
end;


{v0.40}
{v0.43}{/v0.43 const
  FDebLog: TExeLog = nil;}

procedure DebLog(const msg: string);
begin
  if not UseDebugLog then
    exit;
  if FDebLog = nil then begin
    FDebLog := TExeLog.Create(nil, 'DebLog');
    FDebLog.Active := true;
  end;
  FDebLog.Log(msg);
end;
{/v0.40}

initialization
  ExeLog := TExeLog.Create(nil, '');
  {ExeLog.OverWrite := true;}
  ExeLog.Active := true;
  {v0.43}
  ConfigReadWriteValue(nil, rwRead, LogSection, 'UseDebugLog' , @UseDebugLog, ptByte);
  {/v0.43}
finalization
  ExeLog.Free;
  {v0.40}
  FDebLog.Free;
  {/v0.40}
  {v0.43}
  ConfigReadWriteValue(nil, rwWrite, LogSection, 'UseDebugLog' , @UseDebugLog, ptByte);
  {/v0.43}
end.
