如何将exe异常路由到VB6应用程序？ [英] How to route the exe exception back to VB6 app?
本文介绍了如何将exe异常路由到VB6应用程序？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我有一个vb6应用程序，它将调用mencoder.exe是mplayer的一部分，将一些文件转换为flv格式。当我尝试转换这一个opendivx文件时，我正在从mencoder得到这个奇怪的未处理的异常问题。
目前来说，我不清楚这个编解码器是否是此背后的罪魁祸首。无论哪种方式，我都尝试修改命令行，甚至下载最新的可用版本的mencoder。
所以转换工作正常，唯一的问题是最终会出现错误，因为视频文件超过100％到102％。因此我的问题是我如何将这个异常路由到我的vb6应用程序来处理，以免丑版错误弹出窗口不显示？
我甚至在代码中包含了异常捕获，但没有捕获该异常。
'函数GetCommandOutput
'
'sCommandLine：[in]命令行启动
'blnStdOut [in，opt] True（defualt）将输出捕获到STDOUT
'blnStdErr [in，opt] True将捕获到STDERR的输出。默认为false。
'blnOEMConvert：[in，opt] True（默认）将DOS字符转换为Windows，False跳过转换
'
'返回：带STDOUT和/或STDERR输出的字符串
'
公共函数GetCommandOutput（sCommandLine As String，_
可选blnStdOut As Boolean = True，_
可选blnStdErr As Boolean = False，_
可选blnOEMConvert As Boolean = True， _
可选encoderType As String）As String
Dim hPipeRead As Long，hPipeWrite1 As Long，hPipeWrite2 As Long
Dim hCurProcess As Long
Dim sa As SECURITY_ATTRIBUTES
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim baOutput（）As Byte
Dim sNewOutPut As String
Dim lBytesRead As Long
Dim fTwoHandles As Boolean
Dim lRet As Long
Const BUFSIZE = 1024'管道缓冲区大小
错误GoTo ErrorHandler
'至少其中一个应为True，否则调用中没有任何意义函数
如果（不是blnStdOut）和（不是blnStdErr）然后
Err.Raise 5'无效的过程调用或参数
结束如果
'如果两者都为true我们需要两个写柄。如果没有，一个就够了。
fTwoHandles = blnStdOut和blnStdErr
ReDim baOutput（BUFSIZE - 1）As Byte
带有sa
.nLength = Len（sa）
.bInheritHandle = 1'获得可继承的管理柄
结束
如果CreatePipe（hPipeRead，hPipeWrite1，sa，BUFSIZE）= 0然后
退出函数
End If
hCurProcess = GetCurrentProcess（）
'用不可继承的替换我们的可继承阅读句柄。在这种情况下，它不是
'似乎是必要的，但文档说我们应该。
调用DuplicateHandle（hCurProcess，hPipeRead，hCurProcess，hPipeRead，0& 0& DUPLICATE_SAME_ACCESS或DUPLICATE_CLOSE_SOURCE）
'如果STDOUT和STDERR都应重定向，请获得额外的句柄。
如果fTwoHandles然后
调用DuplicateHandle（hCurProcess，hPipeWrite1，hCurProcess，hPipeWrite2，0& 1& DUPLICATE_SAME_ACCESS）
End If
With si
.cb = Len（si）
.dwFlags = STARTF_USESHOWWINDOW或STARTF_USESTDHANDLES
.wShowWindow = SW_HIDE'隐藏窗口
如果fTwoHandles然后
.hStdOutput = hPipeWrite1
.hStdError = hPipeWrite2
ElseIf blnStdOut然后
.hStdOutput = hPipeWrite1
Else
.hStdError = hPipeWrite1
如果
结束
Dim totalSeconds As Double
如果CreateProcess（vbNullString，sCommandLine，ByVal 0& ByVal 0& 1，0& ByVal 0& vbNullString，si，pi）然后
'关闭线程句柄 - 我们不需要它
调用CloseHandle（pi.hThread）
'还关闭我们的句柄到写入端的管道。这很重要，因为
'ReadFile将* * *返回，直到所有写句柄关闭或缓冲区已满。
调用CloseHandle（hPipeWrite1）
hPipeWrite1 = 0
如果hPipeWrite2然后
调用CloseHandle（hPipeWrite2）
hPipeWrite2 = 0
End If
Do
'添加一个DoEvents以允许每个调用将更多数据写入缓冲区。
'这导致更少的更大的块被读取。
'DoEvents
如果ReadFile（hPipeRead，baOutput（0），BUFSIZE，lBytesRead，ByVal 0&）= 0然后
退出
结束如果
如果blnOEMConvert然后
'从DOS转换为Windows字符
sNewOutPut = String $（lBytesRead，0）
调用OemToCharBuff（baOutput（0 ）
Else
'执行没有转换（Unicode除外）
sNewOutPut = Left $（StrConv（baOutput（），vbUnicode），lBytesRead）
结束If
GetCommandOutput = GetCommandOutput& sNewOutPut
'如果您正在执行长时间输出数据的应用程序，
'并且不想锁定您的应用程序，那么
'可能是一个更好的主意ActiveX EXE中的类模块中的代码，并以异步方式执行。
'然后，每次有更多的数据可以提出一个事件。
'Debug.Print sNewOutPut + vbNewLine
如果encoderType =ffmpeg然后
如果totalSeconds< 1然后
totalSeconds = GetFFmpegFileTotalSeconds（sNewOutPut）
End If
调用CalculateFFMpegProgress（sNewOutPut，totalSeconds）
Else
调用CalculateMencoderProgress（sNewOutPut）
结束如果
'RaiseEvent OutputAvailable（sNewOutput）
循环
'当进程成功终止时，Err.LastDllError将为
'ERROR_BROKEN_PIPE（109 ）。其他值表示错误。
调用CloseHandle（pi.hProcess）
Else
GetCommandOutput =无法创建进程，检查命令行的路径。
如果
'清理
调用CloseHandle（hPipeRead）
如果hPipeWrite1然后
调用CloseHandle（hPipeWrite1）
结束如果
如果hPipeWrite2然后
调用CloseHandle（hPipeWrite2）
结束If
退出函数
ErrorHandler：
调用WriteErrorLog （Err，Class clsThread：Sub GetCommandOutput）
结束函数
更新： h2>
如果你们好奇应用程序在崩溃时输出什么，这里是：
1个副本
Pos：83.2s 2504f（99％）112.65fps Trem：0min 6mb AV：0.008 [571：79]]
1重复（$）
Pos：83.4s 2510f（102％）112.74fps Trem：0min 6mb AV：0.006 [571：79]
1个重复帧（s）！
Pos：83.6s 2516f（102％）112.84fps Trem：0min 6mb AV：0.004 [571：79]
1重复帧s）！
[mpeg4 @ 0x1ac53a0]隐藏40 D C，40 AC，40 MV错误AV：0.003 [571：79]
alt text http://img21.imageshack.us/img21/4539/exception.png
谢谢：）
解决方案
您可以尝试使用SetUnhandledExceptionFilter API来捕获异常。我以前使用过它，但只有有限的成功。
我相信这段代码最初来自于受到Jonathan Lunman的无异常错误，我的尊敬的Dr. Watson的五月99日Visual Basic程序员杂志的一篇文章的严重影响或受到启发。 / p>
公共组件SYSEXC_MAXIMUM_PARAMETERS = 15
'不如API中更短的声明，但在内部相同的
类型CONTEXT
Dbls（0到66）As Double
长（0到6）As Long
结束类型
类型SYSEXC_RECORD
ExceptionCode As Long
ExceptionFlags As Long
pExceptionRecord As Long
ExceptionAddress As Long
NumberParameters As Long
异常信息（SYSEXC_MAXIMUM_PARAMETERS）As Long
结束类型
键入SYSEXC_POINTERS
pExceptionRecord As SYSEXC_RECORD
ContextRecord As CONTEXT
结束类型
私有声明函数SetUnhandledExceptionFilter Libkernel32_
（ByVal lpTopLevelExceptionFilter As Long）As Lon g
私有声明Sub CopyMemory Libkernel32别名RtlMoveMemory_
（Destination As Any，Source As Any，ByVal Length As Long）
私有声明Sub CopyExceptionRecord Libkernel32别名 RtlMoveMemory（pDest As SYSEXC_RECORD，ByVal LPSYSEXC_RECORD As Long，ByVal lngBytes As Long）
公共属性获取ErrSysHandlerWasSet（）作为Boolean
ErrSysHandlerWasSet = mSysHandlerWasSet
结束属性
Public Sub ErrSysHandlerSet（）
如果mSysHandlerWasSet然后ErrSysHandlerRelease
调用SetUnhandledExceptionFilter（AddressOf SysExcHandler）
mSysHandlerWasSet = True
End Sub
公共Sub ErrSysHandlerRelease（）
ErrPreserve'可以从错误处理程序调用此子，所以保留错误
On Error Resume Next
如果mSysHandlerWasSet然后调用SetUnhandledExceptionFilter（0）
mSysHandlerWasSet = False
ErrRestore
End Sub
'====================== ==私人的东西=======================================
私人函数SysExcHandler（ByRef ExcPtrs As SYSEXC_POINTERS）As Long
Dim ExcRec As SYSEXC_RECORD，strExc As String
ExcRec = ExcPtrs.pExceptionRecord
直到ExcRec.pExceptionRecord = 0
CopyExceptionRecord ExcRec，ExcRec .pExceptionRecord，Len（ExcRec）
循环
strExc = GetExcAsText（ExcRec.ExceptionCode）
Err.Raise ERR_SYSEXCEPTION，SRC_SYSHANDLER，_
（& H& Hex $（ExcRec.ExceptionCode）& & strExc
结束函数
私有函数GetExcAsText（ByVal ExcNum As Long）As String
选择案例ExcNum
案例SYSEXC_ACCESS_VIOLATION：GetExcAsText =访问冲突
案例SYSEXC_DATATYPE_MISALIGNMENT：GetExcAsText =数据类型错位
案例SYSEXC_BREAKPOINT：GetExcAsText =断点
案例SYSEXC_SINGLE_STEP：GetExcAsText =单步
案例SYSEXC_ARRAY_BOUNDS_EXCEEDED：GetExcAsText =超出数组边界
案例SYSEXC_FLT_DENORMAL_OPERAND：GetExcAsText =浮动异常操作数
案例SYSEXC_FLT_DIVIDE_BY_ZERO：GetExcAsText =除以零
案例SYSEXC_FLT_INEXACT_RESULT：GetExcAsText =浮点不精确结果
案例SYSEXC_FLT_INVALID_OPERATION：GetExcAsText = 无效操作
案例SYSEXC_FLT_OVERFLOW：GetExcAsText =浮动溢出
案例SYSEXC_FLT_STACK_CHECK：GetExcAsText =浮动堆栈检查
案例SYSEXC_FLT_UNDERFLOW：GetExcAsText =浮动下溢
案例SYSEXC_INT_DIVIDE_BY_ZERO：GetExcAsText =整数除以零
案例SYSEXC_INT_OVERFLOW：GetExcAsText =整数溢出
案例SYSEXC_PRIVILEGED_INSTRUCTION：GetExcAsText =特权指令
案例SYSEXC_IN_PAGE_ERROR：GetExcAsText =页面错误
案例SYSEXC_ILLEGAL_INSTRUCTION：GetExcAsText =非法指令
案例SYSEXC_NONCONTINUABLE_EXCEPTION：GetExcAsText =不可持续异常
案例SYSEXC_STACK_OVERFLOW：GetExcAsText =堆栈溢出
案例SYSEXC_INVALID_DISPOSITION：GetExcAsText =无效处置
案例SYSEXC_GUARD_PAGE_VIOLATION：GetExcAsText =防护页违规
案例SYSEXC_IN VALID_HANDLE：GetExcAsText =无效句柄
案例SYSEXC_CONTROL_C_EXIT：GetExcAsText =控制C退出
结束选择
结束函数
查看 SetUnhandledExceptionFilter功能在MSDN了解更多信息。
i have a vb6 apps which will call the mencoder.exe which is part of the mplayer to convert some files into flv format. i'm getting this weird unhandled exception problem from mencoder whenever i try to convert this one opendivx file.
At the moment, i'm unclear of whether is this codec is the culprit behind this. Either way i have try to modify the command line and even downloaded the latest available version for mencoder.
so the conversion works fine and the only problem is that the mencoder will crash in the end, as the video file somehow exceeds 100% to 102%. thus my question is how do i route this exception to be handled by my vb6 app so that the ugly error popup won't be shown?
i've even included the exception capture in the code, but it's not catching that exception.
' Function GetCommandOutput
'
' sCommandLine: [in] Command line to launch
' blnStdOut [in,opt] True (defualt) to capture output to STDOUT
' blnStdErr [in,opt] True to capture output to STDERR. False is default.
' blnOEMConvert: [in,opt] True (default) to convert DOS characters to Windows, False to skip conversion
'
' Returns: String with STDOUT and/or STDERR output
'
Public Function GetCommandOutput(sCommandLine As String, _
Optional blnStdOut As Boolean = True, _
Optional blnStdErr As Boolean = False, _
Optional blnOEMConvert As Boolean = True, _
Optional encoderType As String) As String
Dim hPipeRead As Long, hPipeWrite1 As Long, hPipeWrite2 As Long
Dim hCurProcess As Long
Dim sa As SECURITY_ATTRIBUTES
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim baOutput() As Byte
Dim sNewOutPut As String
Dim lBytesRead As Long
Dim fTwoHandles As Boolean
Dim lRet As Long
Const BUFSIZE = 1024 ' pipe buffer size
On Error GoTo ErrorHandler
' At least one of them should be True, otherwise there's no point in calling the function
If (Not blnStdOut) And (Not blnStdErr) Then
Err.Raise 5 ' Invalid Procedure call or Argument
End If
' If both are true, we need two write handles. If not, one is enough.
fTwoHandles = blnStdOut And blnStdErr
ReDim baOutput(BUFSIZE - 1) As Byte
With sa
.nLength = Len(sa)
.bInheritHandle = 1 ' get inheritable pipe handles
End With
If CreatePipe(hPipeRead, hPipeWrite1, sa, BUFSIZE) = 0 Then
Exit Function
End If
hCurProcess = GetCurrentProcess()
' Replace our inheritable read handle with an non-inheritable. Not that it
' seems to be necessary in this case, but the docs say we should.
Call DuplicateHandle(hCurProcess, hPipeRead, hCurProcess, hPipeRead, 0&, 0&, DUPLICATE_SAME_ACCESS Or DUPLICATE_CLOSE_SOURCE)
' If both STDOUT and STDERR should be redirected, get an extra handle.
If fTwoHandles Then
Call DuplicateHandle(hCurProcess, hPipeWrite1, hCurProcess, hPipeWrite2, 0&, 1&, DUPLICATE_SAME_ACCESS)
End If
With si
.cb = Len(si)
.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
.wShowWindow = SW_HIDE ' hide the window
If fTwoHandles Then
.hStdOutput = hPipeWrite1
.hStdError = hPipeWrite2
ElseIf blnStdOut Then
.hStdOutput = hPipeWrite1
Else
.hStdError = hPipeWrite1
End If
End With
Dim totalSeconds As Double
If CreateProcess(vbNullString, sCommandLine, ByVal 0&, ByVal 0&, 1, 0&, ByVal 0&, vbNullString, si, pi) Then
' Close thread handle - we don't need it
Call CloseHandle(pi.hThread)
' Also close our handle(s) to the write end of the pipe. This is important, since
' ReadFile will *not* return until all write handles are closed or the buffer is full.
Call CloseHandle(hPipeWrite1)
hPipeWrite1 = 0
If hPipeWrite2 Then
Call CloseHandle(hPipeWrite2)
hPipeWrite2 = 0
End If
Do
' Add a DoEvents to allow more data to be written to the buffer for each call.
' This results in fewer, larger chunks to be read.
'DoEvents
If ReadFile(hPipeRead, baOutput(0), BUFSIZE, lBytesRead, ByVal 0&) = 0 Then
Exit Do
End If
If blnOEMConvert Then
' convert from "DOS" to "Windows" characters
sNewOutPut = String$(lBytesRead, 0)
Call OemToCharBuff(baOutput(0), sNewOutPut, lBytesRead)
Else
' perform no conversion (except to Unicode)
sNewOutPut = Left$(StrConv(baOutput(), vbUnicode), lBytesRead)
End If
GetCommandOutput = GetCommandOutput & sNewOutPut
' If you are executing an application that outputs data during a long time,
' and don't want to lock up your application, it might be a better idea to
' wrap this code in a class module in an ActiveX EXE and execute it asynchronously.
' Then you can raise an event here each time more data is available.
'Debug.Print sNewOutPut + vbNewLine
If encoderType = "ffmpeg" Then
If totalSeconds < 1 Then
totalSeconds = GetFFmpegFileTotalSeconds(sNewOutPut)
End If
Call CalculateFFMpegProgress(sNewOutPut, totalSeconds)
Else
Call CalculateMencoderProgress(sNewOutPut)
End If
'RaiseEvent OutputAvailable(sNewOutput)
Loop
' When the process terminates successfully, Err.LastDllError will be
' ERROR_BROKEN_PIPE (109). Other values indicates an error.
Call CloseHandle(pi.hProcess)
Else
GetCommandOutput = "Failed to create process, check the path of the command line."
End If
' clean up
Call CloseHandle(hPipeRead)
If hPipeWrite1 Then
Call CloseHandle(hPipeWrite1)
End If
If hPipeWrite2 Then
Call CloseHandle(hPipeWrite2)
End If
Exit Function
ErrorHandler:
Call WriteErrorLog(Err, "Class clsThread : Sub GetCommandOutput")
End Function
Updates:
and in case you guys are curious what the application was outputting when it crash, here it is:
1 duplicate frame(s)!
Pos: 83.2s 2504f (99%) 112.65fps Trem: 0min 6mb A-V:0.008 [571:79]] 1 duplicate frame(s)!
Pos: 83.4s 2510f (102%) 112.74fps Trem: 0min 6mb A-V:0.006 [571:79] 1 duplicate frame(s)!
Pos: 83.6s 2516f (102%) 112.84fps Trem: 0min 6mb A-V:0.004 [571:79] 1 duplicate frame(s)!
[mpeg4 @ 0x1ac53a0]concealing 40 DC, 40 AC, 40 MV errors A-V:0.003 [571:79]
alt text http://img21.imageshack.us/img21/4539/exception.png
thanks :)
解决方案
You could try using the SetUnhandledExceptionFilter API to catch the exception. I've used it previously, but only with limited success. I believe this code originally either came from, was heavily influenced by, or was inspired by, an Article in the May 99 Visual Basic Programmers Journal called "No Exception Errors, My Dear Dr. Watson" by Jonathan Lunman.
Public Const SYSEXC_MAXIMUM_PARAMETERS = 15
'Not exactly as in API, shorter declaration, but internally the same
Type CONTEXT
Dbls(0 To 66) As Double
Longs(0 To 6) As Long
End Type
Type SYSEXC_RECORD
ExceptionCode As Long
ExceptionFlags As Long
pExceptionRecord As Long
ExceptionAddress As Long
NumberParameters As Long
ExceptionInformation(SYSEXC_MAXIMUM_PARAMETERS) As Long
End Type
Type SYSEXC_POINTERS
pExceptionRecord As SYSEXC_RECORD
ContextRecord As CONTEXT
End Type
Private Declare Function SetUnhandledExceptionFilter Lib "kernel32" _
(ByVal lpTopLevelExceptionFilter As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub CopyExceptionRecord Lib "kernel32" Alias "RtlMoveMemory" (pDest As SYSEXC_RECORD, ByVal LPSYSEXC_RECORD As Long, ByVal lngBytes As Long)
Public Property Get ErrSysHandlerWasSet() As Boolean
ErrSysHandlerWasSet = mSysHandlerWasSet
End Property
Public Sub ErrSysHandlerSet()
If mSysHandlerWasSet Then ErrSysHandlerRelease
Call SetUnhandledExceptionFilter(AddressOf SysExcHandler)
mSysHandlerWasSet = True
End Sub
Public Sub ErrSysHandlerRelease()
ErrPreserve 'This Sub may be called from error handler, so preserve errors
On Error Resume Next
If mSysHandlerWasSet Then Call SetUnhandledExceptionFilter(0)
mSysHandlerWasSet = False
ErrRestore
End Sub
'========================== Private stuff ===========================================
Private Function SysExcHandler(ByRef ExcPtrs As SYSEXC_POINTERS) As Long
Dim ExcRec As SYSEXC_RECORD, strExc As String
ExcRec = ExcPtrs.pExceptionRecord
Do Until ExcRec.pExceptionRecord = 0
CopyExceptionRecord ExcRec, ExcRec.pExceptionRecord, Len(ExcRec)
Loop
strExc = GetExcAsText(ExcRec.ExceptionCode)
Err.Raise ERR_SYSEXCEPTION, SRC_SYSHANDLER, _
"(&H" & Hex$(ExcRec.ExceptionCode) & ") " & strExc
End Function
Private Function GetExcAsText(ByVal ExcNum As Long) As String
Select Case ExcNum
Case SYSEXC_ACCESS_VIOLATION: GetExcAsText = "Access violation"
Case SYSEXC_DATATYPE_MISALIGNMENT: GetExcAsText = "Datatype misalignment"
Case SYSEXC_BREAKPOINT: GetExcAsText = "Breakpoint"
Case SYSEXC_SINGLE_STEP: GetExcAsText = "Single step"
Case SYSEXC_ARRAY_BOUNDS_EXCEEDED: GetExcAsText = "Array bounds exceeded"
Case SYSEXC_FLT_DENORMAL_OPERAND: GetExcAsText = "Float Denormal Operand"
Case SYSEXC_FLT_DIVIDE_BY_ZERO: GetExcAsText = "Divide By Zero"
Case SYSEXC_FLT_INEXACT_RESULT: GetExcAsText = "Floating Point Inexact Result"
Case SYSEXC_FLT_INVALID_OPERATION: GetExcAsText = "Invalid Operation"
Case SYSEXC_FLT_OVERFLOW: GetExcAsText = "Float Overflow"
Case SYSEXC_FLT_STACK_CHECK: GetExcAsText = "Float Stack Check"
Case SYSEXC_FLT_UNDERFLOW: GetExcAsText = "Float Underflow"
Case SYSEXC_INT_DIVIDE_BY_ZERO: GetExcAsText = "Integer Divide By Zero"
Case SYSEXC_INT_OVERFLOW: GetExcAsText = "Integer Overflow"
Case SYSEXC_PRIVILEGED_INSTRUCTION: GetExcAsText = "Privileged Instruction"
Case SYSEXC_IN_PAGE_ERROR: GetExcAsText = "In Page Error"
Case SYSEXC_ILLEGAL_INSTRUCTION: GetExcAsText = "Illegal Instruction"
Case SYSEXC_NONCONTINUABLE_EXCEPTION: GetExcAsText = "Non Continuable Exception"
Case SYSEXC_STACK_OVERFLOW: GetExcAsText = "Stack Overflow"
Case SYSEXC_INVALID_DISPOSITION: GetExcAsText = "Invalid Disposition"
Case SYSEXC_GUARD_PAGE_VIOLATION: GetExcAsText = "Guard Page Violation"
Case SYSEXC_INVALID_HANDLE: GetExcAsText = "Invalid Handle"
Case SYSEXC_CONTROL_C_EXIT: GetExcAsText = "Control-C Exit"
End Select
End Function
Check out the SetUnhandledExceptionFilter Function at MSDN for more info.
这篇关于如何将exe异常路由到VB6应用程序？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
