''''作者: 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       : 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