procedure TForm1.FormCreate(Sender: TObject);
begin
bftoolbox := TBaseForm_ToolBox.Create;
bftoolbox.Exception_ShowMessage:=TRUE;
{$IFDEF LINUX}
bftoolbox.LogPath := '/tmp';
{$ENDIF}
{$IFDEF WINDOWS}
bftoolbox.LogPath := 'c:\tmp';
{$ENDIF}
lbLog.Caption:=bftoolbox.LogPath ;
Caption := bftoolbox.LogPath;
if not ForceDirectoriesUTF8(bftoolbox.LogPath) then
ShowMessage('Directory' + LineEnding + Caption + LineEnding + 'non creata!');
end;
procedure TfmBaseForm.DoConfirm;
var SaveGuiMode: TBaseForm_GuiMode;
BFCR: TBaseForm_BFCR;
begin
SaveGuiMode := GuiMode;
try
// create record for intermethod communications
with BFCR do begin
Test.result:=TRUE;
Test.CanForce:= FALSE;
Test.MsgTestFailed:='';
Test.MsgToForce:='';
end;
// test
if Assigned(OnConfirmTest) then
try
if Assigned(FEventLog) then
FEventLog.Log('DoConfirm / OnConfirmTest');
OnConfirmTest(Self, BFCR);
if not BFCR.Test.result then
if Assigned(FEventLog) then
FEventLog.Log('DoConfirm / OnConfirmTest / Test Failed');
if BFCR.Test.CanForce then begin
if MessageDlg('ATTENTION', BFCR.Test.MsgTestFailed + #10#10 + BFCR.Test.MsgToForce,
mtConfirmation, [mbYES, mbNo], 0) mrYes then
exit;
if Assigned(FEventLog) then
FEventLog.Log('DoConfirm / OnConfirmTest / Execution Forced');
end else begin
if BFCR.Test.MsgTestFailed '' then
ShowMessage(BFCR.Test.MsgTestFailed);
exit;
end;
except
on e: exception do begin
raise TBaseForm_Exception_ConfirmTest.Create('Where: TEST FOR CONFIRM' + #10 + e.Message);
end;
end;
// set gui
case SaveGuiMode of
bfgmInsert: GuiMode := bfgmConfirmInsertInProgress;
bfgmEdit : GuiMode := bfgmConfirmEditInProgress;
end;
// before Confirm
if Assigned(OnConfirmBefore) then
try
if Assigned(FEventLog) then
FEventLog.Log('DoConfirm / OnConfirmBefore');
OnConfirmBefore(Self, BFCR);
except
on e: exception do begin
raise TBaseForm_Exception_ConfirmBefore.Create('Where: BEFORE CONFIRM' + #10 + e.Message);
end;
end;
// Confirm
if Assigned(OnConfirmExecute) then
try
if Assigned(FEventLog) then
FEventLog.Log('DoConfirm / OnConfirmExecute');
OnConfirmExecute(Self, BFCR);
except
on e: exception do begin
raise TBaseForm_Exception_ConfirmExecute.Create('Where: EXECUTE CONFIRM' + #10 + e.Message);
end;
end;
// after Confirm
if Assigned(OnConfirmAfter) then
try
if Assigned(FEventLog) then
FEventLog.Log('DoConfirm / OnConfirmAfter');
OnConfirmAfter(Self, BFCR);
except
on e: exception do begin
raise TBaseForm_Exception_ConfirmAfter.Create('Where: AFTER CONFIRM' + #10 + e.Message);
end;
end;
GuiMode := bfgmBrowse;
except
on e: exception do begin
ManageException(e);
GuiMode := SaveGuiMode;
end;
end;
end;
type
TBaseForm_Behavior = (..., bfb_InstanceLog, bfb_ClassLog, ...);
procedure TfmBaseForm.UpdateBehavior;
begin
...
if (bfb_InstanceLog in FBehavior)
or
(bfb_ClassLog in FBehavior) then begin
if not Assigned(FEventLog) then begin
FEventLog := TEventLog.Create(self);
FEventLog.LogType := ltFile;
FEventLog.Active := FALSE;
end;
if Assigned(ToolBox) then begin
ForceDirectoriesUTF8(ToolBox.LogPath);
FEventLog.FileName := ToolBox.LogPath;
if RightStr(FEventLog.FileName, 1) PathDelim then
FEventLog.FileName := FEventLog.FileName + PathDelim;
FEventLog.FileName := FEventLog.FileName + ClassName;
if bfb_InstanceLog in FBehavior then
FEventLog.FileName := FEventLog.FileName + FormatDateTime('yyyy-mm-dd_hhnnss', Now);
FEventLog.FileName := FEventLog.FileName + '.log';
FEventLog.Active := TRUE;
FEventLog.Log('UpdateBehavior / Log Activate');
end;
...
end;
function TBaseForm_ToolBox.DumpExceptionCallStack(E: Exception): string;
var
I: Integer;
Frames: PPointer;
Report: string;
begin
Report := 'Program exception! ' + LineEnding +
'Stacktrace (ToolBox):' + LineEnding + LineEnding;
if E nil then begin
Report := Report + 'Exception class: ' + E.ClassName + LineEnding +
'Message: ' + E.Message + LineEnding;
end;
Report := Report + BackTraceStrFunc(ExceptAddr);
Frames := ExceptFrames;
for I := 0 to ExceptFrameCount - 1 do
Report := Report + LineEnding + BackTraceStrFunc(Frames[I]);
result := Report;
end;