Other Tips All Tips By Date By Subject
API (33) Bit Manipulation (3) Clipboard (3) Combo Box (5) Desktop (3) GDI (13) Graphics (13) Internet (2) Interprocess Comms (3) Keyboard (2) Mouse (1) Shell (1) Sprites (1) Subclassing (3) Text Box (2) Windows (11) Windows Controls (10)
Submit
|
Whenever an API function call fails, the error code can be retrieved from the Err.LastDLLError
property. This tip shows you how to retrieve the description for the error from
Windows.
Start a new project in VB. Add a new module, then add the following
code to it:
' To Report API errors:
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
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
Public Function WinAPIError(ByVal lLastDLLError As Long) As String
Dim sBuff As String
Dim lCount As Long
   
   
' Return the error message associated with LastDLLError:
    sBuff = String$(256, 0)
    lCount = FormatMessage( _
    FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
    0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
    If lCount Then
    WinAPIError = Left$(sBuff, lCount)
End If
End Function
To test out the function, add a Command button to the project's form.
The following code will incorrectly call the GetPrivateProfileString function in order
to force an API error (the path is not specified for the call). Then the WinAPIError
function is called to retrieve the error message, in this case "The system cannot find
the path specified".
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Sub Command1_Click()
Dim sBuf As String
Dim lLen As Long
Dim lR As Long
    sBuf = String$(255, 0): lLen = 255
    lR = GetPrivateProfileString("", "Fail", "", sBuf, lLen, "")
    If (lR = 0) Then
        MsgBox WinAPIError(Err.LastDllError), vbExclamation
    End If
End Sub
|