unit ULogger;

interface

uses classes,SyncObjs, {Xlib,} SysUtils, {Libc,} IdGlobal;

type
  TMessagerecord = record
    filenameToWrite : string;
    milliseconds : cardinal;
    Amessage : string;
    AParameter : string;
  end;

  PMessagerecord = ^TMessagerecord;

  TLogger = class;

  TLogList = class(TList)
    private
      flogger : TLogger;
    protected
      function Get(Index: Integer): PMessagerecord;
      procedure Put(Index: Integer; Item: PMessagerecord);
    public
      constructor create(ALogger : TLogger); reintroduce;
      property Items[Index: Integer]: PMessagerecord read Get write Put; default;
  end;

  TLogger = class(TThread)
    private
      fBaseDirectory: string;
      fDeafultFileName: string;
      fCriticalSection : TCriticalSection;
      fLogList : TLogList;
      terminating : boolean;
      fBlockCriticalSection : TCriticalSection;
      FBlocked : boolean;
      procedure SetBaseDirectory(const Value: string);
      procedure LogInFile (AmessageRecord : PMessageRecord);
      procedure SetDeafultFileName(const Value: string);
    protected
    public
      constructor create(Blocking:Boolean;createsuspended:boolean; ABaseDirectory, ADefaultFileName : string); reintroduce;
      destructor destroy; override;
      procedure execute; override;
      procedure LogMessage(generalMessage : string); overload;
      procedure LogMessage(AThreadID:Integer ;AMessage : string); overload;
      procedure LogMessage(AParameter:string ;AMessage : string); overload;
      procedure LogMessage(AParameter:string ;AMessage : string; milliseconds : cardinal); overload;
      property BaseDirectory : string read fBaseDirectory write SetBaseDirectory;
      property DeafultFileName : string read fDeafultFileName write SetDeafultFileName;
  end;

implementation

{ TLogger }

constructor TLogger.create(Blocking:Boolean;createsuspended:boolean; ABaseDirectory, ADefaultFileName : string);
begin
  inherited create (true);
  FBlocked := Blocking;
  if FBlocked then
    fBlockCriticalSection := TCriticalSection.Create;
  terminating := false;
  fCriticalSection := TCriticalSection.Create;
  fLogList := TLogList.Create(self);
  if ABaseDirectory <> '' then
    BaseDirectory := ABaseDirectory
  else
    BaseDirectory := ExtractFilePath(ParamStr(0));
  fDeafultFileName := ADefaultFileName;
  if not createsuspended  then
    resume;
end;

procedure TLogger.LogMessage(generalMessage: string);
var temp : pmessagerecord;
begin
  if FBlocked then
    fBlockCriticalSection.Enter;
  new(temp);
  temp.Amessage := generalMessage;
  temp.filenameToWrite := BaseDirectory + DeafultFileName;
  temp.milliseconds := GetTickCount;
  fLogList.Add(temp);
  if FBlocked then
    fBlockCriticalSection.Leave;
end;

procedure TLogger.LogMessage(AThreadID: Integer; AMessage: string);
var temp : pmessagerecord;
begin
  if FBlocked then
    fBlockCriticalSection.Enter;
  new(temp);
  temp.Amessage := AMessage;
  temp.filenameToWrite := BaseDirectory + inttostr(athreadID);
  temp.milliseconds := gettickcount;
  temp.AParameter := inttostr(athreadID);
  fLogList.Add(temp);
  if FBlocked then
    fBlockCriticalSection.Leave;
end;

procedure TLogger.LogMessage(AParameter, AMessage: string);
var temp : pmessagerecord;
begin
  if FBlocked then
    fBlockCriticalSection.Enter;
  new(temp);
  temp.Amessage := AMessage;
  temp.filenameToWrite := BaseDirectory + AParameter;
  temp.milliseconds := GetTickCount;
  temp.AParameter := AParameter;
  fLogList.Add(temp);
  if FBlocked then
    fBlockCriticalSection.Leave;
