Visual Basic System Services
FormatMessage: How to Translate System Error Code Messages
     
Posted:   Saturday June, 1998
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     
 Prerequisites
None.

Instead of coding strings to represent application, system, disk, or network errors or other information that must be passed to the user, let Windows do this for you with the FormatMessage API. easy to implement, format message takes an error code and returns corresponding system message string. The demo here uses an up/down control (VB5/VB6) to increment the message values displaying the message and its hex and decimal values. VB4-32 users will need to code a VScroll control to provide this same functionality.
 BAS Module Code
None.

 Form Code
To a form add  a command button (Command1) and two textboxes (Text1 and Text2).

Add an UpDown control (from Common Controls 2), and set its AutoBuddy property true, its BuddyControl to 'Text2', and the BuddyProperty to Default. Set the UpDown Max value to a high number. Add the following code to the form:


Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function FormatMessage Lib "kernel32" _
  Alias "FormatMessageA" _
  (ByVal dwFlags As Long, _
   lpSource As Long, _
   ByVal dwMessageId As Long, _
   ByVal dwLanguageId As Long, _
   ByVal lpBuffer As String, _
   ByVal nSize As Long, _
   Args As Any) As Long

Private Const MAX_PATH As Long = 260
Private Const LB_SETTABSTOPS As Long= &H192
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long= &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long= &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long= &HFF
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long= &H2000

Private Sub Command1_Click()
    Unload Me
End Sub


Private Function GetErrorList(msgID As Long) As String

   Dim ret As Long
   Dim sVal As String
   Dim sCodes As String
   Dim sBuff As String
   
   sBuff = Space$(MAX_PATH)
   
   ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                       FORMAT_MESSAGE_IGNORE_INSERTS Or _
                       FORMAT_MESSAGE_MAX_WIDTH_MASK, _
                       0&, msgID, 0&, _
                       sBuff, Len(sBuff), 0&)
   
   sBuff = Left$(sBuff, ret)
   sCodes = msgID & vbTab & Hex(msgID) & vbTab
   
   If ret Then
      GetErrorList = sCodes & sBuff
   Else
      GetErrorList = sCodes & "(No such error)"
   End If

End Function


Private Function GetSystemMessage(msgID As Long) As String

   Dim ret As Long
   Dim sVal As String
   Dim sCodes As String
   Dim sBuff As String
   
   sBuff = Space$(MAX_PATH)
   
   ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                       FORMAT_MESSAGE_IGNORE_INSERTS, _
                       0&, msgID, 0&, _
                       sBuff, Len(sBuff), 0&)
   
   sBuff = Left$(sBuff, ret)
   
   sCodes = "Dec: " & msgID & vbTab & "Hex: " & Hex(msgID)
   
   If ret Then
      GetSystemMessage = sBuff & vbCrLf & sCodes
   Else
      GetSystemMessage = "(No such error)" & vbCrLf & vbCrLf & sCodes
   End If
   

End Function


Private Sub Form_Load()

   Text2.Text = "0"
   
End Sub


Private Sub Text2_Change()

   Dim msgID As Long
   Dim sVal As String
      
  'Recognize leading '&' or 'H/h' alone
  'as a hex specifier without following
   sVal = Text2
  
   If (Left$(sVal, 1) = "&" And UCase$(Mid$(sVal, 2, 1)) <> "H") Or _
      (Left$(sVal, 1) = "H") Or _
      (Left$(sVal, 1) = "h") Then
      
       sVal = "&H" & Mid$(sVal, 2)
       
   End If
   
  'display the message
   msgID = Val(sVal)
   Text1.Text = GetSystemMessage(msgID)
   
End Sub


Private Sub Text2_GotFocus()

   Text2.SelStart = 0
   Text2.SelLength = Len(Text2.Text)
   
End Sub


Private Sub Text2_KeyPress(KeyAscii As Integer)

   If KeyAscii = 13 Then
      KeyAscii = 0
   End If
      
End Sub
 Comments
This routine can be easily modified to provide all the error and system information messages needed.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter