procedure TfrmProt.Add2Prot(const AStr: String);
var
  prtData: TDaPrtData;
begin
  FillChar(prtData, SizeOf(prtData), #0); //INITIALISIEREN DES RECORDS
  prtData.Msg := AStr; //LOG-TEXT ZUWEISEN
  TLog.Add(prtData); //prtData VAR ÜBERGEBEN...
end;

type//DAS IST DER RECORD DER DANN NICHT MEHR "GÜLTIG IST" orso...
  TDaPrtData = record
    Typ: TDaPrtMsgType;
    Msg: String;
    Cls: ShortString;
    Code: Integer;
    SQL: String;
    Details: String;
    DoId: Integer;
    ConfigId: Integer;
  end;

//This is based on the example found in the indy newsgroup
  TLog = class(TIdSync)
  protected
    FPrtData: TDaPrtData;
    procedure DoSynchronize; override;
    constructor Create(const APrtData: TDaPrtData);
  public
    class procedure Add(const APrtData: TDaPrtData); overload;
  end;




//---------------------------------------------------//
//------------------------ TLog ---------------------//

constructor TLog.Create(const APrtData: TDaPrtData);
begin
  FPrtData := APrtData; //SOLLTE DOCH AUSREICHEN, ODER? VARS WERDEN
  inherited Create; //DOCH BEI DER ZUWEISEUNG KOPIERT, ODER NICHT?
end;

procedure TLog.DoSynchronize;
var
  lFileStream: TFileStream;
  lMode: Word;
  lString: String;

  procedure TruncateStream;
  var
    Buffer: TMemoryStream;
    c, n1, n2, Len: Int64;
  begin
    Buffer := TMemoryStream.Create;
    try
      Buffer.Size := konPrtLowFileSize;
      lFileStream.Position := lFileStream.Position - konPrtLowFileSize;
      Len := Buffer.CopyFrom(lFileStream, konPrtLowFileSize);
      Buffer.Position := 0;
      lFileStream.Position := 0;
//TODO 1: Alternative. Works but sure slow??
      lFileStream.Size := 0;
      lFileStream.Size := konPrtLowFileSize;

      lFileStream.Position := 0;
      lFileStream.CopyFrom(Buffer, Len);
      QueryPerformanceCounter(n2);
      OutputDebugString(PChar(FloatToStr(n2-n1/c, formatSet)));
    finally
      Buffer.Free;
    end;
  end;

  procedure LogToScreen;
  begin
    try
      frmProt.memLog.Lines.BeginUpdate;
      if frmProt.memLog.Lines.Count > frmProt.PrtOptions.PrtSize then begin
        while frmProt.memLog.Lines.Count > frmProt.PrtOptions.PrtSize-50 do//Cut off 50 Lines
          frmProt.memLog.Lines.Delete(0);
        frmProt.memLog.Lines.Add('$$$'+konPrtColDel+DateTimeToStr(Now, formatSet)+'LOG TRUNCATE'+konPrtLineDel);
      end;
      frmProt.memLog.Lines.Add(lString);
// if True{Optionen_Form.miscAutoScrollLog }then begin
        frmProt.memLog.Perform(EM_LINESCROLL, 0, frmProt.memLog.Lines.Count);
// end;
      frmProt.memLog.Lines.EndUpdate;
    except
      frmProt.PrtOptions.AbledPrtModes := frmProt.PrtOptions.AbledPrtModes -
        [pmScreen];
    end;
  end;//procedure LogToScreen

  procedure LogToFile;
  begin
    try
      if FileExists(frmProt.PrtOptions.PrtFileName) then
        lMode := fmOpenReadWrite or fmShareDenyWrite
      else
        lMode := fmCreate;
      lFileStream := TFileStream.Create(frmProt.PrtOptions.PrtFileName, lMode);
      try
        if lMode <> fmCreate then
          lFileStream.Seek(0, soFromEnd);
        lFileStream.Write(LString[1], Length(lString));
        lFileStream.Write(sLineBreak, Length(sLineBreak)); // <-- sLineBreak is defined by VCL
        if lFileStream.Size > konPrtHighFileSize then begin
          TruncateStream;
        end;
      finally
        lFileStream.Free;
      end;
    except
      frmProt.PrtOptions.AbledPrtModes := frmProt.PrtOptions.AbledPrtModes -
        [pmFile];
    end
  end;//procedure LogToFile
begin
  lString := '';
  try //DIE TRY-EXCEPTS DIENTEN DER FEHLERSUCHE. UNTER UNBEKANNTEN
      //UMSTÄNDEN KOMMEN HIER BEIM ZUGRIFF AUF FPrtData AVs!
      //(VLLT WENN TLog.Add() VON 2 THREAD GLEICHZEITIG AUFGERUFEN WIRD?)
    case FPrtData.Typ of
      pmtInformation: lString := '###' + konPrtColDel;
      pmtConfirmation: lString := '???' + konPrtColDel;
      pmtWarning: lString := 'x!x' + konPrtColDel;
      pmtError: lString := 'XXX' + konPrtColDel;
    end;
  except
    on e:exception do begin
      MessageBeep(MB_ICONERROR);
      ShowMessage(e.Message+#13#10+e.ClassName);
    end;
  end;
                       //Using a formatSetting var it is thread save.
  try
    lString := lString + DateTimeToStr(Now, formatSet) + konPrtColDel +
      FPrtData.Msg + konPrtColDel + FPrtData.Cls + konPrtColDel + FPrtData.SQL + konPrtColDel +
      FPrtData.Details + konPrtColDel + IntToStr(FPrtData.DoId) + konPrtColDel +
      IntToStr(FPrtData.ConfigId) +
      konPrtLineDel;//2006_01_29 We need a Line-Delimiter cause of multiline prt entries!
  except
    on e:exception do begin
      MessageBeep(MB_ICONERROR);
      ShowMessage(e.Message+#13#10+e.ClassName);
    end;
  end;

  try
    case frmProt.PrtOptions.PrtUsage of
      cbChecked: begin
        if pmScreen in frmProt.PrtOptions.AbledPrtModes then
  // LogToScreen; //REMED OUT FORM DEBUGGING PURPOSES
        if pmFile in frmProt.PrtOptions.AbledPrtModes then
  // LogToFile; //REMED OUT FORM DEBUGGING PURPOSES
      end;
      cbGrayed: begin
        if pmScreen in frmProt.PrtOptions.AbledPrtModes then
  // LogToScreen; //REMED OUT FORM DEBUGGING PURPOSES
      end;
      cbUnchecked:;//nothing
    end;//case cbUseProt.State
  except
    on e:exception do begin
      MessageBeep(MB_ICONERROR);
      ShowMessage(e.Message+#13#10+e.ClassName);
    end;
  end;
end;

class procedure TLog.Add(const APrtData: TDaPrtData);
begin
  with TLog.Create(APrtData) do try
    Synchronize;
  finally
    Free;
  end;
end;

class procedure TLog.Add(const AStr: String);
var
  LPrtData: TDaPrtData;
begin
  FillChar(LPrtData, SizeOf(LPrtData), #0);
  LPrtData.Msg := AStr;
  with TLog.Create(LPrtData) do try
    Synchronize;
  finally
    Free;
  end;
end;

//------------------------ TLog ---------------------//
//---------------------------------------------------//