paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 16:40:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: application: remove forced exception address dump

Browse Source 
git-svn-id: trunk@58069 -
This commit is contained in:
ondrej 2018-06-01 19:42:42 +00:00
parent f53117ee9a
commit 63946f4466
1 changed files with 16 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
lcl/include/application.inc
View File

@ -1187,6 +1187,21 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.HandleException(Sender: TObject);
procedure ShowInvalidException(ExObject: TObject; ExAddr: Pointer);
// use shortstring. On exception, the heap may be corrupt.
var
Buf: ShortString;
begin
SetLength(Buf,ExceptionErrorMessage(ExObject,ExAddr,@Buf[1],255));
{$IFDEF DebugInvalidExceptions}
DebugLn('TApplication.HandleException Strange Exception');
DebugLn(Buf);
DumpExceptionBackTrace;
{$ENDIF}
if Assigned(SysUtils.OnShowException) then
SysUtils.OnShowException(Buf);
end;
var
i: LongInt;
Skip: Boolean;
@ -1213,22 +1228,6 @@ begin
Skip := ExceptObject is EAbort;
if not (AppNoExceptionMessages in FFlags) then
begin
// before we do anything, write it down
if ExceptObject is Exception then
begin
if not Skip then
begin
DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
DumpExceptionBackTrace;
end;
end else
begin
DebugLn('TApplication.HandleException Strange Exception ');
DumpExceptionBackTrace;
end;
end;
// release capture and hide all forms with stay on top, so that
// a message can be shown
if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);
@ -1252,7 +1251,7 @@ begin
end;
end
else
SysUtils.ShowException(ExceptObject, ExceptAddr);
ShowInvalidException(ExceptObject, ExceptAddr);
if not Skip then
RestoreStayOnTop(True);
Exclude(FFlags, AppHandlingException);