Tengo una pequeña funcion para guardar mensajes de log en un archivo (la misma que publique en la seccion de trucos). La funcion funciona muy bien, y nunca me habia dado problemas hasta ahora
El problema aparece cuando se crean varios threads y desde todos ellos se llama a la funcion. Al principio parece que aguanta bien, ya la he usado en varios programas con threads sin problemas, pero cuando se hace un uso muy intensivo de la misma a veces falla. Cuando falla, la funcion WaitForSingleObject se queda esperando indefinidamente, bloqueando asi el thread que llamo la funcion.
El codigo es el siguiente (abajo pongo un ejemplo en un zip)
Código Delphi
[-]
unit ULog;
interface
uses Windows, Sysutils, dialogs;
procedure log(Archivo, Mensaje: String); overload;
procedure log(Mensaje: String); overload;
implementation
var
LogFile: String;
Mutex: THandle;
procedure log(Archivo, Mensaje: String); overload;
var
F: TextFile;
SearchRec: TSearchRec;
Str: String;
begin
if Mutex <> 0 then
begin
WaitForSingleObject(Mutex, INFINITE);
try
if FindFirst(Archivo,faAnyFile,SearchRec) = 0 then
begin
if SearchRec.Size > (1024*1024) then
begin
Str:= IncludeTrailingPathDelimiter(ExtractFilePath(Archivo))
+ 'Historico\';
ForceDirectories(Str);
MoveFileEx(PChar(Archivo),PChar(Str + FormatDateTime('yyyymmdd',Now)
+ '.log'), MOVEFILE_REPLACE_EXISTING);
end;
FindClose(SearchRec);
end;
try
AssignFile(F, Archivo);
{$I-}
Append(F);
if IOResult <> 0 then
Rewrite(F);
{$I+}
if IOResult = 0 then
begin
Writeln(F,Mensaje);
CloseFile(F);
end;
except
end;
finally
ReleaseMutex(Mutex);
end;
end;
end;
procedure log(Mensaje: String); overload;
begin
try
Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
log(LogFile,Mensaje);
except
end;
end;
initialization
LogFile:= ChangeFileExt(ParamStr(0),'.log');
Mutex:= CreateMutex(nil,TRUE,
PChar(StringReplace(LogFile,'\','/',[rfReplaceAll])));
finalization
CloseHandle(Mutex);
end.
Y para probar la funcion utilizo el siguiente codigo:
Código Delphi
[-]
program logtest;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Messages,
Classes,
ULog in 'ULog.pas';
type
TTestThread = class(TThread)
protected
procedure Execute; override;
end;
var
ThreadCount: Integer;
procedure TTestThread.Execute;
var
i: Integer;
begin
InterlockedIncrement(ThreadCount);
for i:= 0 to 10 do
begin
log(Format('[%d] %d',[Handle,i]));
Sleep(10);
end;
InterlockedDecrement(ThreadCount);
end;
var
j,k: Integer;
begin
j:= 0;
ThreadCount:= 0;
while TRUE do
begin
if ThreadCount = 0 then
begin
for k:= 1 to 5 do
begin
inc(j);
Writeln(Format('Creado un nuevo Thread: %d',[j]));
TTestThread.Create(FALSE).FreeOnTerminate:= TRUE;
end;
end else;
Sleep(10);
end;
end.
No se que puede estar fallando, hasta utilizo un bloque "try ... finally" para asegurarme de que se libera el mutex, pero aun asi nada
¿Alguien puede ver lo que se me escapa? El problema se podria solucionar cambiando el parametro INFINITE por un tiempo mas pequeño, pero ademas de que eso seria una chapuza, se perderian mensajes.