Многопоточность. Ведение логов из каждого потока. Проблемы

[Человек_Борща]

Всем привет, всех с рождеством!

Сабж:
Мая программо под влиянием юзера создаёт n потоков(TThread), из каждого потока юдёт обращение к одному и тому-же лог файлу(Всего 3 файла).

Я сделал вот такой коекакерский класс:

unit THLRLogUnit;

interface
uses Classes, SysUtils;

const
  TimeBlock_Start = '[';
  Timeblock_End = ']';
  Time_Event_Delim = ' | ';
  HLRLog_FileFormat = '%s.log';
  FileName_DateFormat = 'DDMMYY';
  FileName_TimeFormat = 'HH-MM';
  FileNameFormat = 'HLR_(%s).log';
  HLRLog_EventFormat = TimeBlock_Start + '%s' + TimeBlock_End + Time_Event_Delim;
  DateFormat = 'dd.mm.yy';
  TimeFormat = 'hh:mm:ss';

type
  THLRLog = class
    HLRSysLog,
      HLRAppsLog,
      HLRSelfUpdLog: TStringList;
  public
    constructor Create;
    destructor Destroy; override;

    procedure HLR_SystemLog(LogMsg: string);
    procedure HLR_ApplicationsLog(LogMsg: string);
    procedure HLR_UpdatingLog(LogMsg: string);
  end;

implementation

uses GlobalConsts;

{ THLRLog }

constructor THLRLog.Create;
begin
  HLRSysLog := TStringList.Create;
  HLRAppsLog := TStringList.Create;
  HLRSelfUpdLog := TStringList.Create;

  if FileExists(HLR_GetLogsDir(True, False, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)])) then
    HLRSysLog.LoadFromFile(HLR_GetLogsDir(True, False, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
  {System log...}

  if FileExists(HLR_GetLogsDir(False, True, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)])) then
    HLRAppsLog.LoadFromFile(HLR_GetLogsDir(False, True, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
  {Applications log}

  if FileExists(HLR_GetLogsDir(False, False, True) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)])) then
    HLRSelfUpdLog.LoadFromFile(HLR_GetLogsDir(False, False, True) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
  {Self-updating...}
end;

destructor THLRLog.Destroy;
begin
  HLRSysLog.SaveToFile(HLR_GetLogsDir(True, False, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
  HLRSysLog.Free;

  HLRAppsLog.SaveToFile(HLR_GetLogsDir(False, True, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
  HLRAppsLog.Free;

  HLRSelfUpdLog.SaveToFile(HLR_GetLogsDir(False, False, True) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
  HLRSelfUpdLog.Free;
end;

procedure THLRLog.HLR_SystemLog(LogMsg: string);
begin
  HLRSysLog.Add(Format(HLRLog_EventFormat, [FormatDateTime(TimeFormat, Time)]) + LogMsg);
  //HLRSysLog.SaveToFile(HLR_GetLogsDir(True, False, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
end;

procedure THLRLog.HLR_ApplicationsLog(LogMsg: string);
begin
  HLRAppsLog.Add(Format(HLRLog_EventFormat, [FormatDateTime(TimeFormat, Time)]) + LogMsg);
  //HLRAppsLog.SaveToFile(HLR_GetLogsDir(False, True, False) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
end;

procedure THLRLog.HLR_UpdatingLog(LogMsg: string);
begin
  HLRSelfUpdLog.Add(Format(HLRLog_EventFormat, [FormatDateTime(TimeFormat, Time)]) + LogMsg);
  //HLRSelfUpdLog.SaveToFile(HLR_GetLogsDir(False, False, True) + Format(HLRLog_FileFormat, [FormatDateTime(FileName_DateFormat, Date)]));
end;

Проблема его в том, что программа может работать сутки, дни и недели а юзер лога так и не увидит.
Сохранение происходит только при OnDestroy класса.
Далее если программа упала, тоже лога как такового нет.

Ну и самое глвное это I\O Error возникает при одновлеременном вызове SaveToFile(Если сохранять сразу же после add).

Решения тут два:
1. Вести для каждого потока свой лог.
2. Что-то придумать.


Собственно можно ли как-то модернизировать, так чтобы новые записи сразу же добовлялись... и не происходило ошибок I/O?

[veniside]

1) забить на стринлисты, они все-равно будут падать в мпогопочной проге.
2) писать сразу в файл через WinAPI
3) если хочется супер производительности, и надо произвести впечатление на инвесторов, добавить OVERLAPPED.

В результате должен получиться простой и легкочитаемый код, типа такого. ггг

var
  g_logOL: array[byte] of OVERLAPPED;		// array of OL
  g_logOLOffs: int;				// offset of next OL operation
  g_logOLEvents: array[byte] of tHandle;	// array of OL event handles
  g_logOLBufs: array[byte] of pointer;		// array of OL buffers
  g_logOLBufsSz: array[byte] of int;		// array of OL buffer sizes
  g_logOLCount: unsigned;			// number of OLs

// --  --
function incMT(var v: int32; delta: int32): int32;
begin
  result := InterlockedExchangeAdd(@v, delta);
end;

// --  --
function write2file(handle: tHandle; var offset: int32; buf: pointer; len: unsigned): bool;
var
  i: unsigned;
  OL: POVERLAPPED;
  ofs: unsigned;
begin
  result := false;	//
  if ((0 < len) and (nil <> buf)) then begin
    //
    ofs := incMT(offset, len);
    //
    // find non-pending OL
    i := 0;
    if (0 < g_logOLCount) then begin
      //
      i := WaitForMultipleObjects(g_logOLCount, PWOHandleArray(@g_logOLEvents), false, 10);	// do not wait for too long, better create new OL
      if (i < WAIT_OBJECT_0 + g_logOLCount) then
	OL := @g_logOL[i - WAIT_OBJECT_0]
      else
	OL := nil;	// all are busy
    end
    else
      OL := nil;
    //
    if ((nil = OL) and (g_logOLCount <= high(g_logOL) - low(g_logOL))) then begin
      //
      i := low(g_logOL) + incMT(int32(g_logOLCount), 1);
      g_logOLEvents[i] := CreateEvent(nil, false, false, nil);	// auto-reset event
      g_logOL[i].hEvent := g_logOLEvents[i];
      //
      OL := @g_logOL[i];
    end;
    //
    if (nil <> OL) then begin
      //
      if (int(len) > g_logOLBufsSz[i]) then begin
	//
	mrealloc(g_logOLBufs[i], len);
        g_logOLBufsSz[i] := len;
      end;
      //
      move(buf^, g_logOLBufs[i]^, len);
      //
      OL.Offset := ofs;
      OL.OffsetHigh := 0;
      //
      result := WriteFile(handle, g_logOLBufs[i], len, nil, OL);
      if (not result and (ERROR_IO_PENDING = GetLastError())) then
	result := true;	// report no error
    end;
    //
  end;
end;

Код из рабочего проекта, проверен в круглосуточной работе месяцами. Лог виден через ФАР мгновенно после записи. Вам домашнее задание понять, как его использовать )

[Человек_Борща]

какие модули для работы ему нужны? Накидал ошибок и предупреждений=)

[veniside]

ну.. по-идее там особо ничего и не нужно. Типы unsigned и int (int32) это Cardinal и Integer. mrealloc() заменить на reallocMem(). Остальное все описано в модуле Windows.

В принципе, все это можно заменить одним вызовом WriteFile(), если не заморачиваться с OVERLAPPED.