首页 /编程语言和算法/VB6/ASP
 VB6 利用API显示更加完善的错误
今天 18:16

新建From1(窗体),新建Command1(按钮CommandButton),代码:

'Most API calls will return an error number indicating whether the call was successfully made or not. To convert these error numbers into more meaningful error messages use the following function:
'Error message API
Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long
'Purpose     :  Converts an error number to an error description
'Inputs      :  lErrorNumber        The API error number
'Outputs     :  Returns a descriptive error message
Function f_ErrorDescription(ByVal lErrorNumber As Long) As String
    Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_SYSTEM = &H1000
    Const NERR_BASE = 2100, MAX_NERR = NERR_BASE + 899
    Const LOAD_LIBRARY_AS_DATAFILE = &H2
    Dim sMsg As String
    Dim sRtrnCode As String
    Dim lFlags As Long
    Dim hModule As Long
    Dim lRet As Long
    hModule = 0
    sRtrnCode = Space$(256)
    lFlags = FORMAT_MESSAGE_FROM_SYSTEM
    'If lRet is in the network range, load the message source
    If (lErrorNumber >= NERR_BASE And lErrorNumber <= MAX_NERR) Then
        hModule = LoadLibraryEx("netmsg.dll", 0&, LOAD_LIBRARY_AS_DATAFILE)
        If (hModule <> 0) Then
            lFlags = lFlags Or FORMAT_MESSAGE_FROM_HMODULE
        End If
    End If
    'Call FormatMessage to allow for message text to be acquired
    'from the system or the supplied module handle.
    lRet = FormatMessage(lFlags, hModule, lErrorNumber, 0&, sRtrnCode, 256&, 0&)
    If (hModule <> 0) Then
        'Unloaded message source
        FreeLibrary hModule
    End If
    f_ErrorDescription = "ERROR: " & lErrorNumber & " - " & sRtrnCode
    'Clean message
    lRet = InStr(1, f_ErrorDescription, vbNullChar)
    If lRet Then
        f_ErrorDescription = Left$(f_ErrorDescription, lRet - 1)
    End If
    lRet = InStr(1, f_ErrorDescription, vbNewLine)
    If lRet Then
        f_ErrorDescription = Left$(f_ErrorDescription, lRet - 1)
    End If
End Function

Private Sub Command1_Click()
    On Error GoTo hErr
    Dim a As Integer
    a = 1 / 0
    Exit Sub
hErr:
    Debug.Print Err.Description
    Debug.Print f_ErrorDescription(Err.Number)
End Sub

运行结果:

除数为零
ERROR: 11 - 试图加载格式不正确的程序。


 
全部回复(0)
首页 | 电脑版 |