Arn*_*hez 11
它不是基于JCL的,但它是完整的开源,从Delphi 5到XE都有效.
此日志记录机制能够拦截任何异常.
事实上,从Delphi 6开始,您可以在RtlUnwindProc中定义一个全局过程,以便在引发任何异常时进行推送:
{$ifdef DELPHI5OROLDER}
procedure RtlUnwind; external kernel32 name 'RtlUnwind';
{$else}
var
oldUnWindProc: pointer;
{$endif}
procedure SynRtlUnwind(TargetFrame, TargetIp: pointer;
ExceptionRecord: PExceptionRecord; ReturnValue: Pointer); stdcall;
asm
pushad
cmp byte ptr SynLogExceptionEnabled,0
jz @oldproc
mov eax,TargetFrame
mov edx,ExceptionRecord
call LogExcept
@oldproc:
popad
pop ebp // hidden push ebp at asm level
{$ifdef DELPHI5OROLDER}
jmp RtlUnwind
{$else}
jmp oldUnWindProc
{$endif}
end;
oldUnWindProc := RTLUnwindProc;
RTLUnwindProc := @SynRtlUnwind;
Run Code Online (Sandbox Code Playgroud)
此代码将启动以下功能:
type
PExceptionRecord = ^TExceptionRecord;
TExceptionRecord = record
ExceptionCode: DWord;
ExceptionFlags: DWord;
OuterException: PExceptionRecord;
ExceptionAddress: PtrUInt;
NumberParameters: Longint;
case {IsOsException:} Boolean of
True: (ExceptionInformation : array [0..14] of PtrUInt);
False: (ExceptAddr: PtrUInt; ExceptObject: Exception);
end;
GetExceptionClass = function(const P: TExceptionRecord): ExceptClass;
const
cDelphiExcept = $0EEDFAE0;
cDelphiException = $0EEDFADE;
procedure LogExcept(stack: PPtrUInt; const Exc: TExceptionRecord);
begin
LastError := GetLastError;
(...) intercept the exception
SetLastError(LastError); // code above could have changed this
end;
Run Code Online (Sandbox Code Playgroud)
对于Delphi 5,我不得不在进程中修补VCL,因为没有全局异常拦截器.
归档时间: |
|
查看次数: |
4232 次 |
最近记录: |