Esta funcion nos permite crear un archivo .log
Código Delphi
[-]
procedure log(Mensaje: String);
var
F: TextFile;
Filename: String;
SearchRec: TSearchRec;
begin
Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
Filename:= ChangeFileExt(ParamStr(0),'.log');
if FindFirst(Filename,faArchive,SearchRec) = 0 then
begin
if SearchRec.Size > (1024*1024) then
MoveFileEx(PChar(Filename),PChar(Filename + '.1'),
MOVEFILE_REPLACE_EXISTING);
FindClose(SearchRec);
end;
AssignFile(F, Filename);
{$I-}
Append(F);
if IOResult <> 0 then
Rewrite(F);
{$I+}
if IOResult = 0 then
begin
Writeln(F,Mensaje);
CloseFile(F);
end;
end;
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;
procedure log(Mensaje: String);
var
F: TextFile;
Filename: String;
SearchRec: TSearchRec;
begin
Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
Filename:= ChangeFileExt(ParamStr(0),'.log');
CriticalSection.Enter;
try
if FindFirst(Filename,faArchive,SearchRec) = 0 then
begin
if SearchRec.Size > (1024*1024) then
MoveFileEx(PChar(Filename),PChar(Filename + '.1'),
MOVEFILE_REPLACE_EXISTING);
FindClose(SearchRec);
end;
AssignFile(F, Filename);
{$I-}
Append(F);
if IOResult <> 0 then
Rewrite(F);
{$I+}
if IOResult = 0 then
begin
Writeln(F,Mensaje);
CloseFile(F);
end;
finally
CriticalSection.Leave;
end;
end;
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
Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
Filename:= ChangeFileExt(ParamStr(0),'.log');
Mutex:= CreateMutex(nil,TRUE,
PChar(StringReplace(ParamStr(0),'\','/',[rfReplaceAll])));
WaitForSingleObject(Mutex, INFINITE);
try
if FindFirst(Filename,faArchive,SearchRec) = 0 then
begin
if SearchRec.Size > (1024*1024) then
MoveFileEx(PChar(Filename),PChar(Filename + '.1'),
MOVEFILE_REPLACE_EXISTING);
FindClose(SearchRec);
end;
AssignFile(F, Filename);
{$I-}
Append(F);
if IOResult <> 0 then
Rewrite(F);
{$I+}
if IOResult = 0 then
begin
Writeln(F,Mensaje);
CloseFile(F);
end;
finally
ReleaseMutex(Mutex);
CloseHandle(Mutex);
end;
end;
Vaya forma de darle vueltas al asunto ... jejeje