 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. |
| 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
|
