VB异常处理

Question

Option Explicit
Public Declare Function SetUnhandledExceptionFilter Lib "kernel32 " (ByVal lpTopLevelExceptionFilter As Long) As Long
Public Const EXCEPTION_MAXIMUM_PARAMETERS = 15&
Public Type EXCEPTION_RECORD
    ExceptionCode   As Long
    ExceptionFlags   As Long
    pExceptionRecord   As Long
    ExceptionAddress   As Long
    NumberParameters   As Long
    ExceptionInformation(EXCEPTION_MAXIMUM_PARAMETERS - 1)       As Long
End TypePublic Type EXCEPTION_POINTERS
    pExceptionRecord   As Long
    ContextRecord   As Long
End TypePrivate Declare Sub CopyMemory Lib "kernel32 " Alias "RtlMoveMemory " (Destination As Any, Source As Any, ByVal Length As Long)Public Sub InitExceptionHandler()
    SetUnhandledExceptionFilter AddressOf MyExceptionFilter
End SubPublic Function MyExceptionFilter(lpExceptionPointers As EXCEPTION_POINTERS) As Long
Dim i     As Long
Dim utExceptionRecord     As EXCEPTION_RECORD
Dim sErrMsg     As String    CopyMemory ByVal VarPtr(utExceptionRecord), ByVal lpExceptionPointers.pExceptionRecord, Len(utExceptionRecord)
    Do
        i = i + 1
        If i > 100 Then Exit Do             'Èç¹û´íÎóǶÌ׳¬¹ý100²ã¾Í°Ý°ÝÌø³ö
        With utExceptionRecord
                sErrMsg = TranslateExceptionCode(.ExceptionCode)
                
                If sErrMsg = TranslateExceptionCode(&HC0000005) Then
                        sErrMsg = sErrMsg & "   -   Î»ÓÚ   &H " & Hex(.ExceptionAddress) & "   µÄ´úÂëÊÔͼÏòµØÖ·   &H " & _
                                                Hex(.ExceptionInformation(1)) & "   " & _
                                                IIf(.ExceptionInformation(0) = 0, "¶ÁÈ¡ ", "дÈë ") & "Êý¾Ý "
                End If
                
                If .pExceptionRecord = 0 Then Exit Do
                
                CopyMemory ByVal VarPtr(utExceptionRecord), ByVal .pExceptionRecord, Len(utExceptionRecord)
                
        End With
        sErrMsg = sErrMsg & vbCrLf
    Loop
    
    Err.Raise vbObjectError + &H123, "Òì³£¹ýÂ˺¯Êý ", sErrMsg
End FunctionPrivate Function TranslateExceptionCode(ByVal lExceptionCode As Long) As String
    Select Case lExceptionCode
    Case &HC0000005
            TranslateExceptionCode = "EXCEPTION_ACCESS_VIOLATION "
    Case &HC000008C
            TranslateExceptionCode = "EXCEPTION_ARRAY_BOUNDS_EXCEEDEDEX "
    Case &H80000003
            TranslateExceptionCode = "EXCEPTION_BREAKPOINT "
    Case &H80000002
            TranslateExceptionCode = "EXCEPTION_DATATYPE_MISALIGNMENT "
    Case &HC000008D
            TranslateExceptionCode = "EXCEPTION_FLOAT_DENORMAL_OPERANDEXCE "
    Case &HC000008E
            TranslateExceptionCode = "EXCEPTION_FLOAT_DIVIDE_BY_ZERO "
    Case &HC000008F
            TranslateExceptionCode = "EXCEPTION_FLOAT_INEXACT_RESULT "
    Case &HC0000090
            TranslateExceptionCode = "EXCEPTION_INVALID_OPERATION "
    Case &HC0000091
            TranslateExceptionCode = "EXCEPTION_FLOAT_OVERFLOW "
    Case &HC0000092
            TranslateExceptionCode = "EXCEPTION_FLOAT_STACK_CHECK "
    Case &HC0000093
            TranslateExceptionCode = "EXCEPTION_FLOAT_UNDERFLOW "
    Case &H80000001
            TranslateExceptionCode = "EXCEPTION_GUARD_PAGE_VIOLATION "
    Case &HC000001D
            TranslateExceptionCode = "EXCEPTION_ILLEGAL_INSTRUCTION "
    Case &HC0000006
            TranslateExceptionCode = "EXCEPTION_IN_PAGE_ERROR "
    Case &HC0000094
            TranslateExceptionCode = "EXCEPTION_INT_DIVIDE_BY_ZERO "
    Case &HC0000095
            TranslateExceptionCode = "EXCEPTION_INT_OVERFLOW "
    Case &HC0000026
            TranslateExceptionCode = "EXCEPTION_INVALID_DISPOSITION "
    Case &HC0000008
            TranslateExceptionCode = "EXCEPTION_INVALID_HANDLE "
    Case &HC0000025
            TranslateExceptionCode = "EXCEPTION_NONCONTINUABLE_EXCEPTION "
    Case &HC0000096
            TranslateExceptionCode = "EXCEPTION_PRIVILEGED_INSTRUCTION "
    Case &HC0000004
            TranslateExceptionCode = "EXCEPTION_SINGLE_STEP "
    Case &HC00000FD
            TranslateExceptionCode = "EXCEPTION_STACK_OVERFLOW "
    Case Else
            TranslateExceptionCode = "EXCEPTION_UNKOWN_CODE "
    End Select
