ITPub博客

首页 > 数字化转型 > ERP > 直接从系统得到错误描述 (转)

直接从系统得到错误描述 (转)

原创 ERP 作者:worldblog 时间:2007-12-04 16:40:22 0 删除 编辑
直接从系统得到错误描述 (转)[@more@]

'作者: Thierry Waty
'作者主页: http://www.geocities.com/ResearchTriangle/6311/
'这是一个根据错误代码直接从系统中得到错误描述的程序,你可以不要用硬编码了

'使用举例:

'  Call apiError

  ' *** Or
 '  Debug.Print ReturnAPIError(53)
  ' *** Return : 网络适配器硬件出错。


' #VBideUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * web Site  : www.geocities.com/ResearchTriangle/6311/
' * E-Mail  : .NET">waty.thierry@usa.net
' * Date  : 12/10/1998
' * Time  : 20:20
' * Module Name  : APIError_Module
' * Module Filename  : APIError.bas
' **********************************************************************
' * Comments  :
' * 这是一个根据错误代码直接从系统中得到错误描述的程序,你可以不要用硬编码
' *
' *
' **********************************************************************

Option Explicit

Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200

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

' *** Status Codes
Private Const INVALID_HANDLE_VALUE = -1&
Private Const ERROR_SUCCESS = 0&

Public Function ReturnAPIError(ErrorCode As Long) As String
  ' #VBIDEUtils#************************************************************
  ' * Programmer Name  : Waty Thierry
  ' * Web Site  : www.geocities.com/ResearchTriangle/6311/
  ' * E-mail  : waty.thierry@usa.net
  ' * Date  : 12/10/1998
  ' * Time  : 20:21
  ' * Module Name  : APIError_Module
  ' * Module Filename  : APIError.bas
  ' * Procedure Name  : ReturnAPIError
  ' * Parameters  :
  ' *  ErrorCode As Long
  ' **********************************************************************
  ' * Comments  :
  ' * Takes an API error number, and returns
  ' * a descriptive text string of the error
  ' *
  ' **********************************************************************

  Dim sBuffer  As String

  ' *** Allocate the string, then get the system to
  ' *** tell us the error message associated with
  ' *** this error number
 
  sBuffer = String(256, 0)
  FormatMessage FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, ErrorCode, 0&, sBuffer, Len(sBuffer), 0&

  ' *** Strip the last null, then the last CrLf pair if it exists
 
  sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
  If Right$(sBuffer, 2) = Chr$(13) & Chr$(10) Then
  sBuffer = Mid$(sBuffer, 1, Len(sBuffer) - 2)
  End If

  ReturnAPIError = sBuffer

End Function

Public Sub ApiError()
  ' #VBIDEUtils#************************************************************
  ' * Programmer Name  : Waty Thierry
  ' * Web Site  : www.geocities.com/ResearchTriangle/6311/
  ' * E-Mail  : waty.thierry@usa.net
  ' * Date  : 12/10/1998
  ' * Time  : 20:35
  ' * Module Name  : APIError_Module
  ' * Module Filename  : APIError.bas
  ' * Procedure Name  : APIError
  ' * Parameters  :
  ' **********************************************************************
  ' * Comments  :
  ' * Takes an API error number, and returns
  ' * a descriptive text string of the error
  ' *
  ' **********************************************************************

  Dim sError  As String
 
  On Error GoTo ERROR_APIError
 
  sError = InputBox("Enter the error number", "Returns API error")
 
  If IsNumeric(sError) = False Then Exit Sub
 
  MsgBox ReturnAPIError(CLng(sError)), vbInformation + vbOKOnly, "Error n " & sError
 
  Exit Sub
 
ERROR_APIError:
  MsgBox "Error n " & sError & vbCrLf & " Invalid error number" & vbCrLf & "You have to give another one", vbCritical + vbOKOnly, "Error n " & sError
 
End Sub



 


来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10752043/viewspace-988483/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论
  • 博文量
    6241
  • 访问量
    2449195