end;
                    
procedure TLogger.LogInFile(AmessageRecord : PMessageRecord);
var f:textfile;
begin
  if FBlocked then
    fBlockCriticalSection.Enter;
  forcedirectories(extractfiledir(AmessageRecord.filenameToWrite));
  assignfile(f,AmessageRecord.filenameToWrite);
  if FileExists(AmessageRecord.filenameToWrite) then
    append(f)
  else
    rewrite (f);
  writeln (f,inttostr(AmessageRecord.milliseconds)+#9+
             AmessageRecord.AParameter+#9+
             AmessageRecord.Amessage+' - '+inttostr(threadid));
  closefile(f);
  if AmessageRecord.filenameToWrite <> BaseDirectory+fDeafultFileName then
    begin //  standard log
      assignfile(f,BaseDirectory+fDeafultFileName);
      if FileExists(BaseDirectory+fDeafultFileName) then
        append(f)
      else
        rewrite (f);
      writeln (f,inttostr(AmessageRecord.milliseconds)+#9+
                 AmessageRecord.AParameter+#9+
                 AmessageRecord.Amessage+' - '+inttostr(threadid));
      closefile(f);
    end;
  if FBlocked then
    fBlockCriticalSection.Leave;
end;

procedure TLogger.LogMessage(AParameter, AMessage: string;
  milliseconds: cardinal);
var temp : pmessagerecord;
begin
  if FBlocked then
    fBlockCriticalSection.Enter;
  new(temp);
  temp.Amessage := AMessage;
  temp.filenameToWrite := BaseDirectory + AParameter;
  temp.milliseconds := milliseconds;
  temp.AParameter := AParameter;
  fLogList.Add(temp);
  if FBlocked then
    fBlockCriticalSection.Leave;
end;

procedure TLogger.SetBaseDirectory(const Value: string);
begin
  if value <> fBaseDirectory then
    begin
      fCriticalSection.Enter;
      fBaseDirectory := value;
      if fBaseDirectory[length(fBaseDirectory)]<>'/' then
        fBaseDirectory := fBaseDirectory + '/';
      fCriticalSection.Leave;
    end;
end;

destructor TLogger.destroy;
var i:integer;
begin
  if FBlocked then
    fBlockCriticalSection.Free;
  fCriticalSection.Enter;
  for i:= fLogList.Count -1 downto 0 do
    dispose(fLogList.Items[i]);
  fCriticalSection.Leave;
  fLogList.Free;
  fCriticalSection.Free;
  Terminate;
  while not terminating do
    sleep(5);
  inherited;
end;

procedure TLogger.SetDeafultFileName(const Value: string);
begin
  if fDeafultFileName <> Value then
    begin
      fCriticalSection.Enter;
      fDeafultFileName := Value;
      fCriticalSection.Leave;
    end;
end;

procedure TLogger.execute;
var i:integer;
begin
  inherited;
  while not terminated do
    begin
      if fLogList.Count > 0 then
        begin
          fCriticalSection.Enter;
          for i:= 0 to fLogList.Count -1 do
            LogInFile(fLogList.Items[i]);
          for i:= fLogList.Count -1 downto 0 do
            dispose(fLogList.Items[i]);
          fLogList.Clear;
          fCriticalSection.Leave;
        end;
      sleep(15);
    end;
  terminating := true;
end;

{ TLogList }

constructor TLogList.create(ALogger: TLogger);
begin
  flogger := ALogger;
end;

function TLogList.Get(Index: Integer): PMessagerecord;
begin
  result := PMessagerecord(inherited get(index));
end;

procedure TLogList.Put(Index: Integer; Item: PMessagerecord);
begin
  flogger.fCriticalSection.Enter;
  inherited put(index,item);
  flogger.fCriticalSection.Leave;
end;

end.