在VB中使用自定义·异常处理·过滤函数避免开发环境崩溃（源代码）

supergreenbean 2004-03-18 10:40:14
'---------------- mduExceptionHandler.bas ---------------
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 Type

Public Type EXCEPTION_POINTERS
pExceptionRecord As Long
ContextRecord As Long
End Type


Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


Public Sub InitExceptionHandler()
SetUnhandledExceptionFilter AddressOf MyExceptionFilter
End Sub

Public 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 Function

Private 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
...全文
400 21 打赏 收藏 转发到动态 举报
写回复
用AI写文章
21 条回复
切换为时间正序
请发表友善的回复…
发表回复
jackeroo 2004-09-03
  • 打赏
  • 举报
 回复
好贴·
keiven 2004-08-28
  • 打赏
  • 举报
 回复
mark
supergreenbean 2004-04-08
  • 打赏
  • 举报
 回复
再添加一段到mduExceptionHandler.bas

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF

'********************************************************************************
'用途：返回调用Windows API后系统返回的错误描述或者将要查询的错误号转换成错误描述
'
'使用方法:
' 1. sDes=GetLastDllErrDescription()
' 2. sDes=GetLastDllErrDescription(要查询的错误号)
'********************************************************************************
Public Function GetLastDllErrDescription(Optional vErrNumber As Variant = Empty) As String
Dim lErrNumber As Long

lErrNumber = Err.LastDllError

If Not IsEmpty(vErrNumber) Then
If IsNumeric(vErrNumber) Then
lErrNumber = CLng(vErrNumber)
End If
End If

Dim sDesc As String * 512, lLen As Long
lLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0&, lErrNumber, 0&, sDesc, Len(sDesc), ByVal 0&)
GetLastDllErrDescription = Left$(sDesc, lLen)
End Function
szdido 2004-03-22
  • 打赏
  • 举报
 回复
我去试试！！：）
szdido 2004-03-22
  • 打赏
  • 举报
 回复
谢谢绿豆gg，这是我第一次来这里，万分感谢！！！
supergreenbean 2004-03-22
  • 打赏
  • 举报
 回复
//这段代码可以用吗？
呵呵，恐怕搭不上。下面是你要的函数：

'使用方法：sOut=ContinuousSpacesKiller(sIn,True)
'参数说明：sIn - 输入字符串
' fTrimFirst - 先去除sIn两端所有空格
Public Function ContinuousSpacesKiller(ByVal sIn As String, Optional fTrimFirst As Boolean = True) As String
Dim s As String, sCrt As String, fSpace As Boolean
Dim i As Long
s = IIf(fTrimFirst, Trim$(sIn), sIn)
sCrt = ""
fSpace = False
ContinuousSpacesKiller = ""
For i = 1 To Len(s)
sCrt = Mid$(s, i, 1)
ContinuousSpacesKiller = ContinuousSpacesKiller & IIf(fSpace And (sCrt = " "), "", sCrt)
fSpace = (sCrt = " ")
Next
End Function
szdido 2004-03-22
  • 打赏
  • 举报
 回复
小妹求救，~！！！
过滤字符串中的连续空格为一个空格
函数该怎么写？？？
这段代码可以用吗？
strongfisher 2004-03-22
  • 打赏
  • 举报
 回复
up
wea1978 2004-03-22
  • 打赏
  • 举报
 回复
收藏...
supergreenbean 2004-03-22
  • 打赏
  • 举报
 回复
//看綠豆寫的代碼，千萬不要頭大
我……我……
铁拳 2004-03-19
  • 打赏
  • 举报
 回复
不过这段代码好像对自定义消息处理函数的非正常退出支持得还有些不足。
daisy8675 2004-03-19
  • 打赏
  • 举报
 回复
收了，看綠豆寫的代碼，千萬不要頭大
铁拳 2004-03-18
  • 打赏
  • 举报
 回复
