学步园

Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = 256
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = 512
Private Const FORMAT_MESSAGE_FROM_STRING As Long = 1024
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = 2048
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = 4096
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = 8192
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = 255
Private Const LANG_NEUTRAL As Long = &H0
Private Const SUBLANG_DEFAULT As Long = &H1

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByRef lpString1 As Byte, ByVal lpString2 As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageW" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As Long, ByVal nSize As Long, ByVal Arguments As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Any) As Long

Private Function MAKELANGID(ByVal p As Long, ByVal s As Long) As Long
    MAKELANGID = (CLng(CInt(s)) * 1024) Or CLng(CInt(p))
End Function

Private Function GetErrorText(ByVal dwErrorCode As Long) As String
    Dim dwMessageLength As Long, lpBuffer As Long
    Dim bBuffer() As Byte
    
    dwMessageLength = FormatMessage( _
        FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
        0, _
        dwErrorCode, _
        MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _
        VarPtr(lpBuffer), _
        0, _
        0)
    If dwMessageLength = 0 Then
        GetErrorText = ""
    Else
        ReDim bBuffer(dwMessageLength + dwMessageLength + 2)
        Call lstrcpy(bBuffer(0), lpBuffer)
        GetErrorText = bBuffer
        Erase bBuffer
        Call LocalFree(lpBuffer)
    End If
End Function