Foros Club Delphi - Crear archivo log

Esta funcion nos permite crear un archivo .log

Código Delphi [-]procedure log(Mensaje: String);
var
  F: TextFile;
  Filename: String;
  SearchRec: TSearchRec;
begin
  // Damos formato al mensaje
  Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
  Filename:= ChangeFileExt(ParamStr(0),'.log');
  if FindFirst(Filename,faArchive,SearchRec) = 0 then
  begin
    // Comprobamos el tamaño de .log
    if SearchRec.Size > (1024*1024) then
      // Y si es mayor de 1 MB lo movemos
      MoveFileEx(PChar(Filename),PChar(Filename + '.1'),
        MOVEFILE_REPLACE_EXISTING);
    FindClose(SearchRec);
  end;
  // Aqui abrimos el archivo si existe, o lo creamos sino existe
  AssignFile(F, Filename);
  {$I-}
    Append(F);
  if IOResult <> 0 then
    Rewrite(F);
  {$I+}
  if IOResult = 0 then
  begin
    // Escribimos el mensaje
    Writeln(F,Mensaje);
    CloseFile(F);
  end;
end;

// Ejemplo de uso
log('Se inicio la aplicacion');

Hay que tener en cuenta que esta función no es "thread-safe", es decir, si nuestra aplicación tiene varios threads y mas de uno intenta usar la función a la vez, la función puede fallar.

Una posible solución es usar TCriticalSection. Para eso tenemos que declarar una variable global del tipo TCriticalSection. La función modificada quedaría así:

Código Delphi [-]var
  CriticalSection: TCriticalSection;

// Esta funcion nos permite guardar mensajes en un .log
procedure log(Mensaje: String);
var
  F: TextFile;
  Filename: String;
  SearchRec: TSearchRec;
begin
  // Damos formato al mensaje
  Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
  Filename:= ChangeFileExt(ParamStr(0),'.log');
  // Comenzamos el bloqueo
  CriticalSection.Enter;
  try
    if FindFirst(Filename,faArchive,SearchRec) = 0 then
    begin
      // Comprobamos el tamaño de .log
      if SearchRec.Size > (1024*1024) then
        // Y si es mayor de 1 MB lo movemos
        MoveFileEx(PChar(Filename),PChar(Filename + '.1'),
          MOVEFILE_REPLACE_EXISTING);
      FindClose(SearchRec);
    end;
    // Aqui abrimos el archivo si existe, o lo creamos sino existe
    AssignFile(F, Filename);
    {$I-}
      Append(F);
    if IOResult <> 0 then
      Rewrite(F);
    {$I+}
    if IOResult = 0 then
    begin
      // Escribimos el mensaje
      Writeln(F,Mensaje);
      CloseFile(F);
    end;
  finally
    // Terminamos el bloqueo
    CriticalSection.Leave;
  end;
end;


// ...


// En la seccion initialization y finalization de la unit
initialization
  CriticalSection:= TCriticalSection.Create;
finalization
  CriticalSection.Free;  
end.

Ahora nuestra función ya es "thread-safe". Pero podemos darle otra vuelta de rosca, y volver a meter todo el código dentro de la función. De esta manera ya no tendremos que preocuparnos de declarar variables globales.

Código Delphi [-]procedure log(Mensaje: String);
var
  F: TextFile;
  Filename: String;
  Mutex: THandle;
  SearchRec: TSearchRec;
begin
  // Damos formato al mensaje
  Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
  Filename:= ChangeFileExt(ParamStr(0),'.log');
  // Comenzamos el bloqueo
  Mutex:= CreateMutex(nil,TRUE,
    PChar(StringReplace(ParamStr(0),'\','/',[rfReplaceAll])));
  WaitForSingleObject(Mutex, INFINITE);
  try
    if FindFirst(Filename,faArchive,SearchRec) = 0 then
    begin
      // Comprobamos el tamaño de .log
      if SearchRec.Size > (1024*1024) then
        // Y si es mayor de 1 MB lo movemos
        MoveFileEx(PChar(Filename),PChar(Filename + '.1'),
          MOVEFILE_REPLACE_EXISTING);
      FindClose(SearchRec);
    end;
    // Aqui abrimos el archivo si existe, o lo creamos sino existe
    AssignFile(F, Filename);
    {$I-}
      Append(F);
    if IOResult <> 0 then
      Rewrite(F);
    {$I+}
    if IOResult = 0 then
    begin
      // Escribimos el mensaje
      Writeln(F,Mensaje);
      CloseFile(F);
    end;
  finally
    ReleaseMutex(Mutex);
    CloseHandle(Mutex);
  end;
end;

Vaya forma de darle vueltas al asunto ... jejeje