今天真倒霉，刚来公司时老总说如果要刻什么东西都要经过它批准的，结果今天刚拿了一个刻录盘准备去刻就被它盯上了，刻录机的线被它拨过好几次，要是这次它把刻录机摘了的话那我写的程序就没法弄回来了，现在穷得连U盘都没不起，倒。再加一个问题，帮忙看看。

http://expert.csdn.net/Expert/topic/2859/2859538.xml?temp=.8118708
铁拳 2004-03-18
  • 打赏
  • 举报
 回复
我是按msdn里说的方法一步一步试的，可能是第一个 copymemory 的第一个参数没加 varptr吧，我那个程序在调试时如果出现内存只读的话程序会关闭，但是VB不会关闭，不过编译成可执行文件后会出现内存只读的现象，我也搞不懂问题出现在哪。
supergreenbean 2004-03-18
  • 打赏
  • 举报
 回复
呵呵，谢谢
估计不成功的原因很有可能是用了VB API浏览器里粘贴过来的代码的关系，那里面经常会有一些错误

程序翻译的东西虽然快但就是死板了一点
铁拳 2004-03-18
  • 打赏
  • 举报
 回复
感觉我以前写的那个处理SEH的代码和这个差不多，不过就是不成功，明天去公司再好好看看，已经汇了100分到你的帐户。
supergreenbean 2004-03-18
  • 打赏
  • 举报
 回复
适才见一仁兄问及SEH的事情，我才想起把自己常用的东西贴上来，抢了你第一步，真是惭愧惭愧啊
铁拳 2004-03-18
  • 打赏
  • 举报
 回复
靠，我例子还没写完您都急着发了两贴，我来晚了一步。
铁拳 2004-03-18
  • 打赏
  • 举报
 回复
酷，收藏先。

调用示例如下：
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 errFinish
InitExceptionHandler
CopyMemory ByVal 1, ByVal VarPtr(100), 3
Exit Sub
errFinish:
MsgBox Err.Description
End Sub


记得很久以前看过一个老外写的处理gpf的例子，只是当时没有收藏起来，等到失去时才知道后悔莫急，如果上天再给我一个机会……
supergreenbean 2004-03-18
  • 打赏
  • 举报
 回复
现在各位在调试API的时候，基本上不用提心吊胆，老是担心IDE什么时候耍性子了
加载更多回复（1）
用VB.NET+OpenGL开发交互式CAD系统
本课程用VB.NET结合OpenGL，从无到有开发一个功能较完整的小型交互式CAD系统。 作者有交互式CAD系统、动态几何系统开发经验。出版过交互式CAD系统开发方面的图书。 课程先讲准备知识，然后讲整个系统的开发思路和...
包过滤网络安全
该工具最大优点就是提供了功能强大的MFC类库，MFC是一个很大的C++类层次结构，...本文只处理数据包过滤器，包过滤字段的标题是基于对网络资源的众所周知的方法限制访问滤波要求的能力，按照指定的数据包分类过滤规则。
降本增笑的P0事故背后，是开猿节流引发的代码异常吗？
导读软件开发中遇到异常才是正常，很少有人能写出完美的程序跑在任何机器上都不会报错。但极为正常的软件异常，却经常出自不同的原因，导致不同的结果。怎么样科学地认识异常、处理异常，是很多研发同学需要解决的...
Hook Com接口函数
标 题: 【原创】COM接口函数通用Hook方法 作 者: zhangluduo 时 间: 2014-12-08,22:34:20 ...本文是我的本科学位论文, 今发表在此, 以示原创之据 原文地址:http://bbs.pediy.com/showthread.php?t=19537
通俗易懂，什么是.Net？什么是.NetFramework？什么是.Net Core？
每门语言在最初被设计时都有其在功能和语法上的定位，让不同的人使用擅长的语言去干合适的事，这在团队协作时尤为重要。.NET平台上的跨语言是通过...在C#项目中，可以像自身代码一样正常使用来自vb这个dll的扩展方法。
API

1,486

社区成员

23,279

社区内容

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章