Delphi 5 - 使用RTLUnwind捕获所有异常

时间:2017-01-18 08:34:56

标签: delphi exception delphi-5

我今天在这里,因为我尝试使用Delphi 5和RTLUnwind来捕捉程序的每个例外都会遇到麻烦。

问题是它遇到了错误,但它在...之后立即关闭了我的程序 当我尝试调试时,会出现访问冲突。

以下是此捕获的完整代码:

unit ExceptLog;

interface

implementation

uses SysUtils, Windows, U_Test, Dialogs;

type
  PCardinal = ^Cardinal;
  PtrUInt = cardinal;
  PPtrUInt = ^PtrUInt;
  PExceptionRecord = ^TExceptionRecord;
  TExceptionRecord =
  record
    ExceptionCode : LongWord;
    ExceptionFlags : LongWord;
    OuterException : PExceptionRecord;
    ExceptionAddress : Pointer;
    NumberParameters : Longint;
    case {IsOsException:} Boolean of
    True : (ExceptionInformation : array [0..14] of Longint);
    False : (ExceptAddr: Pointer; ExceptObject: Pointer);
  end;

var
  // Declaration for Delphi 5
  oldRTLUnwindProc: procedure; stdcall;
  RTLUnWindProc: pointer;

procedure MyRtlUnwind; stdcall;
var
  s : string;
  PER : PExceptionRecord;
  E: Exception;
begin
  asm
    mov eax, dword ptr [EBP+8+13*4]
    mov PER, eax
  end;

  if PER^.ExceptionFlags and 1=1 then
  begin
    try
      E := Exception(PER^.ExceptObject);
      if (E is Exception) then
      begin
        s:= 'Delphi exception, type : ' + E.ClassName + ', message: ' +     E.Message;
        OutputDebugString(PChar(s));

        _MessageDlg(s, mtInformation, [mbOk], 0);
      end;
    except
    end;
  end;

  asm
    mov esp, ebp
    pop ebp
    jmp oldRTLUnwindProc  // here come the access violation
  end;
end;

{--------------------------------------------------------------------------------------------------}

procedure PatchCodePtrUInt(Code: PPtrUInt; Value: PtrUInt);
var RestoreProtection, Ignore: DWORD;
begin
  if VirtualProtect(Code, SizeOf(Code^), PAGE_EXECUTE_READWRITE,     RestoreProtection) then
  begin
    Code^ := Value;
    VirtualProtect(Code, SizeOf(Code^), RestoreProtection, Ignore);
    FlushInstructionCache(GetCurrentProcess, Code, SizeOf(Code^));
  end;
end;

{--------------------------------------------------------------------------------------------------}

procedure Patch(P: PAnsiChar);
var
  i: Integer;
  addr: PAnsiChar;
begin
  for i:= 0 to 31 do
  begin
    if (PCardinal(P)^ = $6850006a) and (PWord(P+8)^ = $E852) then
    begin
      inc(P, 10);
      if PInteger(P)^<0 then
      begin
        addr := P+4+PInteger(P)^;
        if PWord(addr)^=$25FF then
        begin
          PatchCodePtrUInt(Pointer(addr+2),cardinal(@RTLUnwindProc));
          exit;
        end;
      end;
    end else
      inc(P);
  end;
end;

{--------------------------------------------------------------------------------------------------}

procedure PatchCallRtlUnWind;
asm
  mov eax,offset System.@HandleAnyException+200
  call Patch
end;

{--------------------------------------------------------------------------------------------------}

procedure InitExceptionLogging;
begin
  oldRTLUnWindProc := RTLUnwindProc;
  RTLUnwindProc := @MyRtlUnwind;
  PatchCallRtlUnWind;
end;

{--------------------------------------------------------------------------------------------------}

initialization
  InitExceptionLogging;
end.

我不是Delphi 5的专家(我的企业使用过),我希望有人能够帮助我。

祝你好运!

P.S:U_Test只是一个包含&#34; _MessageDlg&#34;创建和显示对话框消息的函数。

0 个答案:

没有答案