05a5e2c6a2
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@639 8e941d3f-bd1b-0410-a28a-d453659cc2b4
135 lines
2.9 KiB
ObjectPascal
135 lines
2.9 KiB
ObjectPascal
unit uDebug;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, db;
|
|
|
|
type
|
|
ILogger = interface
|
|
procedure Log(const S:string);overload;
|
|
procedure Log(const S:string; const Fmt:array of const);overload;
|
|
|
|
procedure LogException(E:Exception);
|
|
Procedure ExceptionHandler(Sender : TObject; E : Exception);
|
|
procedure LogDatasetFieldNames(const DatasetName:string; D:TDataset);
|
|
end;
|
|
|
|
function GlobalLogger:ILogger;
|
|
implementation
|
|
uses uConfig, functions_file, Forms;
|
|
|
|
var Logger:ILogger;
|
|
|
|
type
|
|
|
|
{ TLogger }
|
|
|
|
TLogger = class(TInterfacedObject, ILogger)
|
|
private
|
|
//F:TFileStream;
|
|
F:TextFile;
|
|
ExceptionCaught:boolean;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy;override;
|
|
|
|
procedure Log(const S:string);overload;
|
|
procedure Log(const S:string; const Fmt:array of const);overload;
|
|
|
|
procedure LogException(E:Exception);
|
|
Procedure ExceptionHandler(Sender : TObject; E : Exception);
|
|
procedure LogDatasetFieldNames(const DatasetName:string; D:TDataset);
|
|
end;
|
|
|
|
{ TLogger }
|
|
|
|
constructor TLogger.Create;
|
|
begin
|
|
inherited;
|
|
|
|
ExceptionCaught:=false;
|
|
//F:=TFileStream.Create( GlobalConfig.DebugLogFile, fmCreate or fmOpenWrite );
|
|
AssignFile(F, GlobalConfig.DebugLogFile);
|
|
Rewrite(F);
|
|
end;
|
|
|
|
destructor TLogger.Destroy;
|
|
var D, DLog:String;
|
|
begin
|
|
//F.Free;
|
|
CloseFile(F);
|
|
if ExceptionCaught then
|
|
try
|
|
//сохраняем в отдельной папке логов
|
|
D:=GlobalConfig.DebugLogDirectory;
|
|
fb_CreateDirectoryStructure( D );
|
|
|
|
DLog:=Format('%s/log-%s.log', [D, FormatDateTime('dd-mm-yyyy-hh-mm-ss', Now)]);
|
|
//DLog:=Format('%s/log.log', [D]);
|
|
fb_CopyFile(GlobalConfig.DebugLogFile, DLog, false, false);
|
|
except
|
|
end;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLogger.Log(const S: string);
|
|
var Buf:string;
|
|
begin
|
|
//Buf:=S + #13#10;
|
|
//F.Write( PChar(@Buf[1])^, Length(Buf) );
|
|
WriteLn(F, S);
|
|
Flush(F);
|
|
end;
|
|
|
|
procedure TLogger.Log(const S: string; const Fmt: array of const);
|
|
begin
|
|
Log( Format(S, Fmt) );
|
|
end;
|
|
|
|
procedure TLogger.LogException(E: Exception);
|
|
begin
|
|
ExceptionCaught:=true;
|
|
|
|
Log('***Исключение***: ' + E.Message);
|
|
Log('***Исключение*** стек: ');
|
|
DumpExceptionBackTrace(F);
|
|
Flush(F);
|
|
end;
|
|
|
|
procedure TLogger.ExceptionHandler(Sender: TObject; E: Exception);
|
|
begin
|
|
LogException(E);
|
|
//Halt(1);
|
|
Application.Terminate;
|
|
end;
|
|
|
|
procedure TLogger.LogDatasetFieldNames(const DatasetName:string; D: TDataset);
|
|
var S:String;
|
|
n:Integer;
|
|
begin
|
|
S:=DatasetName + ':';
|
|
for n:=0 to D.FieldCount-1 do
|
|
S:=S + Format(' %s(%s)', [D.Fields.Fields[n].FieldName, UpperCase(D.Fields.Fields[n].FieldName)]);
|
|
Log(S);
|
|
end;
|
|
|
|
//==============================================================================
|
|
function GlobalLogger:ILogger;
|
|
begin
|
|
if Logger = nil then
|
|
begin
|
|
Logger:=TLogger.Create;
|
|
end;
|
|
Result:=Logger;
|
|
end;
|
|
|
|
finalization
|
|
Logger:=nil;
|
|
|
|
end.
|
|
|