672 lines
18 KiB
ObjectPascal
672 lines
18 KiB
ObjectPascal
{*******************************************************}
|
|
{ MiTeC Common Routines }
|
|
{ Journal Object }
|
|
{ }
|
|
{ }
|
|
{ Copyright (c) 1997-2021 Michal Mutl }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
{$INCLUDE Compilers.inc}
|
|
|
|
unit MiTeC_Journal;
|
|
|
|
interface
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
WinAPI.Windows, System.SysUtils, System.Classes, System.Variants,
|
|
{$ELSE}
|
|
Variants, Windows, SysUtils, Classes,
|
|
{$ENDIF}
|
|
MiTeC_Windows;
|
|
|
|
type
|
|
TJournalEvent = (jeNormal, jeSystem, jeInformation, jeWarning, jeError, jeData, jeAction, jeExecute, jeReturn, jeMessage);
|
|
|
|
TEventLevel = (elNormal, elStart, elBegin, elEnd, elFinish);
|
|
|
|
TRecordDataProperty = record
|
|
PropName,
|
|
Value: String;
|
|
end;
|
|
|
|
TRecordData = array of TRecordDataProperty;
|
|
|
|
TJournalRecord = record
|
|
Event: TJournalEvent;
|
|
Level: TEventLevel;
|
|
Timestamp: TDateTime;
|
|
TimestampStr: String;
|
|
Text: String;
|
|
Data: TRecordData;
|
|
end;
|
|
|
|
TJournalBuffer = array of TJournalRecord;
|
|
|
|
TJournal = class
|
|
private
|
|
FProcessHandle: THandle;
|
|
FFile: TFileStream;
|
|
FBuffer: TJournalBuffer;
|
|
FInternalSave: Boolean;
|
|
FFilename, FMachine, FUser: string;
|
|
FOverwrite: Boolean;
|
|
FStartTime,FStopTime: Int64;
|
|
FInternalTime: array of Int64;
|
|
FModuleName: string;
|
|
FModuleVersion: string;
|
|
function GetRecord(Index: DWORD): TJournalRecord;
|
|
function GetRecordCount: DWORD;
|
|
procedure SetRecord(Index: DWORD; const Value: TJournalRecord);
|
|
//procedure AddRecord(ATimestamp: TDateTime; AText: string; AEvent: TJournalEvent; ALevel: TEventLevel; AData: TRecordData); overload;
|
|
//procedure AddRecord(ATimestamp: string; AText: string; AEvent: TJournalEvent; ALevel: TEventLevel; AData: TRecordData); overload;
|
|
procedure AddRecord(ARecord: TJournalRecord); overload;
|
|
procedure CreateFile;
|
|
procedure PushTime(Time: Int64);
|
|
function PopTime: UInt64;
|
|
procedure WriteToFile(ARecord: TJournalRecord);
|
|
procedure WriteSpace;
|
|
public
|
|
constructor Create(ADir,AFileNamePrefix: string; AInternalSave,AOverwrite,ASaveOnDisk: boolean);
|
|
destructor Destroy; override;
|
|
|
|
procedure WriteSimpleEvent(AText: string; AEvent: TJournalEvent; ALevel: TEventLevel = elNormal);
|
|
procedure WriteEvent(AText: string; AEvent: TJournalEvent; ALevel: TEventLevel; AData: TRecordData);
|
|
procedure WritePropertyEvent(AText: string; AEvent: TJournalEvent; ALevel: TEventLevel; APropNames: array of string; AValues: array of Variant);
|
|
procedure LoadFromFile(AFilename: string);
|
|
procedure SaveToFile(AFilename: string);
|
|
procedure SaveToCSV(AFilename: string);
|
|
procedure Clear;
|
|
procedure StartTimer;
|
|
function StopTimer: Extended;
|
|
|
|
procedure AddDataProperty(var AData: TRecordData; AName: string; AValue: Variant);
|
|
|
|
property FileName: string read FFilename;
|
|
property InternalSave: Boolean read FInternalSave write FInternalSave;
|
|
property Overwrite: Boolean read FOverwrite write FOverwrite;
|
|
property Records[Index: DWORD]: TJournalRecord read GetRecord write SetRecord;
|
|
property RecordCount: DWORD read GetRecordCount;
|
|
|
|
property ModuleName: string read FModuleName;
|
|
property ModuleVersion: string read FModuleVersion;
|
|
end;
|
|
|
|
function FormatTimer(ATime: Int64): string;
|
|
|
|
const
|
|
JournalEvents: array[TJournalEvent] of string = (
|
|
'Normal ',
|
|
'System ',
|
|
'Info ',
|
|
'Warning',
|
|
'Error ',
|
|
'Data ',
|
|
'Action ',
|
|
'Execute',
|
|
'Return ',
|
|
'Message'
|
|
);
|
|
EventLevels: array[TEventLevel] of string = (
|
|
'Normal ',
|
|
'Start ',
|
|
'Begin ',
|
|
'End ',
|
|
'Finish '
|
|
);
|
|
extMJF = '.mjf';
|
|
|
|
resourcestring
|
|
rsJournalStartedInEXE = 'Process started';
|
|
rsJournalFinishedInEXE = 'Process terminated';
|
|
rsJournalStartedInModule = 'Module started';
|
|
rsJournalFinishedInModule = 'Module terminated';
|
|
rsJournalInternalFree = 'Freeing internal timer leak';
|
|
rsExitCode = 'ExitCode';
|
|
rsElapsedTime = 'ElapsedTime';
|
|
rsName = 'Name';
|
|
rsVersion = 'Version';
|
|
rsMachine = 'Machine';
|
|
rsUser = 'Username';
|
|
rsTimestamp = 'Timestamp';
|
|
rsRecNo = 'RecNo';
|
|
|
|
implementation
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
System.Win.Registry,
|
|
{$else}
|
|
Registry,
|
|
{$ENDIF}
|
|
MiTeC_Routines, MiTeC_StrUtils, MiTeC_Datetime;
|
|
|
|
type
|
|
TVersionInfo = record
|
|
FileName,
|
|
Version,
|
|
ProductName,
|
|
CompanyName,
|
|
Description,
|
|
Comments,
|
|
Copyright: string;
|
|
Major,
|
|
Minor,
|
|
Release,
|
|
Build: DWORD;
|
|
end;
|
|
|
|
function FormatTimer;
|
|
begin
|
|
Result:=FormatMilliSeconds(ATime,False);
|
|
end;
|
|
|
|
function GetFileVerInfo(const fn :string; var VI:TVersionInfo): Boolean;
|
|
var
|
|
VersionHandle,VersionSize :dword;
|
|
PItem,PVersionInfo :pointer;
|
|
FixedFileInfo :PVSFixedFileInfo;
|
|
il :uint;
|
|
translation: string;
|
|
begin
|
|
Result:=False;
|
|
if fn<>'' then begin
|
|
VI.FileName:=fn;
|
|
versionsize:=getfileversioninfosize(PChar(fn),versionhandle);
|
|
Result:=False;
|
|
if versionsize=0 then
|
|
exit;
|
|
getMem(pversioninfo,versionsize);
|
|
try
|
|
if getfileversioninfo(PChar(fn),versionhandle,versionsize,pversioninfo) then begin
|
|
Result:=True;
|
|
if verqueryvalue(pversioninfo,'\',pointer(fixedfileinfo),il) then begin
|
|
VI.version:=inttostr(hiword(fixedfileinfo^.dwfileversionms))+
|
|
'.'+inttostr(loword(fixedfileinfo^.dwfileversionms))+
|
|
'.'+inttostr(hiword(fixedfileinfo^.dwfileversionls))+
|
|
'.'+inttostr(loword(fixedfileinfo^.dwfileversionls));
|
|
VI.Major:=hiword(fixedfileinfo^.dwfileversionms);
|
|
VI.Minor:=loword(fixedfileinfo^.dwfileversionms);
|
|
VI.Release:=hiword(fixedfileinfo^.dwfileversionls);
|
|
VI.Build:=loword(fixedfileinfo^.dwfileversionls);
|
|
|
|
if verqueryvalue(pversioninfo,pchar('\VarFileInfo\Translation'),pitem,il) then begin
|
|
translation:=IntToHex(PDWORD(pitem)^,8);
|
|
translation:=Copy(translation,5,4)+Copy(translation,1,4);
|
|
end;
|
|
if verqueryvalue(pversioninfo,pchar('\StringFileInfo\'+translation+'\FileDescription'),pitem,il) then
|
|
VI.description:=pchar(pitem);
|
|
|
|
if verqueryvalue(pversioninfo,pchar('\StringFileInfo\'+translation+'\LegalCopyright'),pitem,il) then
|
|
VI.Copyright:=pchar(pitem);
|
|
|
|
if verqueryvalue(pversioninfo,pchar('\StringFileInfo\'+translation+'\Comments'),pitem,il) then
|
|
VI.Comments:=pchar(pitem);
|
|
|
|
if verqueryvalue(pversioninfo,pchar('\StringFileInfo\'+translation+'\ProductName'),pitem,il) then
|
|
VI.ProductName:=pchar(pitem);
|
|
|
|
if verqueryvalue(pversioninfo,pchar('\StringFileInfo\'+translation+'\CompanyName'),pitem,il) then
|
|
VI.CompanyName:=pchar(pitem);
|
|
|
|
end;
|
|
end;
|
|
finally
|
|
freeMem(pversioninfo,versionsize);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetUserAndDomainName(hProcess :THandle; var UserName, DomainName :string) :boolean;
|
|
const
|
|
RTN_OK = 0;
|
|
RTN_ERROR = 13;
|
|
MY_BUFSIZE = 512;
|
|
var
|
|
hToken :THandle;
|
|
InfoBuffer :array[0..MY_BUFSIZE] of byte;
|
|
snu :SID_NAME_USE;
|
|
cchUserName,cchDomainName :dword;
|
|
cbInfoBuffer :DWORD;
|
|
begin
|
|
cbInfoBuffer:=MY_BUFSIZE;
|
|
result:=false;
|
|
if OpenProcessToken(hProcess,TOKEN_QUERY,hToken) then begin
|
|
if GetTokenInformation(hToken,TokenUser,@InfoBuffer,cbInfoBuffer,cbInfoBuffer) then
|
|
result:=LookupAccountSid(nil,PSID(@InfoBuffer),PChar(@UserName),
|
|
cchUserName,PChar(@DomainName),cchDomainName,snu);
|
|
CloseHandle(hToken);
|
|
end;
|
|
end;
|
|
|
|
function GetMachine :string;
|
|
var
|
|
n :dword;
|
|
buf :pchar;
|
|
const
|
|
rkMachine = {HKEY_LOCAL_MACHINE}'\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName';
|
|
rvMachine = 'ComputerName';
|
|
begin
|
|
n:=255;
|
|
buf:=stralloc(n);
|
|
GetComputerName(buf,n);
|
|
result:=buf;
|
|
strdispose(buf);
|
|
with TRegistry.Create do begin
|
|
rootkey:=HKEY_LOCAL_MACHINE;
|
|
if OpenKeyReadOnly(rkMachine) then begin
|
|
if ValueExists(rvMachine) then
|
|
result:=ReadString(rvMachine);
|
|
closekey;
|
|
end;
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
function GetUser :string;
|
|
var
|
|
n :dword;
|
|
buf :pchar;
|
|
begin
|
|
n:=255;
|
|
buf:=stralloc(n);
|
|
GetUserName(buf,n);
|
|
result:=buf;
|
|
strdispose(buf);
|
|
end;
|
|
|
|
{ TJournal }
|
|
|
|
procedure TJournal.AddDataProperty;
|
|
begin
|
|
SetLength(AData,Length(AData)+1);
|
|
with AData[High(AData)] do begin
|
|
PropName:=AName;
|
|
try
|
|
Value:=VarToStr(AValue);
|
|
except
|
|
Value:='';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJournal.AddRecord(ARecord: TJournalRecord);
|
|
begin
|
|
SetLength(FBuffer,Length(FBuffer)+1);
|
|
FBuffer[High(FBuffer)]:=ARecord;
|
|
end;
|
|
|
|
{procedure TJournal.AddRecord(ATimestamp: TDateTime; AText: string;
|
|
AEvent: TJournalEvent; ALevel: TEventLevel; AData: TRecordData);
|
|
begin
|
|
SetLength(FBuffer,Length(FBuffer)+1);
|
|
with FBuffer[High(FBuffer)] do begin
|
|
Event:=AEvent;
|
|
Level:=ALevel;
|
|
Timestamp:=ATimestamp;
|
|
TimestampStr:=FormatDateTime('yyy-mm-dd hh:mm:ss',ATimestamp);
|
|
Text:=AText;
|
|
Data:=AData;
|
|
end;
|
|
end;}
|
|
|
|
{procedure TJournal.AddRecord(ATimestamp, AText: string;
|
|
AEvent: TJournalEvent; ALevel: TEventLevel; AData: TRecordData);
|
|
begin
|
|
SetLength(FBuffer,Length(FBuffer)+1);
|
|
with FBuffer[High(FBuffer)] do begin
|
|
Event:=AEvent;
|
|
Level:=ALevel;
|
|
Timestamp:=0;
|
|
TimeStampStr:=ATimestamp;
|
|
Text:=AText;
|
|
Data:=AData;
|
|
end;
|
|
end;}
|
|
|
|
procedure TJournal.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to High(FBuffer) do
|
|
Finalize(FBuffer[i].Data);
|
|
Finalize(FBuffer);
|
|
if Assigned(FFile) then begin
|
|
FlushFileBuffers(FFile.Handle);
|
|
FFile.Free;
|
|
end;
|
|
DeleteFile(FFilename);
|
|
CreateFile;
|
|
end;
|
|
|
|
constructor TJournal.Create;
|
|
var
|
|
p: PChar;
|
|
VIM: TVersionInfo;
|
|
s: string;
|
|
begin
|
|
FMachine:=GetMachine;
|
|
FUser:=GetUser;
|
|
GetUserAndDomainName(GetCurrentProcess,FUser,FMachine);
|
|
p:=Allocmem(256);
|
|
GetModuleFileName(hInstance,p,255);
|
|
FModulename:=p;
|
|
GetFileVerInfo(p,VIM);
|
|
FModuleVersion:=VIM.Version;
|
|
FreeMem(p);
|
|
FInternalSave:=AInternalSave;
|
|
FOverwrite:=AOverwrite;
|
|
SetLength(FBuffer,0);
|
|
if not ASaveOnDisk then begin
|
|
s:=ExtractFileExt(AFileNamePrefix);
|
|
if s='' then
|
|
s:=extMJF;
|
|
AFileNamePrefix:=Trim(ChangeFileExt(ExtractFilename(AFileNamePrefix),''));
|
|
if AFileNamePrefix<>'' then
|
|
AFileNamePrefix:=AFilenamePrefix+'_';
|
|
FFilename:=IncludeTrailingPathDelimiter(ADir)+AFilenamePrefix+FormatDateTime('yyyy-mm-dd',Date)+s;
|
|
CreateFile;
|
|
end;
|
|
end;
|
|
|
|
procedure TJournal.CreateFile;
|
|
var
|
|
VIM,VIP: TVersionInfo;
|
|
p: PChar;
|
|
rd: TRecordData;
|
|
begin
|
|
Finalize(rd);
|
|
if Assigned(FFile) then begin
|
|
FlushFileBuffers(FFile.Handle);
|
|
FFile.Free;
|
|
end;
|
|
try
|
|
if FOverwrite or not FileExists(FFilename) then begin
|
|
FFile:=TFileStream.Create(FFileName,fmCreate or fmShareDenyWrite);
|
|
FFile.Free;
|
|
end;
|
|
FFile:=TFileStream.Create(FFileName,fmOpenWrite or fmShareDenyWrite);
|
|
if FFile.Size>0 then begin
|
|
FFile.Position:=FFile.Size;
|
|
WriteSpace;
|
|
end;
|
|
FProcessHandle:=GetModuleHandle(nil);
|
|
GetFileVerInfo(ParamStr(0),VIP);
|
|
if FProcessHandle<>hInstance then begin
|
|
p:=Allocmem(256);
|
|
GetModuleFileName(hInstance,p,255);
|
|
GetFileVerInfo(p,VIM);
|
|
AddDataProperty(rd,rsName,string(p));
|
|
AddDataProperty(rd,rsVersion,VIM.Version);
|
|
WriteEvent(rsJournalStartedInModule,jeSystem,elBegin,rd);
|
|
Freemem(p);
|
|
end else begin
|
|
AddDataProperty(rd,rsName,ParamStr(0));
|
|
AddDataProperty(rd,rsVersion,VIP.Version);
|
|
AddDataProperty(rd,rsMachine,FMachine);
|
|
AddDataProperty(rd,rsUser,FUser);
|
|
WriteEvent(rsJournalStartedInEXE,jeSystem,elStart,rd);
|
|
end;
|
|
except
|
|
on e: Exception do begin
|
|
FFile:=nil;
|
|
FFilename:='';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
destructor TJournal.Destroy;
|
|
var
|
|
i: Integer;
|
|
rd: TRecordData;
|
|
begin
|
|
for i:=0 to High(FInternalTime) do
|
|
WriteEvent(rsJournalInternalFree,jeSystem,elFinish,nil);
|
|
if FProcessHandle<>hInstance then
|
|
WriteEvent(rsJournalFinishedInModule,jeSystem,elEnd,nil)
|
|
else begin
|
|
AddDataProperty(rd,rsExitCode,ExitCode);
|
|
WriteEvent(rsJournalFinishedInEXE,jeSystem,elFinish,rd);
|
|
end;
|
|
SetLength(FBuffer,0);
|
|
if Assigned(FFile) then begin
|
|
FlushFileBuffers(FFile.Handle);
|
|
FFile.Free;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
function TJournal.GetRecord(Index: DWORD): TJournalRecord;
|
|
begin
|
|
Finalize(Result);
|
|
try
|
|
Result:=FBuffer[Index];
|
|
except
|
|
ZeroMemory(@Result,SizeOf(TJournalRecord));
|
|
end;
|
|
end;
|
|
|
|
function TJournal.GetRecordCount: DWORD;
|
|
begin
|
|
Result:=Length(FBuffer);
|
|
end;
|
|
|
|
procedure TJournal.LoadFromFile(AFilename: string);
|
|
var
|
|
fs: TFileStream;
|
|
sl: TStringList;
|
|
i,p,l: Integer;
|
|
j: TJournalEvent;
|
|
k: TEventLevel;
|
|
s,v: string;
|
|
r: TJournalRecord;
|
|
begin
|
|
Clear;
|
|
sl:=TStringList.Create;
|
|
fs:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyNone);
|
|
try
|
|
sl.LoadFromStream(fs);
|
|
for i:=0 to sl.Count-1 do begin
|
|
Finalize(r);
|
|
ZeroMemory(@r,SizeOf(r));
|
|
s:=sl[i];
|
|
if Pos('[',s)=1 then begin
|
|
p:=Pos(']',s);
|
|
r.TimestampStr:=Copy(s,2,p-2);
|
|
Delete(s,1,p);
|
|
p:=Pos(']',s);
|
|
v:=Trim(Copy(s,2,p-2));
|
|
r.Event:=jeNormal;
|
|
for j:=Low(JournalEvents) to High(JournalEvents) do
|
|
if CompareText(v,Trim(JournalEvents[j]))=0 then begin
|
|
r.Event:=j;
|
|
Break;
|
|
end;
|
|
Delete(s,1,p);
|
|
p:=Pos(']',s);
|
|
v:=Trim(Copy(s,2,p-2));
|
|
r.Level:=elNormal;
|
|
for k:=Low(EventLevels) to High(EventLevels) do
|
|
if CompareText(v,Trim(EventLevels[k]))=0 then begin
|
|
r.Level:=k;
|
|
Break;
|
|
end;
|
|
Delete(s,1,p+1);
|
|
p:=Pos('{',s);
|
|
if p>0 then begin
|
|
r.Text:=Copy(s,1,p-2);
|
|
Delete(s,1,p-1);
|
|
while p>0 do begin
|
|
p:=Pos('}',s);
|
|
v:=Copy(s,2,p-2);
|
|
l:=Pos('=',v);
|
|
if l>0 then
|
|
AddDataProperty(r.Data,Copy(v,1,l-1),Copy(v,l+1,Length(v)));
|
|
Delete(s,1,p);
|
|
p:=Pos('{',s);
|
|
end;
|
|
end else
|
|
r.Text:=s;
|
|
AddRecord(r);
|
|
end;
|
|
end;
|
|
finally
|
|
fs.Free;
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJournal.PopTime: UInt64;
|
|
begin
|
|
try
|
|
Result:=FInternalTime[High(FInternalTime)];
|
|
SetLength(FInternalTime,High(FInternalTime));
|
|
except
|
|
Result:=GetTickCountSafe;
|
|
end;
|
|
end;
|
|
|
|
procedure TJournal.PushTime(Time: Int64);
|
|
begin
|
|
try
|
|
SetLength(FInternalTime,Length(FInternalTime)+1);
|
|
FInternalTime[High(FInternalTime)]:=Time;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TJournal.SaveToCSV(AFilename: string);
|
|
var
|
|
i: Integer;
|
|
sl: TStringList;
|
|
begin
|
|
sl:=TStringList.Create;
|
|
try
|
|
sl.Add('TS;MSG');
|
|
for i:=0 to High(FBuffer) do
|
|
with FBuffer[i] do
|
|
sl.Add(Format('%s;%s',[TimeStampStr,Text]));
|
|
sl.SaveToFile(AFilename);
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJournal.SaveToFile(AFilename: string);
|
|
var
|
|
i: Integer;
|
|
sl: TStringList;
|
|
begin
|
|
sl:=TStringList.Create;
|
|
try
|
|
for i:=0 to High(FBuffer) do
|
|
WriteToFile(FBuffer[i]);
|
|
sl.SaveToFile(AFilename);
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJournal.SetRecord(Index: DWORD; const Value: TJournalRecord);
|
|
begin
|
|
FBuffer[Index]:=Value;
|
|
end;
|
|
|
|
procedure TJournal.StartTimer;
|
|
begin
|
|
FStartTime:=GetTickCountSafe;
|
|
FStopTime:=FStartTime;
|
|
end;
|
|
|
|
function TJournal.StopTimer: Extended;
|
|
begin
|
|
FStopTime:=GetTickCountSafe;
|
|
Result:=FStopTime-FStartTime;
|
|
end;
|
|
|
|
procedure TJournal.WriteEvent(AText: string; AEvent: TJournalEvent; ALevel: TEventLevel; AData: TRecordData);
|
|
var
|
|
i: Integer;
|
|
t: Int64;
|
|
rd: TRecordData;
|
|
r: TJournalRecord;
|
|
begin
|
|
Finalize(rd);
|
|
AText:=StringReplace(AText,#10#13,' ',[rfReplaceAll,rfIgnoreCase]);
|
|
AText:=StringReplace(AText,#13#10,' ',[rfReplaceAll,rfIgnoreCase]);
|
|
AText:=StringReplace(AText,#10,' ',[rfReplaceAll,rfIgnoreCase]);
|
|
AText:=StringReplace(AText,#13,' ',[rfReplaceAll,rfIgnoreCase]);
|
|
if ALevel=elBegin then
|
|
PushTime(GetTickCountSafe);
|
|
if ALevel=elEnd then begin
|
|
t:=GetTickCountSafe-PopTime;
|
|
AddDataProperty(rd,rsElapsedTime,FormatTimer(t));
|
|
end;
|
|
Finalize(r);
|
|
Zeromemory(@r,SizeOf(r));
|
|
r.Timestamp:=now;
|
|
r.TimestampStr:=FormatDateTime('yyyy-mm-dd hh:mm:ss',r.Timestamp);
|
|
r.Text:=AText;
|
|
r.Event:=AEvent;
|
|
r.Level:=ALevel;
|
|
if Assigned(AData) then
|
|
for i:=0 to High(AData) do
|
|
AddDataProperty(rd,AData[i].PropName,AData[i].Value);
|
|
r.Data:=rd;
|
|
WriteToFile(r);
|
|
if FInternalSave then
|
|
AddRecord(r);
|
|
end;
|
|
|
|
procedure TJournal.WritePropertyEvent;
|
|
var
|
|
rd: TRecordData;
|
|
i: Integer;
|
|
begin
|
|
Finalize(rd);
|
|
for i:=0 to High(APropnames) do
|
|
try
|
|
AddDataProperty(rd,APropnames[i],VarToStr(AValues[i]));
|
|
except
|
|
end;
|
|
WriteEvent(AText,AEvent,ALevel,rd);
|
|
end;
|
|
|
|
procedure TJournal.WriteSimpleEvent(AText: string; AEvent: TJournalEvent;
|
|
ALevel: TEventLevel);
|
|
begin
|
|
WriteEvent(AText,AEvent,ALevel,nil);
|
|
end;
|
|
|
|
procedure TJournal.WriteSpace;
|
|
var
|
|
s: string;
|
|
begin
|
|
if Assigned(FFile) then begin
|
|
s:=#13#10;
|
|
FFile.WriteBuffer(PChar(s)^,Length(s));
|
|
FlushFileBuffers(FFile.Handle);
|
|
end;
|
|
end;
|
|
|
|
procedure TJournal.WriteToFile(ARecord: TJournalRecord);
|
|
var
|
|
s: string;
|
|
i: Integer;
|
|
begin
|
|
if Assigned(FFile) then
|
|
with ARecord do begin
|
|
s:=Format('[%s][%s][%s] %s ',[TimeStampStr,
|
|
JournalEvents[Event],
|
|
EventLevels[Level],
|
|
Text]);
|
|
if Assigned(Data) then
|
|
for i:=0 to High(Data) do
|
|
s:=s+Format('{%s = %s}',[Data[i].Propname,Data[i].Value]);
|
|
s:=s+#13#10;
|
|
FFile.WriteBuffer(PChar(s)^,Length(s));
|
|
FlushFileBuffers(FFile.Handle);
|
|
end;
|
|
end;
|
|
|
|
end.
|