Get Error Messages from the System and Specific Modules

Category:

System/API

Type:

Modules

Difficulty:

Intermediate

Author:

Arkadiy Olovyannikov

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

Since IE5.5 MS include Message Tables in resources in Unicode format. So, all previous snippets to retrive messages from modules wit FormatMessage(FORMAT_MESSAGE_FROM_HMODULE...) don't work (while system messages in kernel32 still store in ANSI format). This module allow you to retrive any mesage from system/module by its number.

See the bottom of the snippet for sample usage.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
'Seems to be undocumented Private Type MESSAGE_RESOURCE_BLOCK LowId As Long HighId As Long OffsetToEntries As Long End Type Private Const RT_MESSAGETABLE = 11& 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 Const LOAD_LIBRARY_AS_DATAFILE = 2 Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (Destination As Any, Source As Any, _ ByVal Length As Long) Private Declare Function CopyStringA Lib "kernel32" _ Alias "lstrcpyA" (ByVal NewString As String, _ ByVal OldString As Long) As Long Private Declare Function FindResource Lib "kernel32" _ Alias "FindResourceA" (ByVal hInstance As Long, _ ByVal lpName As String, ByVal lpType As String) As Long Private Declare Function FindResourceByNum Lib _ "kernel32" Alias "FindResourceA" _ (ByVal hInstance As Long, ByVal lpName As String, _ ByVal lpType As Long) As Long Private Declare Function LoadResource Lib "kernel32" _ (ByVal hInstance As Long, ByVal hResInfo As Long) _ As Long Private Declare Function LockResource Lib "kernel32" _ (ByVal hResData As Long) As Long Private Declare Function FreeResource Lib _ "kernel32" (ByVal hResData As Long) As Long

Code:

Public Function FormatMessageFromSystem(ByVal nMsgNumber _
   As Long) As String

'Most system messages stored in kernel32.dll
   Dim s As String
   s = FormatMessageFromModule("kernel32", nMsgNumber)
   FormatMessageFromSystem = s
End Function

Public Function FormatMessageFromModule(ByVal sModuleName _
   As String, ByVal nMsgNumber As Long) As String
 
  Dim hModule As Long, hRsrc As Long, hGlobal As Long
   Dim lpData As Long, nBlocks As Long, nPos As Long
   Dim uLength As Long, uFlag As Long
   Dim i As Long, j As Long
   Dim s As String
   Dim bFound As Boolean
   hModule = LoadLibraryEx(sModuleName, 0, _
        LOAD_LIBRARY_AS_DATAFILE)
   If hModule = 0 Then Exit Function
   hRsrc = FindResourceByNum(hModule, "#1", RT_MESSAGETABLE)
   If hRsrc = 0 Then GoTo FmtMsgError
   hGlobal = LoadResource(hModule, hRsrc)
   lpData = LockResource(hGlobal)
   Call CopyMemory(nBlocks, ByVal lpData, 4)
   If nBlocks = 0 Then GoTo FmtMsgError
   ReDim mrb(nBlocks - 1) As MESSAGE_RESOURCE_BLOCK
   Call CopyMemory(mrb(0), ByVal lpData + 4, 12 * nBlocks)
   For i = 0 To nBlocks - 1
       If (nMsgNumber >= mrb(i).LowId) And _
             (nMsgNumber <= mrb(i).HighId) Then
          nPos = lpData + mrb(i).OffsetToEntries
          For j = mrb(i).LowId To mrb(i).HighId
              Call CopyMemory(uLength, ByVal nPos, 2)
              If (uLength > 0) And (j = nMsgNumber) Then
                 Call CopyMemory(uFlag, ByVal (nPos + 2), 2)
                 If uFlag = 1 Then 'Unicode
                    s = String(uLength, Chr$(0))
                    Call CopyMemory(ByVal StrPtr(s), _
                      ByVal (nPos + 4), uLength - 4)
                 Else 'ANSI
                    s = String(uLength, Chr$(0))
                    Call CopyStringA(s, ByVal nPos + 4)
                 End If
                 bFound = True
                 Exit For
              End If
              nPos = nPos + uLength
          Next j
       End If
       If bFound Then Exit For
   Next i
   s = TrimNULL(s)
   FormatMessageFromModule = s
FmtMsgError:
   If hModule Then Call FreeLibrary(hModule)
   If hGlobal Then Call FreeResource(hGlobal)
End Function

Private Function TrimNULL(ByVal str As String) As String
    If InStr(str, Chr$(0)) > 0& Then
        TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
    Else
        TrimNULL = str
    End If
End Function

'=======Using========
Private Sub Command1_Click()
  MsgBox FormatMessageFromSystem(136), vbExclamation, _
       "System message"
  MsgBox FormatMessageFromModule("wininet.dll", 12031), vbExclamation, "Module message"
End Sub

'or   MsgBox FormatMessageFromSystem(Err.LastDllError), vbExclamation, "System message"