Delphi中利用SEH屏蔽退出时的Runtime Error

Delphi 中利用 SEH 屏蔽退出时的 Runtime Error

书呆子

Delphi 写的程序，如果在单元的 finalization 里出现了一些异常操作会导致退出时抛出 Runtime Error  ，规范的处理办法当然是解决这些异常，但是有些特殊的情况下，比如用了很多的第三方控件，实在没办法解决问题时，只有把他屏蔽掉，这样给客户的时候就不至于看到满天的 Runtime Error  了。

前些日子同事正好碰到了这个问题，他写的一个 ACTIVEX 控件，在客户的 IE 里关闭的时候就会抛出很多错误导致 IE 死掉，但是在本机又模拟不出来，问题不能解决，又得应付客户。找我讨论解决方案，我提议可以用 SEH 解决，于是写了一段代码，效果不错，不敢独享，贴出来希望能够帮大家应付遇到的问题。

我的做法其实很简单，就是在 END. 之前手工调用 Halt 释放，并且将 Halt 抛出的错误屏蔽掉，这样做和正常的 DELPHI 释放过程没有任何区别，因为 End. 编译后其实就是一句话 Call Halt0 ，只是 VCL 自己没有屏蔽 Halt0 里抛出的错误，而是跳出个 Runtime Error  来 ;

首先就是位置的问题，如果是 EXE 的话，直接在 END. 之前就行了，如果是 Dll 的话就麻烦点，需要挂上 DllProc ，当 wReason = DLL_PROCESS_DETACH 时处理。

然后就是如何屏蔽错误的问题了，第一个最容易想到的做法就是直接

Try

  halt

except

end;

 

但是这样是不行的，因为try…except end捕获的错误都会放到System单元的_HandleOnException中处理，函数检查错误类型是否是DelphiException，如果不是就不处理，这个时候就会被DELPHI的顶层异常机制捕获，并抛出Runtime error，halt里抛出来的错误恰恰就是非DelphiException，代码如下：

 

 procedure       _HandleOnException;

 …

        CMP     [EAX].TExceptionRecord.ExceptionCode,cDelphiException

        JE      @@DelphiException

        CLD

        CALL    _FpuInit

        MOV     EDX,ExceptClsProc

        TEST    EDX,EDX

        JE      @@exit

        CALL    EDX

        TEST    EAX,EAX

        JNE     @@common

        JMP     @@exit

…

End;

所以，需要借助SHE机制来处理这个问题（哈哈，不然就得改标题了），代码如下（关于如何挂SHE我就不介绍了，我在另外一篇文章《 Delphi 异常机制与 SEH》详细介绍了）：

    asm

      // 挂上 SEH

xor edx, edx

      push ebp

      push OFFSET @@safecode

      push dword ptr fs:[edx]

      mov fs:[edx],esp

      // 调用 Halt0

      call Halt0

      jmp @@exit;

 

      @@safecode:

        // 如果出现异常继续调用 Halt0 退出

call Halt0;

 

      @@exit:

    end;

这个做法的好处就是，不会对DELPHI正常释放过程产生影响，所有的释放操作都是和VCL一致的，只是不会把错误显示出来。

 

以下是完整代码：

一、EXE的情况，把代码放在工程文件

procedure Halt0;

begin

 Halt;

end;

 

begin

 Application.Initialize;

 Application.CreateForm(TForm1, Form1);

 Application.Run;

 

 asm

    xor edx, edx

    push ebp

    push OFFSET @@safecode

    push dword ptr fs:[edx]

    mov fs:[edx],esp

 

    call Halt0

    jmp @@exit;

 

    @@safecode:

      call Halt0;

 

    @@exit:

 end;

 

end.

二、DLL的情况，把代码放在工程文件里

procedure Halt0;

begin

 Halt;

end;

 

var

 OldProc: Pointer;

 

procedure DLLEntryPoint(dwReason: DWord);

begin

 

 if (dwReason = DLL_PROCESS_DETACH) Then

 Begin

    asm

      xor edx, edx

      push ebp

      push OFFSET @@safecode

      push dword ptr fs:[edx]

      mov fs:[edx],esp

 

      call Halt0

      jmp @@exit;

 

      @@safecode:

        call Halt0;

 

      @@exit:

    end;

 end;

 

end;

 

begin

 DllProc := @DLLEntryPoint;

 DllProcEX := @DLLEntryPoint;

 

end.

 

测试这段代码可以，自己在某个单元的 finalization 段里抛出一个异常，看看加上代码和不加代码的效果有何不同。

联系方式

Mail： [email protected]