End Function上面是超级神豆写的VB异常处理代码。
我现在的程序也出现相同的状况，因为客户需要双屏幕，所以在第2个屏幕上运行的时候，会出现内存错误。
估计是我第2个程序中循环的图片和出现单据的问题。一直捕捉不到，在客户那边每天会出现一次ERROR，主程序就自动关闭，副屏幕没关闭，出现一个ERROR窗口，每次客户需要重启机器才可以。
再第2个屏幕中一个是富文本框-每次主程序打单的时候，都会在副屏幕上显示。
一个图片框-用来给客户放自己商店的图片，用TIMER控制，（11秒）循环的出现。现在上面的异常捕捉代码是要放到哪里？
具体是要该怎么做？

Answer 1

我的个神呢！汉字都乱码了～～
On ERROR的时候调用
TranslateExceptionCode 试试

Answer 2

还是on error goto到函数或过程的末尾然后自己集中处理方便。

Answer 3

ON ORROR GOTO就是捕捉不到

Answer 4

看看，有运算符AddressOf，必须放到标准模块。
调用方法：call InitExceptionHandler'初始化

Answer 5

on error goto 当然捕捉不到，VB内部出错才能用这个。这是搞操作系统错误捕获的。
应该在窗体的Form_Load装载事件中调用，或者在标准模块的Sub Main（）中调用。
调用方法见5楼。

Answer 6

Public Type EXCEPTION_RECORD
    ExceptionCode   As Long
    ExceptionFlags   As Long
    pExceptionRecord   As Long
    ExceptionAddress   As Long
    NumberParameters   As Long
    ExceptionInformation(EXCEPTION_MAXIMUM_PARAMETERS - 1)       As Long
End TypePublic Type EXCEPTION_POINTERS
    pExceptionRecord   As Long
    ContextRecord   As Long
End Type看到这两个public你也应该知道它是模块代码,因为在私有对象模块中不能定义PUBLIC 用户定义类型

Answer 7

上面代码是在模块中,现在我调用的时候是每个SUB都放call InitExceptionHandler

Answer 8

InitExceptionHandler只需要在程序启动时调用一次即可,就已经设置了HOOK了.然后在具体出错时会跳到MyExceptionFilter过程里去.

Answer 9

下面是豆子写的测试例子。详见：http://topic.csdn.net/t/20040318/22/2859424.html需要引起注意的是，每一个右引号左边的空格要注意清出掉，太多了，否则不起作用。特别是API，会找不到函数入口点。上面程序使用方法： 
将上面代码放于模块文件之中，需要用的时候将模块文件加到工程中。 
然后在窗体Form_Load或其他过程中写入 
Call   InitExceptionHandler 
总之要保证这句是程序的第1句。 使用实例： 
'------------   Form1.frm   ------------- 
Option   Explicit 
Private   Declare   Sub   CopyMemory   Lib   "kernel32 "   Alias   "RtlMoveMemory "   (Destination   As   Any,   Source   As   Any,   ByVal   Length   As   Long) Private   Sub   Form_Load() 
        On   Error   GoTo   Error_Handler 
        Call   InitExceptionHandler 
        CopyMemory   ByVal   -10,   ByVal   123,   100 '这行肯定出错，造成系统崩溃。
        Exit   Sub 
Error_Handler: 
        Resume   Next 
End   Sub