{-----------------------------------------------------------------------------
   Unit Name: KErrHeader
   Purpose  : To return ErrorHeader for log files.
              Format:
   Author   : Vesa Lappalainen
   Date     : 19.1.2002
   Changed  :
   Todo     :
-----------------------------------------------------------------------------}

unit KErrHeader;

interface

type
  TErrHeader = function:string;

  TLogFile = class
  private
    FFileName : string;
    FNoLogSave : boolean;
    f:Text;
    FErrHeader: TErrHeader;
    FCreateOnFirstWrite : boolean;
    function CreateFile : boolean;
  public
    constructor Create(const s:string);
    procedure Add(const s:string); virtual;
    property NoLogSave:boolean read FNoLogSave;
    property ErrHeader : TErrHeader read FErrHeader write FErrHeader;
  end;

function GetErrHeader:string;
procedure SaveToLogString(const s:string);
procedure ChangeInternalHeader(f:TErrHeader);


implementation

uses SysUtils,kdouble,kstring,dialogs;

const tab=#9;

var InternalLog : TLogFile;
    ErrHeaderFunc : TErrHeader;

function GetErrHeader:string;
begin
  if ( Assigned(ErrHeaderFunc) ) then Result := ErrHeaderFunc
  else Result := NowToStr + ' ';
end;

procedure SaveToLogString(const s:string);
begin
  InternalLog.Add(s);
end;


{ TLogFile }


procedure TLogFile.Add(const s: string);
var eh:string;
    logopen:boolean;
begin
  logopen := false;

  if ( Assigned(ErrHeader) ) then eh := ErrHeader + tab else eh := '';
//  while true do begin i := Pos(#09,eh); if i = 0 then break; eh[i] := ' '; end;

  try
  try
    if IoResult <> 0 then;
    if ( FCreateOnFirstWrite ) then if ( not CreateFile ) then exit;
    Append(F);
    logopen := true;
    Writeln(f, eh + s);
    FNoLogSave := False;
  except
    if ( not NoLogSave ) then
      ShowMessage(('Can''t write log file')+' '+ FFileName +'!');
    FNoLogSave := True;
  end;
  finally
    if ( logopen ) then CloseFile(F);
    if IoResult <> 0 then;
  end;
end;

constructor TLogFile.Create(const s: string);
begin
  FFileName := s;
  AssignFile(F, FFileName);
  FErrHeader := GetErrHeader;
  FCreateOnFirstWrite := Not FileExists(FFileName);
end;

function TLogFile.CreateFile: boolean;
begin
  Result := true;
  if ( Not FileExists(FFileName) ) then begin
    try
      Rewrite(f);
      CloseFile(f);
    except
      FNoLogSave := True;
      Result := false;
    end;
  end;
  FCreateOnFirstWrite := false;
end;

procedure ChangeInternalHeader(f:TErrHeader);
begin
  InternalLog.ErrHeader := f;
  ErrHeaderFunc := f;
end;

initialization begin
  InternalLog := TlogFile.Create(GetCurrentDir + '\log.txt');
  ErrHeaderFunc := nil;
end;

finalization begin
  InternalLog.Free;
end;

end.
